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

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
 

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
+      | 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
     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
+    (** 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
         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
             else None
         end
-      else None
+    (** never purge -> failwith never executed! purge_initialized h; *)
+
   in
   node_pass aux