Schedule with the iterator and eqs/var_decs added in mapfold.

compiler/main/heptc.ml

@@ -56,7 +56,7 @@ let compile_impl modname filename =
     Mls_printer.print mlsc p;
 
     (* Process the MiniLS AST *)
-   (* let p = Mls_compiler.compile pp p in *)
+    let p = Mls_compiler.compile pp p in
 
       (* Generate the sequential code *)
       Mls2seq.program p;

compiler/minils/main/mls_compiler.ml

@@ -11,20 +11,19 @@ open Compiler_utils
 
 let compile pp p =
   (* Clocking *)
-  let p = do_silent_pass Clocking.program "Clocking" p true in
+  (*let p = do_silent_pass Clocking.program "Clocking" p true in *)
 
   (* Check that the dataflow code is well initialized *)
-  let p =
-    do_silent_pass Init.program "Initialization check" p !init in
+  (*let p = do_silent_pass Init.program "Initialization check" p !init in *)
 
   (* Normalization to maximize opportunities *)
-  let p = do_pass Normalize.program "Normalization" p pp true in
+  (*let p = do_pass Normalize.program "Normalization" p pp true in*)
 
   (* Scheduling *)
   let p = do_pass Schedule.program "Scheduling" p pp true in
 
   (* Parametrized functions instantiation *)
-  let p = do_pass Callgraph.program
-    "Parametrized functions instantiation" p pp true in
+  (*let p = do_pass Callgraph_mapfold.program
+    "Parametrized functions instantiation" p pp true in *)
 
   p

compiler/minils/mls_mapfold.ml

@@ -19,9 +19,12 @@ type 'a mls_it_funs = {
   app:        'a mls_it_funs -> 'a -> Minils.app -> Minils.app * 'a;
   edesc:      'a mls_it_funs -> 'a -> Minils.edesc -> Minils.edesc * 'a;
   eq:         'a mls_it_funs -> 'a -> Minils.eq -> Minils.eq * 'a;
+  eqs:        'a mls_it_funs -> 'a -> Minils.eq list -> Minils.eq list * 'a;
   exp:        'a mls_it_funs -> 'a -> Minils.exp -> Minils.exp * 'a;
   pat:        'a mls_it_funs -> 'a -> Minils.pat -> Minils.pat * 'a;
   var_dec:    'a mls_it_funs -> 'a -> Minils.var_dec -> Minils.var_dec * 'a;
+  var_decs:   'a mls_it_funs -> 'a -> Minils.var_dec list
+                                   -> Minils.var_dec list * 'a;
   contract:   'a mls_it_funs -> 'a -> Minils.contract -> Minils.contract * 'a;
   node_dec:   'a mls_it_funs -> 'a -> Minils.node_dec -> Minils.node_dec * 'a;
   const_dec:  'a mls_it_funs -> 'a -> Minils.const_dec -> Minils.const_dec * 'a;
@@ -97,19 +100,25 @@ and eq funs acc eq =
   let eq_rhs, acc = exp_it funs acc eq.eq_rhs in
     { eq with eq_lhs = eq_lhs; eq_rhs = eq_rhs }, acc
 
+and eqs_it funs acc eqs = funs.eqs funs acc eqs
+and eqs funs acc eqs = mapfold (eq_it funs) acc eqs
+
 
 and var_dec_it funs acc vd = funs.var_dec funs acc vd
 and var_dec funs acc vd =
   let v_type, acc = ty_it funs.global_funs acc vd.v_type in
   { vd with v_type = v_type }, acc
 
+and var_decs_it funs acc vds = funs.var_decs funs acc vds
+and var_decs funs acc vds = mapfold (var_dec_it funs) acc vds
+
 
 and contract_it funs acc c = funs.contract funs acc c
 and contract funs acc c =
   let c_assume, acc = exp_it funs acc c.c_assume in
   let c_enforce, acc = exp_it funs acc c.c_enforce in
-  let c_local, acc = mapfold (var_dec_it funs) acc c.c_local in
-  let c_eq, acc = mapfold (eq_it funs) acc c.c_eq in
+  let c_local, acc = var_decs_it funs acc c.c_local in
+  let c_eq, acc = eqs_it funs acc c.c_eq in
   { c with
     c_assume = c_assume; c_enforce = c_enforce; c_local = c_local; c_eq = c_eq }
   , acc
@@ -117,12 +126,12 @@ and contract funs acc c =
 
 and node_dec_it funs acc nd = funs.node_dec funs acc nd
 and node_dec funs acc nd =
-  let n_input, acc = mapfold (var_dec_it funs) acc nd.n_input in
-  let n_output, acc = mapfold (var_dec_it funs) acc nd.n_output in
-  let n_local, acc = mapfold (var_dec_it funs) acc nd.n_local in
+  let n_input, acc = var_decs_it funs acc nd.n_input in
+  let n_output, acc = var_decs_it funs acc nd.n_output in
+  let n_local, acc = var_decs_it funs acc nd.n_local in
   let n_params, acc = mapfold (param_it funs.global_funs) acc nd.n_params in
   let n_contract, acc =  optional_wacc (contract_it funs) acc nd.n_contract in
-  let n_equs, acc = mapfold (eq_it funs) acc nd.n_equs in
+  let n_equs, acc = eqs_it funs acc nd.n_equs in
   { nd with
       n_input = n_input; n_output = n_output;
       n_local = n_local; n_params = n_params;
@@ -164,9 +173,11 @@ let defaults = {
   app = app;
   edesc = edesc;
   eq = eq;
+  eqs = eqs;
   exp = exp;
   pat = pat;
   var_dec = var_dec;
+  var_decs = var_decs;
   contract = contract;
   node_dec = node_dec;
   const_dec = const_dec;

compiler/minils/transformations/schedule.ml

@@ -27,6 +27,7 @@ let join ck1 ck2 =
 
 let join eq1 eq2 = join (Vars.clock eq1) (Vars.clock eq2)
 
+(* TODO *)
 (* possible overlapping between nodes *)
 (*let head e =
   match e with
@@ -72,14 +73,10 @@ let schedule eq_list =
   let node_list = List.rev node_list in
   List.map containt node_list
 
-let schedule_contract ({ c_eq = eqs } as c) =
-  let eqs = schedule eqs in
-  { c with c_eq = eqs }
+(* We suppose here that we don't have nested eqs.
+  Otherwise schedule should be 'recursive' *)
+let eqs funs () eq_list = schedule eq_list, ()
 
-let node ({ n_contract = contract; n_equs = eq_list } as node) =
-  let contract = optional schedule_contract contract in
-  let eq_list = schedule eq_list in
-  { node with n_equs = eq_list; n_contract = contract }
-
-let program ({ p_nodes = p_node_list } as p) =
-  { p with p_nodes = List.map node p_node_list }
+let program p =
+  let p, () = Mls_mapfold.program_it
+                { Mls_mapfold.defaults with Mls_mapfold.eqs = eqs } () p in p

compiler/utilities/graph.ml

@@ -7,7 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)
 (* graph manipulation *)
-(* $Id$ *)
+
 type 'a graph =
     { g_top: 'a node list;
       g_bot: 'a node list }