[passes] ordering equations

src/main.ml

@@ -25,7 +25,8 @@ let exec_passes ast main_fn verbose debug passes f =
 
 let _ =
   (** Usage and argument parsing. *)
-  let default_passes = ["chkvar_init_unicity"; "pre2vars"; "linearization"] in
+  let default_passes = ["pre2vars"; "linearization"; "equations_ordering"] in
+  let sanity_passes = ["chkvar_init_unicity"] in
   let usage_msg =
     "Usage: main [-passes p1,...,pn] [-ast] [-verbose] [-debug] \
       [-o output_file] [-m main_function] source_file\n" in
@@ -37,10 +38,14 @@ let _ =
   let passes = ref [] in
   let main_fn = ref "main" in
   let source_file = ref "" in
+  let testopt = ref false in
   let output_file = ref "out.c" in
   let anon_fun filename = source_file := filename in
   let speclist =
     [
+      ("-test", Arg.Set testopt, "Runs the sanity passes not only at the \
+                                begining of the compilation, but also after \
+                                each pass altering then AST.");
       ("-ast", Arg.Set ppast, "Only print the AST of the input file");
       ("-nop", Arg.Set nopopt, "Only computes the AST and execute the passes");
       ("-verbose", Arg.Set verbose, "Output some debug information");
@@ -66,6 +71,7 @@ let _ =
       ("pre2vars", Passes.pre2vars);
       ("chkvar_init_unicity", Passes.chkvar_init_unicity);
       ("linearization", Passes.pass_linearization);
+      ("equations_ordering", Passes.pass_eq_reordering);
     ];
 
   (** Main functionality below *)
@@ -99,12 +105,19 @@ let _ =
       end
     in
 
-  let passes = List.map (fun (pass: string) -> (pass,
+  let passes =
-    match Hashtbl.find_opt passes_table pass with
+    List.map
-    | None ->
+      (fun (pass: string) -> (pass,
-      (exit_error (Format.sprintf "The pass %s does not exist.\n" pass); exit 0)
+        match Hashtbl.find_opt passes_table pass with
-    | Some f ->
+        | None ->
-      (print_debug ("The pass "^pass^" has been selected.\n"); f))) !passes in
+          (exit_error (Format.sprintf "The pass %s does not exist.\n" pass); exit 0)
+        | Some f ->
+          (print_debug ("The pass "^pass^" has been selected.\n"); f)))
+      (sanity_passes @
+        if !testopt
+          then List.flatten (List.map (fun p -> p :: sanity_passes) !passes)
+          else !passes)
+    in
 
   print_debug (Format.asprintf "Initial AST (before executing any passes):\n%a"
                 Pp.pp_ast ast) ;

src/passes.ml

@@ -159,6 +159,7 @@ let pass_linearization verbose debug main_fn =
     let rec tpl ((pat, exp): t_equation) =
       match exp with
       | ETuple (_, hexps :: texps) ->
+          debug "An ETuple has been recognized, inlining...";
           let p1, p2 =
             Utils.list_select
               (List.length (Utils.type_exp hexps))
@@ -191,3 +192,43 @@ let pass_linearization verbose debug main_fn =
       }
   in
   node_pass node_lin
+
+let pass_eq_reordering verbose debug main_fn ast =
+  let vars_of_patt patt = List.map Utils.name_of_var (snd patt) in
+  let rec vars_of_expr (expr: t_expression) : ident list =
+    match expr with
+    | EConst _ -> []
+    | EVar   (_, v) -> [Utils.name_of_var v]
+    | EApp (_, _, e) | EMonOp (_, _, e) -> vars_of_expr e
+    | EComp  (_, _, e, e') | EReset (_, e, e') | EBinOp (_, _, e, e') | EWhen  (_, e, e')
+        -> (vars_of_expr e) @ (vars_of_expr e')
+    | ETriOp (_, _, e, e', e'') ->
+        (vars_of_expr e) @ (vars_of_expr e') @ (vars_of_expr e'')
+    | ETuple (_, l) -> List.flatten (List.map vars_of_expr l)
+    in
+  let rec pick_equations init_vars eqs remaining_equations =
+    match remaining_equations with
+    | [] -> Some eqs
+    | _ ->
+      begin
+        match List.filter
+                (fun (patt, expr) ->
+                  List.for_all
+                    (fun v -> List.mem v init_vars)
+                    (vars_of_expr expr))
+                remaining_equations with
+        | [] -> raise EquatiobnOrderingIssue
+        | (p, e) :: _ ->
+            pick_equations
+              (init_vars @ (vars_of_patt p))
+              ((p, e) :: eqs)
+              (List.filter (fun eq -> eq <> (p, e)) remaining_equations)
+      end
+    in
+  let node_eq_reorganising  (node: t_node): t_node option =
+    let init_vars = List.map Utils.name_of_var (snd node.n_inputs) in
+    match pick_equations init_vars [] node.n_equations with
+    | None -> None
+    | Some eqs -> Some { node with n_equations = eqs }
+ in
+  node_pass node_eq_reorganising ast

src/passes_utils.ml

@@ -31,3 +31,5 @@ let expression_pass f: t_nodelist -> t_nodelist option =
     | Some expr -> Some (patt, expr)
   in
   equation_pass aux
+
+exception EquatiobnOrderingIssue