2011-05-02 11:20:37 +02:00
|
|
|
open Idents
|
|
|
|
open Signature
|
2011-04-19 17:19:40 +02:00
|
|
|
open Minils
|
|
|
|
open Mls_mapfold
|
|
|
|
|
|
|
|
(** Adds an extra equation for outputs that are also memories.
|
|
|
|
For instance, if o is an output, then:
|
|
|
|
o = v fby e
|
|
|
|
becomes
|
|
|
|
mem_o = v fby e;
|
|
|
|
o = mem_o
|
|
|
|
*)
|
|
|
|
|
2011-09-08 11:45:43 +02:00
|
|
|
let eq _ (outputs, v, eqs) eq = match eq.eq_lhs, eq.eq_rhs.e_desc with
|
2011-04-19 17:19:40 +02:00
|
|
|
| Evarpat x, Efby _ ->
|
2011-05-02 11:20:37 +02:00
|
|
|
if Mls_utils.vd_mem x outputs then
|
2011-09-08 11:45:43 +02:00
|
|
|
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)
|
2011-05-02 11:20:37 +02:00
|
|
|
else (* this memory is not an output *)
|
2011-09-08 11:45:43 +02:00
|
|
|
eq, (outputs, v, eq::eqs)
|
2011-04-19 17:19:40 +02:00
|
|
|
| _, _ ->
|
2011-09-08 11:45:43 +02:00
|
|
|
eq, (outputs, v, eq::eqs)
|
2011-04-19 17:19:40 +02:00
|
|
|
|
2011-07-27 16:13:45 +02:00
|
|
|
(* Leave contract unchanged (no output defined in it) *)
|
|
|
|
let contract funs acc c = c, acc
|
|
|
|
|
2011-04-19 17:19:40 +02:00
|
|
|
let node funs acc nd =
|
2011-09-08 11:45:43 +02:00
|
|
|
let nd, (_, v, eqs) = Mls_mapfold.node_dec funs (nd.n_output, nd.n_local, []) nd in
|
2011-04-27 14:28:45 +02:00
|
|
|
(* return updated node *)
|
2011-09-08 11:45:43 +02:00
|
|
|
{ nd with n_local = v; n_equs = List.rev eqs }, acc
|
2011-04-19 17:19:40 +02:00
|
|
|
|
|
|
|
let program p =
|
2011-09-07 17:51:31 +02:00
|
|
|
let funs = { Mls_mapfold.defaults with
|
2011-09-08 11:45:43 +02:00
|
|
|
eq = eq; node_dec = node; contract = contract } in
|
|
|
|
let p, _ = Mls_mapfold.program_it funs ([], [], []) p in
|
2011-04-19 17:19:40 +02:00
|
|
|
p
|