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

really fix normalize_mem.

Browse source 
in the old fix was missing the renaming, and there was wrong equations
order :
f () returns x
[here rename x by mem_x]
mem_x = fby ...
x = mem_x

so the simplest was :
f () returns out_x
var x;
[ nothing to do]
out_x = x
x = fby ...

pay attention to the order of equations since we are after the
scheduling..
probably it should be done before the scheduling anyway ?
This commit is contained in:
Léonard Gérard 2011-04-20 19:23:35 +02:00
parent 5fb518d8ed
commit 6b86b86e9d
2 changed files with 19 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
compiler/minils/mls_utils.ml
View file

@ -36,7 +36,7 @@ let rec bounds_list ty =
(** @return the [var_dec] object corresponding to the name [n]
in a list of [var_dec]. *)
let rec vd_find n = function
| [] -> Format.eprintf "Not found var %s@." (name n); raise Not_found
| [] -> (*Format.eprintf "Not found var %s@." (name n);*) raise Not_found
| vd::l ->
if vd.v_ident = n then vd else vd_find n l

32
compiler/minils/transformations/normalize_mem.ml
View file

@ -9,26 +9,30 @@ open Mls_mapfold
o = mem_o
*)
let eq _ (v, eqs) eq = match eq.eq_lhs, eq.eq_rhs.e_desc with
let rec vd_replace vd by_vd vd_l = match vd_l with
| [] -> []
| h::t -> if h.v_ident = vd.v_ident then by_vd::t else h::(vd_replace vd by_vd t)
let eq _ (locals, eqs, outs) eq = match eq.eq_lhs, eq.eq_rhs.e_desc with
| Evarpat x, Efby _ ->
if not (Mls_utils.vd_mem x v) then (* this memory is also an output *)
(try
let vd_out = Mls_utils.vd_find x outs in (* this memory is also an output *)
let ty = eq.eq_rhs.e_ty in
let x_copy = Idents.gen_var "normalize_mem" ("mem_"^(Idents.name x)) in
let vd = mk_var_dec ~clock:eq.eq_rhs.e_ck x_copy ty in
let x_copy_exp = mk_exp ty (Eextvalue (mk_extvalue ~ty:ty (Wvar x_copy))) in
let eq_copy = { eq with eq_rhs = x_copy_exp } in
let eq = { eq with eq_lhs = Evarpat x_copy } in
eq, (vd::v, eq_copy::eq::eqs)
else
eq, (v, eq::eqs)
let x_copy = Idents.gen_var "normalize_mem" ("out_"^(Idents.name x)) in
let vd_x_copy = mk_var_dec ~clock:eq.eq_rhs.e_ck x_copy ty in
let exp_x = mk_exp ty (Eextvalue (mk_extvalue ~ty:ty (Wvar x))) in
let eq_copy = { eq with eq_lhs = Evarpat x_copy; eq_rhs = exp_x } in
eq, (vd_out::locals, eq::eq_copy::eqs, vd_replace vd_out vd_x_copy outs)
with Not_found -> (* this memory is not an output *)
eq, (locals, eq::eqs, outs))
| _, _ ->
eq, (v, eq::eqs)
eq, (locals, eq::eqs, outs)
let node funs acc nd =
let nd, (v, eqs) = Mls_mapfold.node_dec funs (nd.n_local, []) nd in
{ nd with n_local = v; n_equs = List.rev eqs }, acc
let nd, (v, eqs, o) = Mls_mapfold.node_dec funs (nd.n_local, [], nd.n_output) nd in
{ nd with n_local = v; n_equs = List.rev eqs; n_output = o }, acc
let program p =
let funs = { Mls_mapfold.defaults with eq = eq; node_dec = node } in
let p, _ = Mls_mapfold.program_it funs ([], []) p in
let p, _ = Mls_mapfold.program_it funs ([], [], []) p in
p