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

Fixed inlining

Browse source 
Inlining is now recursive.
This commit is contained in:
Cédric Pasteur 2011-09-15 13:28:41 +02:00
parent 26ad2739dd
commit 1231afdbb1
1 changed files with 14 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
compiler/heptagon/transformations/inline.ml
View file

@ -49,7 +49,9 @@ let mk_unique_node nd =
edesc = subst_edesc; } in
fst (Hept_mapfold.node_dec funs () nd)
let exp funs (env, newvars, newequs) exp = match exp.e_desc with
let exp funs (env, newvars, newequs) exp =
let exp, (env, newvars, newequs) = Hept_mapfold.exp funs (env, newvars, newequs) exp in
match exp.e_desc with
| Eiterator (it, { a_op = Enode nn; }, _, _, _, _) when to_be_inlined nn ->
Format.eprintf
"WARN: inlining iterators (\"%s %s\" here) is unsupported.@."
@ -62,7 +64,7 @@ let exp funs (env, newvars, newequs) exp = match exp.e_desc with
| None -> eq
| Some x -> mk_equation (Ereset (mk_block [eq], x)) in
let ni = mk_unique_node (env nn) in
let ni = mk_unique_node (QualEnv.find nn env) in
let static_subst =
List.combine (List.map (fun p -> (local_qn p.p_name)) ni.n_params)
@ -101,12 +103,13 @@ let exp funs (env, newvars, newequs) exp = match exp.e_desc with
(res_e, (env, newvars, newequs))
with
| Not_found -> exp, (env, newvars, newequs)
| Not_found -> Format.eprintf "Could not inline %s@." (fullname nn);
exp, (env, newvars, newequs)
end
| _ -> Hept_mapfold.exp funs (env, newvars, newequs) exp
| _ -> exp, (env, newvars, newequs)
let block funs (env, newvars, newequs) blk =
let (_, (env, newvars, newequs)) =
let (blk, (env, newvars, newequs)) =
Hept_mapfold.block funs (env, newvars, newequs) blk in
({ blk with b_local = newvars @ blk.b_local; b_equs = newequs @ blk.b_equs; },
(env, [], []))
@ -114,25 +117,16 @@ let block funs (env, newvars, newequs) blk =
let node_dec funs (env, newvars, newequs) nd =
let nd, (env, newvars, newequs) =
Hept_mapfold.node_dec funs (env, newvars, newequs) nd in
({ nd with n_block =
{ nd.n_block with b_local = newvars @ nd.n_block.b_local;
b_equs = newequs @ nd.n_block.b_equs } },
(env, [], []))
let nd = { nd with n_block =
{ nd.n_block with b_local = newvars @ nd.n_block.b_local;
b_equs = newequs @ nd.n_block.b_equs } } in
let env = QualEnv.add nd.n_name nd env in
nd, (env, [], [])
let program p =
let env n =
let d =
List.find
(function
| Pnode nd -> nd.n_name = n
| _ -> false)
p.p_desc in
match d with
| Pnode nd -> nd
| _ -> assert false in
let funs =
{ defaults with exp = exp; block = block; node_dec = node_dec; eq = eq; } in
let (p, (_, newvars, newequs)) = Hept_mapfold.program funs (env, [], []) p in
let (p, (_, newvars, newequs)) = Hept_mapfold.program funs (QualEnv.empty, [], []) p in
assert (newvars = []);
assert (newequs = []);
p