diff --git a/compiler/minils/main/mls_compiler.ml b/compiler/minils/main/mls_compiler.ml index a8855af..ad8bfb8 100644 --- a/compiler/minils/main/mls_compiler.ml +++ b/compiler/minils/main/mls_compiler.ml @@ -40,7 +40,10 @@ let compile_program p = let p = pass "Automata minimization checks" true Tomato.tomato_checks p pp in *) - + + (* Normalize memories*) + let p = pass "Normalize memories" true Normalize_mem.program p pp in + (* Scheduling *) let p = if !Compiler_options.use_interf_scheduler then @@ -49,9 +52,6 @@ let compile_program p = pass "Scheduling" true Schedule.program p pp in - (* Normalize memories*) - let p = pass "Normalize memories" true Normalize_mem.program p pp in - (* Memory allocation *) let p = pass "memory allocation" !do_mem_alloc Interference.program p pp in diff --git a/compiler/minils/transformations/normalize_mem.ml b/compiler/minils/transformations/normalize_mem.ml index 1437412..402dc68 100644 --- a/compiler/minils/transformations/normalize_mem.ml +++ b/compiler/minils/transformations/normalize_mem.ml @@ -11,49 +11,34 @@ open Mls_mapfold o = mem_o *) -let fix_vd_ad env vd ad = - if Env.mem vd.v_ident env then - let x_copy = Env.find vd.v_ident env in - { vd with v_ident = x_copy }, { ad with a_name = Some (Idents.name x_copy) } - else - vd, ad - -let eq _ (outputs, eqs, env) eq = match eq.eq_lhs, eq.eq_rhs.e_desc with +let eq _ (outputs, v, eqs) eq = match eq.eq_lhs, eq.eq_rhs.e_desc with | Evarpat x, Efby _ -> if Mls_utils.vd_mem x outputs then - let ty = eq.eq_rhs.e_ty in - let lin = eq.eq_rhs.e_linearity in - let ck = eq.eq_rhs.e_base_ck in - let x_copy = Idents.gen_var "normalize_mem" ("out_"^(Idents.name x)) in - let exp_x = - mk_exp ck ~ck:ck ~ct:(Clocks.Ck ck) ty ~linearity:lin - (Eextvalue (mk_extvalue ~clock:ck ~ty:ty ~linearity:lin (Wvar x))) - in - let eq_copy = { eq with eq_lhs = Evarpat x_copy; eq_rhs = exp_x } in - let env = Env.add x x_copy env in - eq, (outputs, eq::eq_copy::eqs, env) + let vd = Mls_utils.vd_find x outputs 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 + (* 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 + eq, (outputs, vd_mem::v, eq::eq_copy::eqs) else (* this memory is not an output *) - eq, (outputs, eq::eqs, env) + eq, (outputs, v, eq::eqs) | _, _ -> - eq, (outputs, eq::eqs, env) + eq, (outputs, v, eq::eqs) (* Leave contract unchanged (no output defined in it) *) let contract funs acc c = c, acc let node funs acc nd = - let nd, (_, eqs, env) = Mls_mapfold.node_dec funs (nd.n_output, [], Env.empty) nd in - let v = Env.fold - (fun x _ acc -> (Mls_utils.vd_find x nd.n_output)::acc) env nd.n_local in - (* update the signature of the node *) - let f = Modules.find_value nd.n_name in - let o, sig_o = List.split (List.map2 (fix_vd_ad env) nd.n_output f.node_outputs) in - let f = { f with node_outputs = sig_o } in - Modules.replace_value nd.n_name f; + let nd, (_, v, eqs) = Mls_mapfold.node_dec funs (nd.n_output, nd.n_local, []) nd in (* return updated node *) - { nd with n_local = v; n_equs = List.rev eqs; n_output = o }, acc + { nd with n_local = v; n_equs = List.rev eqs }, acc let program p = let funs = { Mls_mapfold.defaults with - eq = eq; node_dec = node; contract = contract } in - let p, _ = Mls_mapfold.program_it funs ([], [], Env.empty) p in + eq = eq; node_dec = node; contract = contract } in + let p, _ = Mls_mapfold.program_it funs ([], [], []) p in p