summaryrefslogtreecommitdiff
path: root/src/constant_propagation.ml
diff options
context:
space:
mode:
authorBrian Campbell2019-05-02 12:01:44 +0100
committerBrian Campbell2019-05-06 16:36:45 +0100
commit4eb2e16d8e3accf5bfc9d695be619d80b34e2824 (patch)
tree1465032f1909b67221b170a2b2afb3b17f7f5e07 /src/constant_propagation.ml
parent1064db03f724f96dee4ea4da1ddc47f201d28cbb (diff)
Calculate some type variable substitutions during constant propagation
Needed for constructor monomorphisation
Diffstat (limited to 'src/constant_propagation.ml')
-rw-r--r--src/constant_propagation.ml12
1 files changed, 11 insertions, 1 deletions
diff --git a/src/constant_propagation.ml b/src/constant_propagation.ml
index 153ec772..2fb19c05 100644
--- a/src/constant_propagation.ml
+++ b/src/constant_propagation.ml
@@ -680,7 +680,17 @@ let const_props defs ref_vars =
match e, p with
| _, P_wild -> DoesMatch ([],[])
| _, P_typ (_,p') -> check_exp_pat exp p'
- | _, P_id id' when pat_id_is_variable env id' -> DoesMatch ([id',exp],[])
+ | _, P_id id' when pat_id_is_variable env id' ->
+ let exp_typ = typ_of exp in
+ let pat_typ = typ_of_pat pat in
+ let goals = KidSet.diff (tyvars_of_typ pat_typ) (tyvars_of_typ exp_typ) in
+ let unifiers = Type_check.unify l env goals pat_typ exp_typ in
+ let is_nexp (k,a) = match a with
+ | A_aux (A_nexp n,_) -> Some (k,n)
+ | _ -> None
+ in
+ let kbindings = Util.map_filter is_nexp (KBindings.bindings unifiers) in
+ DoesMatch ([id',exp],kbindings)
| E_tuple es, P_tup ps ->
let rec check = function
| DoesNotMatch -> fun _ -> DoesNotMatch