From db5c5844355a6547a65d7c15c06a2c6165aad9aa Mon Sep 17 00:00:00 2001 From: Arnaud DABY-SEESARAM Date: Thu, 15 Dec 2022 17:40:15 +0100 Subject: [PATCH] [passes] fix for the equation ordering pass --- .gitignore | 8 ++++++++ src/main.ml | 2 +- src/passes.ml | 28 +++++++++------------------- src/passes_utils.ml | 2 +- src/pp.ml | 3 ++- src/utils.ml | 19 ++++++++++++++++++- 6 files changed, 39 insertions(+), 23 deletions(-) diff --git a/.gitignore b/.gitignore index a9d45b3..6869629 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,10 @@ _build tags +beamer.aux +beamer.log +beamer.nav +beamer.out +beamer.pdf +beamer.snm +beamer.toc +texput.log diff --git a/src/main.ml b/src/main.ml index 3130b66..2df8c12 100644 --- a/src/main.ml +++ b/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"); diff --git a/src/passes.ml b/src/passes.ml index b54626e..34363ff 100644 --- a/src/passes.ml +++ b/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 = diff --git a/src/passes_utils.ml b/src/passes_utils.ml index d925ef1..f1a6426 100644 --- a/src/passes_utils.ml +++ b/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 diff --git a/src/pp.ml b/src/pp.ml index 378cd65..11aa484 100644 --- a/src/pp.ml +++ b/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 diff --git a/src/utils.ml b/src/utils.ml index afadb9f..58e09f3 100644 --- a/src/utils.ml +++ b/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) +