[passes] correction of the check not re-init of variables
This commit is contained in:
Arnaud DABY-SEESARAM
parent
c441f8b1a6
commit
f3416582be
13
src/main.ml
13
src/main.ml
@ -14,7 +14,7 @@ let exec_passes ast verbose debug passes f =
|
||||
| [] -> f ast
|
||||
| (n, p) :: passes ->
|
||||
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)
|
||||
| Some 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 debug = ref false in
|
||||
let ppast = ref false in
|
||||
let nopopt = ref false in
|
||||
let passes = ref [] in
|
||||
let source_file = ref "" in
|
||||
let output_file = ref "out.c" in
|
||||
@ -39,6 +40,7 @@ let _ =
|
||||
let speclist =
|
||||
[
|
||||
("-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");
|
||||
("-debug", Arg.Set debug, "Output a lot of debug information");
|
||||
("-p", Arg.String (fun s -> passes := s :: !passes),
|
||||
@ -52,7 +54,7 @@ let _ =
|
||||
let print_debug = print_debug !debug in
|
||||
|
||||
(** 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)
|
||||
[
|
||||
("pre2vars", Passes.pre2vars);
|
||||
@ -65,7 +67,7 @@ let _ =
|
||||
let inchan = open_in !source_file in
|
||||
try
|
||||
begin
|
||||
let _ = Parsing.set_trace true in
|
||||
(**let _ = Parsing.set_trace true in*)
|
||||
let res = Parser.main Lexer.token (Lexing.from_channel inchan) in
|
||||
close_in inchan; res
|
||||
end
|
||||
@ -103,6 +105,9 @@ let _ =
|
||||
begin
|
||||
if !ppast
|
||||
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
|
||||
|
||||
|
||||
108
src/passes.ml
108
src/passes.ml
@ -34,7 +34,7 @@ let expression_pass f: t_nodelist -> t_nodelist option =
|
||||
in
|
||||
equation_pass aux
|
||||
|
||||
let pre2vars =
|
||||
let pre2vars verbose debug =
|
||||
let rec all_pre expr =
|
||||
match expr with
|
||||
| EMonOp (ty, MOp_pre, expr) -> all_pre expr
|
||||
@ -115,62 +115,80 @@ let pre2vars =
|
||||
in
|
||||
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 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 add_var v =
|
||||
match v with
|
||||
| IVar s -> Hashtbl.add h s v
|
||||
| BVar s -> Hashtbl.add h s v
|
||||
| RVar s -> Hashtbl.add h s v
|
||||
| IVar s -> Hashtbl.add h s 0
|
||||
| BVar s -> Hashtbl.add h s 0
|
||||
| RVar s -> Hashtbl.add h s 0
|
||||
in
|
||||
List.iter add_var (snd node.n_inputs);
|
||||
List.iter add_var (snd node.n_outputs);
|
||||
List.iter add_var (snd node.n_local_vars);
|
||||
(** Remove the variables initialized in usual equations *)
|
||||
let check_equations eqs =
|
||||
List.fold_right
|
||||
(fun (((_, patt), _): t_equation) (acc: bool) ->
|
||||
if acc = false
|
||||
then false
|
||||
else
|
||||
begin
|
||||
(* assert(acc = true) *)
|
||||
List.fold_right
|
||||
(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
|
||||
|
||||
|
||||
(** Usual Equations *)
|
||||
incr_eqlist h node.n_equations;
|
||||
if check_now h = false
|
||||
then None
|
||||
else
|
||||
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
|
||||
List.iter (* 0. *) (incr_automata h) node.n_automata;
|
||||
if check_now h
|
||||
then Some node
|
||||
else None
|
||||
end
|
||||
else None
|
||||
(** never purge -> failwith never executed! purge_initialized h; *)
|
||||
|
||||
in
|
||||
node_pass aux
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user