[passes] fix for the equation ordering pass

This commit is contained in:
Arnaud DABY-SEESARAM 2022-12-15 17:40:15 +01:00
parent 6459c54159
commit db5c584435
6 changed files with 39 additions and 23 deletions

8
.gitignore vendored
View File

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

View File

@ -45,7 +45,7 @@ let _ =
[ [
("-test", Arg.Set testopt, "Runs the sanity passes not only at the \ ("-test", Arg.Set testopt, "Runs the sanity passes not only at the \
begining of the compilation, but also after \ 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"); ("-ast", Arg.Set ppast, "Only print the AST of the input file");
("-nop", Arg.Set nopopt, "Only computes the AST and execute the passes"); ("-nop", Arg.Set nopopt, "Only computes the AST and execute the passes");
("-verbose", Arg.Set verbose, "Output some debug information"); ("-verbose", Arg.Set verbose, "Output some debug information");

View File

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

View File

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

View File

@ -136,7 +136,8 @@ let pp_expression =
let rec pp_equations fmt: t_eqlist -> unit = function let rec pp_equations fmt: t_eqlist -> unit = function
| [] -> () | [] -> ()
| (patt, expr) :: eqs -> | (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) debug_type_pp (Utils.type_exp expr)
pp_varlist patt pp_varlist patt
pp_expression expr pp_expression expr

View File

@ -22,7 +22,7 @@ let rec list_chk v = function
| [] -> false | [] -> false
| h :: t -> if h = v then true else list_chk v t | 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) = let type_var (v: t_var) =
match v with 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) = [] if List.filter (fun v -> name_of_var v = name) (snd l) = []
then name then name
else fresh_var_name l n 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)