diff --git a/src/main.ml b/src/main.ml index b7e26b6..447e598 100644 --- a/src/main.ml +++ b/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 diff --git a/src/passes.ml b/src/passes.ml index a7977c3..8428d9d 100644 --- a/src/passes.ml +++ b/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