[passes] correction of the check not re-init of variables

This commit is contained in:
Arnaud DABY-SEESARAM 2022-12-13 18:08:06 +01:00
parent c441f8b1a6
commit f3416582be
2 changed files with 72 additions and 49 deletions

View File

@ -14,7 +14,7 @@ let exec_passes ast verbose debug passes f =
| [] -> f ast | [] -> f ast
| (n, p) :: passes -> | (n, p) :: passes ->
verbose (Format.asprintf "Executing pass %s:\n" n); verbose (Format.asprintf "Executing pass %s:\n" n);
match p ast with match p verbose debug ast with
| None -> (exit_error ("Error while in the pass "^n^".\n"); exit 0) | None -> (exit_error ("Error while in the pass "^n^".\n"); exit 0)
| Some ast -> ( | Some ast -> (
debug (Format.asprintf "Current AST (after %s):\n%a\n" n Pp.pp_ast ast); debug (Format.asprintf "Current AST (after %s):\n%a\n" n Pp.pp_ast ast);
@ -32,6 +32,7 @@ let _ =
let verbose = ref false in let verbose = ref false in
let debug = ref false in let debug = ref false in
let ppast = ref false in let ppast = ref false in
let nopopt = ref false in
let passes = ref [] in let passes = ref [] in
let source_file = ref "" in let source_file = ref "" in
let output_file = ref "out.c" in let output_file = ref "out.c" in
@ -39,6 +40,7 @@ let _ =
let speclist = let speclist =
[ [
("-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");
("-verbose", Arg.Set verbose, "Output some debug information"); ("-verbose", Arg.Set verbose, "Output some debug information");
("-debug", Arg.Set debug, "Output a lot of debug information"); ("-debug", Arg.Set debug, "Output a lot of debug information");
("-p", Arg.String (fun s -> passes := s :: !passes), ("-p", Arg.String (fun s -> passes := s :: !passes),
@ -52,7 +54,7 @@ let _ =
let print_debug = print_debug !debug in let print_debug = print_debug !debug in
(** Definition of the passes table *) (** Definition of the passes table *)
let passes_table : (string, t_nodelist -> t_nodelist option) Hashtbl.t = Hashtbl.create 100 in let passes_table = Hashtbl.create 100 in
List.iter (fun (s, k) -> Hashtbl.add passes_table s k) List.iter (fun (s, k) -> Hashtbl.add passes_table s k)
[ [
("pre2vars", Passes.pre2vars); ("pre2vars", Passes.pre2vars);
@ -65,7 +67,7 @@ let _ =
let inchan = open_in !source_file in let inchan = open_in !source_file in
try try
begin begin
let _ = Parsing.set_trace true in (**let _ = Parsing.set_trace true in*)
let res = Parser.main Lexer.token (Lexing.from_channel inchan) in let res = Parser.main Lexer.token (Lexing.from_channel inchan) in
close_in inchan; res close_in inchan; res
end end
@ -103,6 +105,9 @@ let _ =
begin begin
if !ppast if !ppast
then (Format.printf "%a" Pp.pp_ast) then (Format.printf "%a" Pp.pp_ast)
else (Format.printf "%a" Ast_to_c.ast_to_c) else (
if !nopopt
then (fun _ -> ())
else Format.printf "%a" Ast_to_c.ast_to_c)
end end

View File

@ -34,7 +34,7 @@ let expression_pass f: t_nodelist -> t_nodelist option =
in in
equation_pass aux equation_pass aux
let pre2vars = let pre2vars verbose debug =
let rec all_pre expr = let rec all_pre expr =
match expr with match expr with
| EMonOp (ty, MOp_pre, expr) -> all_pre expr | EMonOp (ty, MOp_pre, expr) -> all_pre expr
@ -115,62 +115,80 @@ let pre2vars =
in in
expression_pass (Utils.somify aux) expression_pass (Utils.somify aux)
let chkvar_init_unicity : t_nodelist -> t_nodelist option = let chkvar_init_unicity verbose debug : t_nodelist -> t_nodelist option =
let aux (node: t_node) : t_node option = let aux (node: t_node) : t_node option =
let incr_aux h n =
match Hashtbl.find_opt h n with
| None -> failwith "todo, should not happend."
| Some num -> Hashtbl.replace h n (num + 1)
in
let incr_eq h (((_, patt), _): t_equation) =
List.iter (fun v -> incr_aux h (Utils.name_of_var v)) patt
in
let rec incr_eqlist h = function
| [] -> ()
| eq :: eqs -> (incr_eq h eq; incr_eqlist h eqs)
in
let incr_branch h (State (_, eqs, _, _): t_state) = incr_eqlist h eqs in
let incr_automata h ((_, states): t_automaton) =
let acc = Hashtbl.copy h in
List.iter
(fun st ->
let h_st = Hashtbl.copy h in
incr_branch h_st st;
Hashtbl.iter
(fun varname num' ->
match Hashtbl.find_opt acc varname with
| None -> failwith "non!"
| Some num -> Hashtbl.replace acc varname (Int.max num num')
) h_st) states;
Hashtbl.iter (fun v n -> Hashtbl.replace h v n) acc
in
let check_now h : bool=
Hashtbl.fold
(fun varname num old_res ->
if num > 1
then (verbose (Format.asprintf "%s initialized twice!" varname); false)
else old_res) h true
in
(*let purge_initialized h =
Hashtbl.iter
(fun varname num ->
if num > 0
then (verbose (Format.asprintf "Purging %s" varname); Hashtbl.remove h varname)
else ()) h
in*)
let h = Hashtbl.create Config.maxvar in let h = Hashtbl.create Config.maxvar in
let add_var v = let add_var v =
match v with match v with
| IVar s -> Hashtbl.add h s v | IVar s -> Hashtbl.add h s 0
| BVar s -> Hashtbl.add h s v | BVar s -> Hashtbl.add h s 0
| RVar s -> Hashtbl.add h s v | RVar s -> Hashtbl.add h s 0
in in
List.iter add_var (snd node.n_inputs); List.iter add_var (snd node.n_inputs);
List.iter add_var (snd node.n_outputs); List.iter add_var (snd node.n_outputs);
List.iter add_var (snd node.n_local_vars); List.iter add_var (snd node.n_local_vars);
(** Remove the variables initialized in usual equations *)
let check_equations eqs =
List.fold_right (** Usual Equations *)
(fun (((_, patt), _): t_equation) (acc: bool) -> incr_eqlist h node.n_equations;
if acc = false if check_now h = false
then false then None
else else
begin begin
(* assert(acc = true) *) List.iter (* 0. *) (incr_automata h) node.n_automata;
List.fold_right if check_now h
(fun var acc ->
if acc = false
then false
else
begin
let n = Utils.name_of_var var in
match Hashtbl.find_opt h n with
| None -> false
| Some _ -> (Hashtbl.remove h n; true)
end)
patt true
end)
node.n_equations true
in
if check_equations node.n_equations
then
begin
(** Remove the variables initialized in automata *)
if
List.fold_right
(fun (automata: t_automaton) acc ->
if acc = false
then false
else
begin
List.fold_right
(fun (State(_, eqs, _, _): t_state) acc -> acc && check_equations eqs)
(snd automata) true
end)
node.n_automata true
then Some node then Some node
else None else None
end end
else None (** never purge -> failwith never executed! purge_initialized h; *)
in in
node_pass aux node_pass aux