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

Second part of the fix

Browse source
This commit is contained in:
Cédric Pasteur 2011-11-29 14:08:12 +01:00 committed by Adrien Guatto
parent 2b9d3828b1
commit f76667e042
3 changed files with 22 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
compiler/main/mls2obc.ml
View file

@ -713,6 +713,9 @@ let translate_node
let d_list = translate_var_dec (v @ d_list) in
let m, d_list = List.partition
(fun vd -> List.exists (fun (i,_) -> i = vd.v_ident) mem_var_tys) d_list in
let m', o_list =
List.partition
(fun vd -> List.exists (fun (i,_) -> i = vd.v_ident) mem_var_tys) o_list in
let s = s_list @ s_list' in
let j = j' @ j in
let si = si @ si' in
@ -721,7 +724,7 @@ let translate_node
in
let resetm = { m_name = Mreset; m_inputs = []; m_outputs = []; m_body = mk_block si } in
if stateful
then { cd_name = f; cd_stateful = true; cd_mems = m; cd_params = params;
then { cd_name = f; cd_stateful = true; cd_mems = m' @ m; cd_params = params;
cd_objs = j; cd_methods = [stepm; resetm]; cd_loc = loc; cd_mem_alloc = mem_alloc }
else (
(* Functions won't have [Mreset] or memories,

5
compiler/minils/mls_utils.ml
View file

@ -202,6 +202,11 @@ let node_memory_vars n =
let _, acc = node_dec_it funs [] n in
acc
let rec is_fby e = match e.e_desc with
| Ewhen (e, _, _) -> is_fby e
| Efby (_, _) -> true
| _ -> false
(* data-flow dependences. pre-dependences are discarded *)
module DataFlowDep = Dep.Make
(struct

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

@ -28,7 +28,8 @@ let normalize_outputs = ref true
Other variables are mapped to None. *)
let build_env nd =
let add_none env l = List.fold_left (fun env vd -> Env.add vd.v_ident None env) env l in
let add_eq env eq = match eq.eq_lhs, eq.eq_rhs.e_desc with
let rec add_eq env eq = match eq.eq_lhs, eq.eq_rhs.e_desc with
| _, Ewhen (e, _, _) -> add_eq env { eq with eq_rhs = e }
| Evarpat x, Efby (_, w) -> Env.add x (ident_of_extvalue w) env
| _, _ ->
List.fold_left (fun env id -> Env.add id None env) env (Vars.def [] eq)
@ -43,6 +44,11 @@ let build_env nd =
in
env
let rec replace_fby e exp_mem_x = match e.e_desc with
| Ewhen (e1, c, y) -> { e with e_desc = Ewhen (replace_fby e1 exp_mem_x, c, y) }
| Efby (_, _) -> exp_mem_x
| _ -> assert false
let rec depends_on x y env =
match Env.find y env with
| None -> false
@ -51,17 +57,18 @@ let rec depends_on x y env =
else if ident_compare y z = 0 then false
else depends_on x z env
let eq _ (env, vds, v, eqs) eq = match eq.eq_lhs, eq.eq_rhs.e_desc with
| Evarpat x, Efby (_, _) when depends_on x x env ->
let eq funs (env, vds, v, eqs) eq = match eq.eq_lhs, eq.eq_rhs with
| Evarpat x, e when is_fby e && depends_on x x env ->
let vd = vd_find x vds in
let x_mem = Idents.gen_var "normalize_mem" ("mem_"^(Idents.name x)) in
let vd_mem = { vd with v_ident = x_mem } in
let exp_mem_x = mk_extvalue_exp vd.v_clock vd.v_type
~clock:vd.v_clock ~linearity:vd.v_linearity (Wvar x_mem) in
let ck = Misc.assert_1 (Clocks.unprod e.e_ct) in
let exp_mem_x = mk_extvalue_exp e.e_level_ck vd.v_type
~clock:ck ~linearity:vd.v_linearity (Wvar x_mem) in
(* mem_o = v fby e *)
let eq_copy = { eq with eq_lhs = Evarpat x_mem } in
(* o = mem_o *)
let eq = { eq with eq_rhs = exp_mem_x } in
let eq = { eq with eq_rhs = replace_fby e exp_mem_x } in
(* remove the dependency in env *)
let env = Env.add x None env in
eq, (env, vds, vd_mem::v, eq::eq_copy::eqs)