[passes] fix for the equation ordering pass

.gitignore

@@ -1,2 +1,10 @@
 _build
 tags
+beamer.aux
+beamer.log
+beamer.nav
+beamer.out
+beamer.pdf
+beamer.snm
+beamer.toc
+texput.log

src/main.ml

@@ -45,7 +45,7 @@ let _ =
     [
       ("-test", Arg.Set testopt, "Runs the sanity passes not only at the \
                                 begining of the compilation, but also after \
-                                each pass altering then AST.");
+                                each pass altering the 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");

src/passes.ml

@@ -194,18 +194,6 @@ let pass_linearization verbose debug main_fn =
   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
@@ -215,14 +203,16 @@ let pass_eq_reordering verbose debug main_fn ast =
                 (fun (patt, expr) ->
                   List.for_all
                     (fun v -> List.mem v init_vars)
-                    (vars_of_expr expr))
+                    (Utils.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)
+        | [] -> raise EquationOrderingIssue
+        | h :: t ->
+            let init_vars =
+              List.fold_left
+                (fun acc vs ->
+                  acc @ (Utils.vars_of_patt (fst vs))) init_vars (h :: t) in
+            pick_equations init_vars (eqs@(h :: t))
+              (List.filter (fun eq -> List.for_all (fun e -> eq <> e) (h :: t)) remaining_equations)
       end
     in
   let node_eq_reorganising  (node: t_node): t_node option =

src/passes_utils.ml

@@ -32,4 +32,4 @@ let expression_pass f: t_nodelist -> t_nodelist option =
   in
   equation_pass aux
 
-exception EquatiobnOrderingIssue
+exception EquationOrderingIssue

src/pp.ml

@@ -136,7 +136,8 @@ let pp_expression =
 let rec pp_equations fmt: t_eqlist -> unit = function
   | [] -> ()
   | (patt, expr) :: eqs ->
-      Format.fprintf fmt "\t\t∗ Equation of type : %a\n\t\t  left side: %a\n\t\t  right side:\n%a\n%a"
+      Format.fprintf fmt "\t\t∗ Equation of type : %a\n\t\t  left side: %a\n\
+                          \t\t  right side:\n%a\n\n%a"
         debug_type_pp (Utils.type_exp expr)
         pp_varlist patt
         pp_expression expr

src/utils.ml

@@ -22,7 +22,7 @@ let rec list_chk v = function
   | [] -> false
   | h :: t -> if h = v then true else list_chk v t
 
-exception MyParsingError of (string * Ast.location)
+exception MyParsingError of (string * location)
 
 let type_var (v: t_var) =
     match v with
@@ -60,3 +60,20 @@ let rec fresh_var_name (l: t_varlist) n : ident =
   if List.filter (fun v -> name_of_var v = name) (snd l) = []
     then name
     else fresh_var_name l n
+
+let vars_of_patt patt = List.map name_of_var (snd patt)
+
+let rec vars_of_expr (expr: t_expression) : ident list =
+  match expr with
+  | EConst _ -> []
+  | EVar   (_, v) -> [name_of_var v]
+    (** pre (e) does not rely on anything in this round *)
+  | EMonOp (_, MOp_pre, _) -> []
+  | 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)
+