diff options
| author | Brian Campbell | 2017-07-07 18:04:03 +0100 |
|---|---|---|
| committer | Brian Campbell | 2017-07-07 18:04:03 +0100 |
| commit | 32671d00eae73a5d1110c79710783d7c04f7cdbf (patch) | |
| tree | e89f7d7da33776d3897f3e1d9f351bb48607efde /src | |
| parent | 10caa78f7d11bae716c714587e059d18cee51476 (diff) | |
Correct variable mapping when splitting constructor patterns for monomorphisation
Diffstat (limited to 'src')
| -rw-r--r-- | src/monomorphise.ml | 19 |
1 files changed, 17 insertions, 2 deletions
diff --git a/src/monomorphise.ml b/src/monomorphise.ml index 2e78b6b5..a64e047c 100644 --- a/src/monomorphise.ml +++ b/src/monomorphise.ml @@ -755,10 +755,25 @@ let split_defs splits (Type_check.Env (d_env,t_env,b_env,tp_env)) defs = match p with | P_app (id,args) -> (try - let variants = List.assoc (id_to_string id) refinements in + let i = id_to_string id in + let variants = List.assoc i refinements in + let constr_tannot = + match Envmap.apply t_env i with + | Some (Base ((_,{t=Tfn(_,outt,_,_)}),_,_,_,_,_)) -> simple_annot outt + | _ -> raise (Reporting_basic.err_general l + ("Constructor missing from environment: " ^ i)) + in + let varmap = build_nexp_subst l constr_tannot tannot in let map_inst (insts,i') = + let insts = List.map (fun (v,i) -> + ((match List.assoc v varmap with + | {nexp=Nvar s} -> s + | _ -> raise (Reporting_basic.err_general l + ("Constructor parameter not a variable: " ^ v))), + TA_nexp {nexp=Nconst (Big_int.big_int_of_int i);imp_param=false})) + insts in P_aux (P_app (Id_aux (Id i',Generated l),args),(Generated l,tannot)), - Envmap.from_list (List.map (fun (v,i) -> (v,TA_nexp {nexp=Nconst (Big_int.big_int_of_int i);imp_param=false})) insts) + Envmap.from_list insts in ConstrSplit (List.map map_inst variants) with Not_found -> NoSplit) |
