summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorBrian Campbell2017-07-07 18:04:03 +0100
committerBrian Campbell2017-07-07 18:04:03 +0100
commit32671d00eae73a5d1110c79710783d7c04f7cdbf (patch)
treee89f7d7da33776d3897f3e1d9f351bb48607efde /src
parent10caa78f7d11bae716c714587e059d18cee51476 (diff)
Correct variable mapping when splitting constructor patterns for monomorphisation
Diffstat (limited to 'src')
-rw-r--r--src/monomorphise.ml19
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)