Commit 04a5751b authored by Pietro Abate's avatar Pietro Abate
Browse files

Add substitutions in Typed abstractions

parent 70914ae2
......@@ -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
}
......@@ -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) ->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment