Add substitutions in Typed abstractions

typing/typed.ml

@@ -86,6 +86,7 @@ and branch = {
   mutable br_vars_empty : fv;
   mutable br_vars_poly : fv;
   br_pat : tpat;
-  br_body : texpr 
+  (* this field is mutable because we need to add substitutions *)
+  mutable br_body : texpr 
 }
 

typing/typer.ml

@@ -851,6 +851,7 @@ let flatten arg constr precise =
 
 
 let rec type_check env e constr precise = 
+  Printf.printf "aaaa\n%!";
   let (ed,d) = type_check' e.exp_loc env e.exp_descr constr precise in
   let d = if precise then d else constr in
   e.exp_typ <- Types.cup e.exp_typ d;
@@ -862,8 +863,9 @@ and type_check' loc env ed constr precise = match ed with
       let t = Types.descr t in
       ignore (type_check env e t false);
       (ed,verify loc t constr)
-
+(*
   | Subst (e, sigma) -> (ed,type_check env e constr precise)
+*)
 
   | Check (t0,e,t) ->
       let te = type_check env e Types.any true in
@@ -884,18 +886,25 @@ and type_check' loc env ed constr precise = match ed with
       (* update \delta with all variables in t1 -> t2 *)
 
       (* I check the body with all possible t1 -> t2 types *)
-      List.iter (fun (t1,t2) ->
-        let acc = a.fun_body.br_accept in
-        if not (Types.subtype t1 acc) then
-	    raise_loc loc (NonExhaustive (Types.diff t1 acc));
-        let t = type_check_branches loc env t1 a.fun_body t2 false in
-        let sigma = Types.abstr t t2 in (* H_j *)
-        (*
-        List.iter (fun br ->
-          br.br_body.exp_descr <- Subst(br.br_body,sigma); 
-        ) a.fun_body.br_branches
-      *) ()
-	) a.fun_iface;
+      let sl_list = 
+        List.fold_left (fun tacc (t1,t2) ->
+          let acc = a.fun_body.br_accept in
+          if not (Types.subtype t1 acc) then
+            raise_loc loc (NonExhaustive (Types.diff t1 acc));
+          let t = type_check_branches loc env t1 a.fun_body t2 false in
+          (Types.abstr t t2)::tacc (* H_j *)
+        ) [] a.fun_iface
+      in
+      List.iter (function 
+        (* If sigma empty (sat, we do not need any subst ...
+         | sigma when Types.Tallying.CS. sigma -> () *)
+        | sigma ->
+          List.iter (fun br ->
+            let e = br.br_body in
+            let loc = br.br_body.exp_loc in
+            br.br_body <- exp' loc (Subst(e,sigma)); 
+          ) a.fun_body.br_branches
+      ) (List.rev sl_list);
       (ed,t)
 
   | Match (e,b) ->