diff options
| author | Alasdair | 2019-11-01 01:49:13 +0000 |
|---|---|---|
| committer | Alasdair | 2019-11-01 01:51:42 +0000 |
| commit | 92a041233cc148fcfce2eccb43ae98a9b970de25 (patch) | |
| tree | 4170311779ac95a4517c26afb96af8929a6437e8 /src | |
| parent | d61c5160a637479c264b74d8cefc5c0a67942795 (diff) | |
Add a missing well-formedness check
Diffstat (limited to 'src')
| -rw-r--r-- | src/type_check.ml | 6 |
1 files changed, 5 insertions, 1 deletions
diff --git a/src/type_check.ml b/src/type_check.ml index af4a7f65..93b6da36 100644 --- a/src/type_check.ml +++ b/src/type_check.ml @@ -1335,10 +1335,12 @@ let add_typquant l (quant : typquant) (env : Env.t) : Env.t = let expand_bind_synonyms l env (typq, typ) = typq, Env.expand_synonyms (add_typquant l typq env) typ -let wf_typschm env (TypSchm_aux (TypSchm_ts (typq, typ), l)) = +let wf_binding l env (typq, typ) = let env = add_typquant l typq env in Env.wf_typ env typ +let wf_typschm env (TypSchm_aux (TypSchm_ts (typq, typ), l)) = wf_binding l env (typq, typ) + (* Create vectors with the default order from the environment *) let default_order_error_string = @@ -5077,11 +5079,13 @@ let check_type_union env variant typq (Tu_aux (tu, l)) = match tu with | Tu_ty_id (Typ_aux (Typ_fn (arg_typ, ret_typ, _), _) as typ, v) -> let typq = mk_typquant (List.map (mk_qi_id K_type) (KidSet.elements (tyvars_of_typ typ))) in + wf_binding l env (typq, typ); env |> Env.add_union_id v (typq, typ) |> Env.add_val_spec v (typq, typ) | Tu_ty_id (arg_typ, v) -> let typ' = mk_typ (Typ_fn ([arg_typ], ret_typ, no_effect)) in + wf_binding l env (typq, typ'); env |> Env.add_union_id v (typq, typ') |> Env.add_val_spec v (typq, typ') |