Compare commits
No commits in common. "6459c541599eb2a4d2d9307d8080b952775ace0f" and "19fd3bc1b92985f44bd11ccac648688d162a9c0c" have entirely different histories.
6459c54159
...
19fd3bc1b9
19
src/main.ml
19
src/main.ml
@ -25,8 +25,7 @@ let exec_passes ast main_fn verbose debug passes f =
|
|||||||
|
|
||||||
let _ =
|
let _ =
|
||||||
(** Usage and argument parsing. *)
|
(** Usage and argument parsing. *)
|
||||||
let default_passes = ["pre2vars"; "linearization"; "equations_ordering"] in
|
let default_passes = ["chkvar_init_unicity"; "pre2vars"; "linearization"] in
|
||||||
let sanity_passes = ["chkvar_init_unicity"] in
|
|
||||||
let usage_msg =
|
let usage_msg =
|
||||||
"Usage: main [-passes p1,...,pn] [-ast] [-verbose] [-debug] \
|
"Usage: main [-passes p1,...,pn] [-ast] [-verbose] [-debug] \
|
||||||
[-o output_file] [-m main_function] source_file\n" in
|
[-o output_file] [-m main_function] source_file\n" in
|
||||||
@ -38,14 +37,10 @@ let _ =
|
|||||||
let passes = ref [] in
|
let passes = ref [] in
|
||||||
let main_fn = ref "main" in
|
let main_fn = ref "main" in
|
||||||
let source_file = ref "" in
|
let source_file = ref "" in
|
||||||
let testopt = ref false in
|
|
||||||
let output_file = ref "out.c" in
|
let output_file = ref "out.c" in
|
||||||
let anon_fun filename = source_file := filename in
|
let anon_fun filename = source_file := filename in
|
||||||
let speclist =
|
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");
|
("-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");
|
||||||
@ -71,7 +66,6 @@ let _ =
|
|||||||
("pre2vars", Passes.pre2vars);
|
("pre2vars", Passes.pre2vars);
|
||||||
("chkvar_init_unicity", Passes.chkvar_init_unicity);
|
("chkvar_init_unicity", Passes.chkvar_init_unicity);
|
||||||
("linearization", Passes.pass_linearization);
|
("linearization", Passes.pass_linearization);
|
||||||
("equations_ordering", Passes.pass_eq_reordering);
|
|
||||||
];
|
];
|
||||||
|
|
||||||
(** Main functionality below *)
|
(** Main functionality below *)
|
||||||
@ -105,19 +99,12 @@ let _ =
|
|||||||
end
|
end
|
||||||
in
|
in
|
||||||
|
|
||||||
let passes =
|
let passes = List.map (fun (pass: string) -> (pass,
|
||||||
List.map
|
|
||||||
(fun (pass: string) -> (pass,
|
|
||||||
match Hashtbl.find_opt passes_table pass with
|
match Hashtbl.find_opt passes_table pass with
|
||||||
| None ->
|
| None ->
|
||||||
(exit_error (Format.sprintf "The pass %s does not exist.\n" pass); exit 0)
|
(exit_error (Format.sprintf "The pass %s does not exist.\n" pass); exit 0)
|
||||||
| Some f ->
|
| Some f ->
|
||||||
(print_debug ("The pass "^pass^" has been selected.\n"); f)))
|
(print_debug ("The pass "^pass^" has been selected.\n"); f))) !passes in
|
||||||
(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"
|
print_debug (Format.asprintf "Initial AST (before executing any passes):\n%a"
|
||||||
Pp.pp_ast ast) ;
|
Pp.pp_ast ast) ;
|
||||||
|
@ -159,7 +159,6 @@ let pass_linearization verbose debug main_fn =
|
|||||||
let rec tpl ((pat, exp): t_equation) =
|
let rec tpl ((pat, exp): t_equation) =
|
||||||
match exp with
|
match exp with
|
||||||
| ETuple (_, hexps :: texps) ->
|
| ETuple (_, hexps :: texps) ->
|
||||||
debug "An ETuple has been recognized, inlining...";
|
|
||||||
let p1, p2 =
|
let p1, p2 =
|
||||||
Utils.list_select
|
Utils.list_select
|
||||||
(List.length (Utils.type_exp hexps))
|
(List.length (Utils.type_exp hexps))
|
||||||
@ -192,43 +191,3 @@ let pass_linearization verbose debug main_fn =
|
|||||||
}
|
}
|
||||||
in
|
in
|
||||||
node_pass node_lin
|
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
|
|
||||||
|
@ -31,5 +31,3 @@ let expression_pass f: t_nodelist -> t_nodelist option =
|
|||||||
| Some expr -> Some (patt, expr)
|
| Some expr -> Some (patt, expr)
|
||||||
in
|
in
|
||||||
equation_pass aux
|
equation_pass aux
|
||||||
|
|
||||||
exception EquatiobnOrderingIssue
|
|
||||||
|
Loading…
Reference in New Issue
Block a user