Compare commits

..

2 Commits

Author SHA1 Message Date
Arnaud DABY-SEESARAM
6459c54159 [passes] ordering equations 2022-12-15 17:11:19 +01:00
Arnaud DABY-SEESARAM
9151a6e29a [tests] adding the -test option to duplicate sanity checks 2022-12-15 17:11:19 +01:00
3 changed files with 63 additions and 7 deletions

View File

@ -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,
match Hashtbl.find_opt passes_table pass with
| None ->
(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))) !passes in
let passes =
List.map
(fun (pass: string) -> (pass,
match Hashtbl.find_opt passes_table pass with
| None ->
(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) ;

View File

@ -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

View File

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