diff options
| author | Brian Campbell | 2017-11-27 16:41:58 +0000 |
|---|---|---|
| committer | Brian Campbell | 2017-11-27 16:42:55 +0000 |
| commit | 4a7d6e6d7e9221a19bc50c627b5714e45b1748bc (patch) | |
| tree | c22a44c80e45b17c1c96c802450aa8eeb2bc1fe7 /src | |
| parent | 05081c479140487dd581167168f67e8226ec599f (diff) | |
Use guards from when patterns when typing cases
Diffstat (limited to 'src')
| -rw-r--r-- | src/type_check.ml | 4 |
1 files changed, 3 insertions, 1 deletions
diff --git a/src/type_check.ml b/src/type_check.ml index 3a8f2e59..2260416d 100644 --- a/src/type_check.ml +++ b/src/type_check.ml @@ -2041,7 +2041,9 @@ let rec check_exp env (E_aux (exp_aux, (l, ())) as exp : unit exp) (Typ_aux (typ | Pat_aux (Pat_when (pat, guard, case), (l, _)) -> let tpat, env = bind_pat env pat (typ_of inferred_exp) in let checked_guard = check_exp env guard bool_typ in - Pat_aux (Pat_when (tpat, checked_guard, crule check_exp env case typ), (l, None)) + let flows, constrs = infer_flow env checked_guard in + let env' = add_constraints constrs (add_flows true flows env) in + Pat_aux (Pat_when (tpat, checked_guard, crule check_exp env' case typ), (l, None)) in annot_exp (E_case (inferred_exp, List.map (fun case -> check_case case typ) cases)) typ | E_try (exp, cases), _ -> |