jeltz/heptagon
1
0
Fork 0
Code Issues Pull requests Releases Activity

Fixed extvalue inlining w.r.t. linear copy

Browse source
This commit is contained in:
Adrien Guatto 2011-10-05 17:43:43 +02:00
parent 175c8e34ff
commit 30089e7d0f
1 changed files with 22 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
compiler/minils/transformations/inline_extvalues.ml
View file

@ -32,10 +32,31 @@ open Mls_compare
4. If no new extended value was formed, stop ; else, go back to 1.
*)
let gather_extvalues_node nd =
let ty_env =
let add env vd = Env.add vd.v_ident vd.v_type env in
let add_l env vd_list = List.fold_left add env vd_list in
(add_l (add_l (add_l Env.empty nd.n_output) nd.n_local) nd.n_input)
in
let changed_type w =
let rec var_of_extvalue w = match w.w_desc with
| Wvar _ -> Some w
| Wfield(w, _) -> var_of_extvalue w
| Wwhen(w, _, _) -> var_of_extvalue w
| Wconst _ -> None
in
match var_of_extvalue w with
| Some { w_ty = ty; w_desc = Wvar x; } ->
let ty' = Env.find x ty_env in
Global_compare.type_compare ty' ty = 0
| _ -> false
in
let gather_extvalues_eq _ env eq =
let env = match eq.eq_lhs, eq.eq_rhs.e_desc with
| Evarpat x, Eextvalue w -> Env.add x w env
| Evarpat x, Eextvalue w when not (changed_type w) -> Env.add x w env
| _ -> env
in
eq, env