Coccinelle release 1.0.0-rc3
[bpt/coccinelle.git] / cocci.ml
index 8073594..ef8c893 100644 (file)
--- a/cocci.ml
+++ b/cocci.ml
@@ -44,39 +44,65 @@ module Ast_to_flow = Control_flow_c_build
 (* --------------------------------------------------------------------- *)
 (* C related *)
 (* --------------------------------------------------------------------- *)
-let cprogram_of_file file =
-  let (program2, _stat) = Parse_c.parse_c_and_cpp file in
+let cprogram_of_file saved_typedefs saved_macros file =
+  let (program2, _stat) =
+    Parse_c.parse_c_and_cpp_keep_typedefs
+      (Some saved_typedefs) (Some saved_macros) file in
   program2
 
 let cprogram_of_file_cached file =
-  let (program2, _stat) = Parse_c.parse_cache file in
+  let ((program2,typedefs,macros), _stat) = Parse_c.parse_cache file in
   if !Flag_cocci.ifdef_to_if
   then
-    program2 +> Parse_c.with_program2 (fun asts ->
-      Cpp_ast_c.cpp_ifdef_statementize asts
-    )
-  else program2
+    let p2 =
+      program2 +> Parse_c.with_program2 (fun asts ->
+       Cpp_ast_c.cpp_ifdef_statementize asts
+         ) in
+    (p2,typedefs,macros)
+  else (program2,typedefs,macros)
 
 let cfile_of_program program2_with_ppmethod outf =
   Unparse_c.pp_program program2_with_ppmethod outf
 
 (* for memoization, contains only one entry, the one for the SP *)
 let _hparse = Hashtbl.create 101
+let _h_ocaml_init = Hashtbl.create 101
 let _hctl = Hashtbl.create 101
 
 (* --------------------------------------------------------------------- *)
 (* Cocci related *)
 (* --------------------------------------------------------------------- *)
-let sp_of_file2 file iso   =
-  Common.memoized _hparse (file, iso) (fun () ->
-    let (_,xs,_,_,_,_,_,_) as res = Parse_cocci.process file iso false in
-    (match Prepare_ocamlcocci.prepare file xs with
-      None -> ()
-    | Some ocaml_script_file ->
-        (* compile file *)
-       Prepare_ocamlcocci.load_file ocaml_script_file;
-       Prepare_ocamlcocci.clean_file ocaml_script_file);
-    res)
+(* for a given pair (file,iso), only keep an instance for the most recent
+virtual rules and virtual_env *)
+
+let sp_of_file2 file iso =
+  let redo _ =
+    let new_code =
+      let (_,xs,_,_,_,_,_) as res = Parse_cocci.process file iso false in
+      (* if there is already a compiled ML code, do nothing and use that *)
+      try let _ = Hashtbl.find _h_ocaml_init (file,iso) in res
+      with Not_found ->
+       begin
+         Hashtbl.add _h_ocaml_init (file,iso) ();
+         match Prepare_ocamlcocci.prepare file xs with
+             None -> res
+           | Some ocaml_script_file ->
+             (* compile file *)
+             Prepare_ocamlcocci.load_file ocaml_script_file;
+             (if not !Common.save_tmp_files
+              then Prepare_ocamlcocci.clean_file ocaml_script_file);
+             res
+       end in
+    Hashtbl.add _hparse (file,iso)
+      (!Flag.defined_virtual_rules,!Flag.defined_virtual_env,new_code);
+    new_code in
+  try
+    let (rules,env,code) = Hashtbl.find _hparse (file,iso) in
+    if rules = !Flag.defined_virtual_rules && env = !Flag.defined_virtual_env
+    then code
+    else (Hashtbl.remove _hparse (file,iso); redo())
+  with Not_found -> redo()
+    
 let sp_of_file file iso    =
   Common.profile_code "parse cocci" (fun () -> sp_of_file2 file iso)
 
@@ -268,24 +294,26 @@ let show_or_not_diff2 cfile outfile =
              let diff_line =
                match List.rev(Str.split (Str.regexp " ") line) with
                  new_file::old_file::cmdrev ->
+                   let old_base_file = drop_prefix old_file in
                    if !Flag.sgrep_mode2
                    then
                      String.concat " "
-                       (List.rev ("/tmp/nothing" :: old_file :: cmdrev))
+                       (List.rev
+                          (("/tmp/nothing"^old_base_file)
+                           :: old_file :: cmdrev))
                    else
-                     let old_base_file = drop_prefix old_file in
                      String.concat " "
                        (List.rev
                           (("b"^old_base_file)::("a"^old_base_file)::cmdrev))
                | _ -> failwith "bad command" in
              let (minus_line,plus_line) =
-               if !Flag.sgrep_mode2
-               then (minus_file,"+++ /tmp/nothing")
-               else
-                 match (Str.split (Str.regexp "[ \t]") minus_file,
-                        Str.split (Str.regexp "[ \t]") plus_file) with
-                   ("---"::old_file::old_rest,"+++"::new_file::new_rest) ->
-                     let old_base_file = drop_prefix old_file in
+               match (Str.split (Str.regexp "[ \t]") minus_file,
+                      Str.split (Str.regexp "[ \t]") plus_file) with
+                 ("---"::old_file::old_rest,"+++"::new_file::new_rest) ->
+                   let old_base_file = drop_prefix old_file in
+                   if !Flag.sgrep_mode2
+                   then (minus_file,"+++ /tmp/nothing"^old_base_file)
+                   else
                      (String.concat " "
                         ("---"::("a"^old_base_file)::old_rest),
                       String.concat " "
@@ -307,6 +335,12 @@ let show_or_not_diff a b =
 
 let show_or_not_ctl_tex2 astcocci ctls =
   if !Flag_cocci.show_ctl_tex then begin
+    let ctls =
+      List.map
+       (List.map
+          (function ((Asttoctl2.NONDECL ctl | Asttoctl2.CODE ctl),x) ->
+            (ctl,x)))
+       ctls in
     Ctltotex.totex ("/tmp/__cocci_ctl.tex") astcocci ctls;
     Common.command2 ("cd /tmp; latex __cocci_ctl.tex; " ^
                     "dvips __cocci_ctl.dvi -o __cocci_ctl.ps;" ^
@@ -352,7 +386,7 @@ let show_or_not_ctl_text2 ctl ast rulenb =
       );
 
     pr "CTL = ";
-    let (ctl,_) = ctl in
+    let ((Asttoctl2.CODE ctl | Asttoctl2.NONDECL ctl),_) = ctl in
     adjust_pp_with_indent (fun () ->
       Format.force_newline();
       Pretty_print_engine.pp_ctlcocci
@@ -516,7 +550,7 @@ let sp_contain_typed_metavar_z toplevel_list_list =
   let combiner =
     Visitor_ast.combiner bind option_default
       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
-      donothing donothing donothing donothing
+      donothing donothing donothing donothing donothing
       donothing expression donothing donothing donothing donothing donothing
       donothing donothing donothing donothing donothing
   in
@@ -548,32 +582,60 @@ let sp_contain_typed_metavar rules =
  * For the moment we base in part our heuristic on the name of the file, e.g.
  * serio.c is related we think to #include <linux/serio.h>
  *)
-let rec search_include_path searchlist relpath =
-  match searchlist with
-      []       -> Some relpath
-    | hd::tail ->
-       let file = Filename.concat hd relpath in
-       if Sys.file_exists file then
-         Some file
-       else
-         search_include_path tail relpath
+let include_table = Hashtbl.create(100)
 
 let interpret_include_path relpath =
+  let maxdepth = List.length relpath in
+  let unique_file_exists dir f =
+    let cmd =
+      Printf.sprintf "find %s -maxdepth %d -mindepth %d -path \"*/%s\""
+       dir maxdepth maxdepth f in
+    match Common.cmd_to_list cmd with
+      [x] -> Some x
+    | _ -> None in
+  let native_file_exists dir f =
+    let f = Filename.concat dir f in
+    if Sys.file_exists f
+    then Some f
+    else None in
+  let rec search_include_path exists searchlist relpath =
+    match searchlist with
+      []       -> None
+    | hd::tail ->
+       (match exists hd relpath with
+         Some x -> Some x
+       | None -> search_include_path exists tail relpath) in
+  let rec search_path exists searchlist = function
+      [] ->
+       let res = Common.concat "/" relpath in
+       Hashtbl.add include_table (searchlist,relpath) res;
+       Some res
+    | (hd::tail) as relpath1 ->
+       let relpath1 = Common.concat "/" relpath1 in
+       (match search_include_path exists searchlist relpath1 with
+         None -> search_path unique_file_exists searchlist tail
+       | Some f ->
+           Hashtbl.add include_table (searchlist,relpath) f;
+           Some f) in
   let searchlist =
     match !Flag_cocci.include_path with
-       [] -> ["include"]
-      | x -> List.rev x
-  in
-    search_include_path searchlist relpath
+      [] -> ["include"]
+    | x -> List.rev x in
+  try Some(Hashtbl.find include_table (searchlist,relpath))
+  with Not_found ->
+    search_path native_file_exists searchlist relpath
 
 let (includes_to_parse:
-       (Common.filename * Parse_c.program2) list ->
+       (Common.filename * Parse_c.extended_program2) list ->
         Flag_cocci.include_options -> 'a) = fun xs choose_includes ->
   match choose_includes with
     Flag_cocci.I_UNSPECIFIED -> failwith "not possible"
   | Flag_cocci.I_NO_INCLUDES -> []
   | x ->
-      let all_includes = x =*= Flag_cocci.I_ALL_INCLUDES in
+      let all_includes =
+       List.mem x
+         [Flag_cocci.I_ALL_INCLUDES; Flag_cocci.I_REALLY_ALL_INCLUDES] in
+      let xs = List.map (function (file,(cs,_,_)) -> (file,cs)) xs in
       xs +> List.map (fun (file, cs) ->
        let dir = Common.dirname file in
 
@@ -585,7 +647,7 @@ let (includes_to_parse:
            (match x with
             | Ast_c.Local xs ->
                let relpath = Common.join "/" xs in
-               let f = Filename.concat dir (relpath) in
+               let f = Filename.concat dir relpath in
                if (Sys.file_exists f) then
                  Some f
                else
@@ -595,24 +657,23 @@ let (includes_to_parse:
                    let attempt2 = Filename.concat dir (Common.last xs) in
                      if not (Sys.file_exists attempt2) && all_includes
                      then
-                       interpret_include_path relpath
+                       interpret_include_path xs
                      else Some attempt2
                  else
-                   if all_includes then interpret_include_path relpath
+                   if all_includes then interpret_include_path xs
                    else None
 
             | Ast_c.NonLocal xs ->
-               let relpath = Common.join "/" xs in
                if all_includes ||
                Common.fileprefix (Common.last xs) =$= Common.fileprefix file
                then
-                 interpret_include_path relpath
+                 interpret_include_path xs
                else None
             | Ast_c.Weird _ -> None
                  )
          | _ -> None))
        +> List.concat
-       +> Common.uniq
+       +> (fun x -> (List.rev (Common.uniq (List.rev x)))) (*uniq keeps last*)
 
 let rec interpret_dependencies local global = function
     Ast_cocci.Dep s      -> List.mem s local
@@ -761,6 +822,9 @@ type toplevel_c_info = {
 
   was_modified: bool ref;
 
+  all_typedefs: (string, Lexer_parser.identkind) Common.scoped_h_env;
+  all_macros: (string, Cpp_token_c.define_def) Hashtbl.t;
+
   (* id: int *)
 }
 
@@ -785,7 +849,7 @@ type toplevel_cocci_info_script_rule = {
 }
 
 type toplevel_cocci_info_cocci_rule = {
-  ctl: Lib_engine.ctlcocci * (CCI.pred list list);
+  ctl: Asttoctl2.top_formula * (CCI.pred list list);
   metavars: Ast_cocci.metavar list;
   ast_rule: Ast_cocci.rule;
   isexp: bool; (* true if + code is an exp, only for Flag.make_hrule *)
@@ -948,7 +1012,7 @@ let prepare_cocci ctls free_var_lists negated_pos_lists
 
 (* --------------------------------------------------------------------- *)
 
-let build_info_program cprogram env =
+let build_info_program (cprogram,typedefs,macros) env =
 
   let (cs, parseinfos) =
     Common.unzip cprogram in
@@ -994,6 +1058,9 @@ let build_info_program cprogram env =
       env_typing_after = envb;
 
       was_modified = ref false;
+
+      all_typedefs = typedefs;
+      all_macros = macros;
     }
   )
 
@@ -1010,7 +1077,7 @@ let rebuild_info_program cs file isexp =
         file;
 
       (* Common.command2 ("cat " ^ file); *)
-      let cprogram = cprogram_of_file file in
+      let cprogram = cprogram_of_file c.all_typedefs c.all_macros file in
       let xs = build_info_program cprogram c.env_typing_before in
 
       (* TODO: assert env has not changed,
@@ -1034,63 +1101,75 @@ let rebuild_info_c_and_headers ccs isexp =
       rebuild_info_program c_or_h.asts c_or_h.full_fname isexp }
   )
 
-
+let rec prepare_h seen env hpath choose_includes : file_info list =
+  if not (Common.lfile_exists hpath)
+  then
+    begin
+      pr2_once ("TYPE: header " ^ hpath ^ " not found");
+      []
+    end
+  else
+    begin
+      let h_cs = cprogram_of_file_cached hpath in
+      let local_includes =
+       if choose_includes =*= Flag_cocci.I_REALLY_ALL_INCLUDES
+       then
+         List.filter
+           (function x -> not (List.mem x !seen))
+           (includes_to_parse [(hpath,h_cs)] choose_includes)
+       else [] in
+      seen := local_includes @ !seen;
+      let others =
+       List.concat
+         (List.map (function x -> prepare_h seen env x choose_includes)
+            local_includes) in
+      let info_h_cs = build_info_program h_cs !env in
+      env :=
+       if null info_h_cs
+       then !env
+       else last_env_toplevel_c_info info_h_cs;
+      others@
+      [{
+       fname = Common.basename hpath;
+       full_fname = hpath;
+       asts = info_h_cs;
+       was_modified_once = ref false;
+       fpath = hpath;
+       fkind = Header;
+      }]
+    end
 
 let prepare_c files choose_includes : file_info list =
   let cprograms = List.map cprogram_of_file_cached files in
   let includes = includes_to_parse (zip files cprograms) choose_includes in
+  let seen = ref includes in
 
   (* todo?: may not be good to first have all the headers and then all the c *)
-  let all =
-    (includes +> List.map (fun hpath -> Right hpath))
-    ++
-    ((zip files cprograms) +>
-     List.map (fun (file, asts) -> Left (file, asts)))
-  in
-
   let env = ref !TAC.initial_env in
 
-  let ccs = all +> Common.map_filter (fun x ->
-    match x with
-    | Right hpath ->
-        if not (Common.lfile_exists hpath)
-        then begin
-          pr2 ("TYPE: header " ^ hpath ^ " not found");
-          None
-        end
-        else
-          let h_cs = cprogram_of_file_cached hpath in
-          let info_h_cs = build_info_program h_cs !env in
-          env :=
-            if null info_h_cs
-            then !env
-            else last_env_toplevel_c_info info_h_cs
-          ;
-          Some {
-            fname = Common.basename hpath;
-            full_fname = hpath;
-            asts = info_h_cs;
-            was_modified_once = ref false;
-            fpath = hpath;
-            fkind = Header;
-          }
-    | Left (file, cprogram) ->
-        (* todo?: don't update env ? *)
+  let includes =
+    includes +>
+    List.map (function hpath -> prepare_h seen env hpath choose_includes) +>
+    List.concat in
+
+  let cfiles =
+    (zip files cprograms) +>
+    List.map
+      (function (file, cprogram) ->
+      (* todo?: don't update env ? *)
         let cs = build_info_program cprogram !env in
         (* we do that only for the c, not for the h *)
         ignore(update_include_rel_pos (cs +> List.map (fun x -> x.ast_c)));
-        Some {
-          fname = Common.basename file;
-          full_fname = file;
-          asts = cs;
-          was_modified_once = ref false;
-          fpath = file;
-          fkind = Source;
-        }
-  )
-  in
-  ccs
+        {
+        fname = Common.basename file;
+        full_fname = file;
+        asts = cs;
+        was_modified_once = ref false;
+        fpath = file;
+        fkind = Source
+      }) in
 
+  includes @ cfiles
 
 (*****************************************************************************)
 (* Processing the ctls and toplevel C elements *)
@@ -1202,6 +1281,7 @@ let ocaml_application mv ve script_vars r =
     else None
   with e -> (pr2 ("Failure in " ^ r.scr_rule_info.rulename); raise e)
 
+(* returns Left in case of dependency failure, Right otherwise *)
 let apply_script_rule r cache newes e rules_that_have_matched
     rules_that_have_ever_matched script_application =
   Common.profile_code r.language (fun () ->
@@ -1231,21 +1311,23 @@ let apply_script_rule r cache newes e rules_that_have_matched
                List.exists (function (_,(r,m),_) -> r =*= re && m =$= rm) mv)
              e in
          (try
-           let script_vals =  List.assoc relevant_bindings cache in
-           print_dependencies
-             "dependencies for script satisfied, but cached:"
-             rules_that_have_matched
-             !rules_that_have_ever_matched
-             r.scr_rule_info.dependencies;
-           show_or_not_binding "in" e;
+           match List.assoc relevant_bindings cache with
+             None -> (cache,newes)
+           | Some script_vals ->
+               print_dependencies
+                 "dependencies for script satisfied, but cached:"
+                 rules_that_have_matched
+                 !rules_that_have_ever_matched
+                 r.scr_rule_info.dependencies;
+               show_or_not_binding "in" e;
              (* env might be bigger than what was cached against, so have to
                 merge with newes anyway *)
-           let new_e = (List.combine script_vars script_vals) @ e in
-           let new_e =
-             new_e +>
-             List.filter
-               (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in
-           (cache,merge_env [(new_e, rules_that_have_matched)] newes)
+               let new_e = (List.combine script_vars script_vals) @ e in
+               let new_e =
+                 new_e +>
+                 List.filter
+                   (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in
+               (cache,merge_env [(new_e, rules_that_have_matched)] newes)
          with Not_found ->
            begin
              print_dependencies "dependencies for script satisfied:"
@@ -1256,7 +1338,7 @@ let apply_script_rule r cache newes e rules_that_have_matched
              match script_application mv ve script_vars r with
                None ->
                  (* failure means we should drop e, no new bindings *)
-                 (((relevant_bindings,[]) :: cache), newes)
+                 (((relevant_bindings,None) :: cache), newes)
              | Some script_vals ->
                  let script_vals =
                    List.map (function x -> Ast_c.MetaIdVal(x,[]))
@@ -1268,7 +1350,7 @@ let apply_script_rule r cache newes e rules_that_have_matched
                    List.filter
                      (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in
                  r.scr_rule_info.was_matched := true;
-                 (((relevant_bindings,script_vals) :: cache),
+                 (((relevant_bindings,Some script_vals) :: cache),
                   merge_env
                     [(new_e,
                       r.scr_rule_info.rulename :: rules_that_have_matched)]
@@ -1531,46 +1613,57 @@ and process_a_generated_a_env_a_toplevel rule env ccs =
 (* does side effects on C ast and on Cocci info rule *)
 and process_a_ctl_a_env_a_toplevel2 r e c f =
  indent_do (fun () ->
-  show_or_not_celem "trying" c.ast_c;
-  Flag.currentfile := Some (f ^ ":" ^get_celem c.ast_c);
-  let (trans_info, returned_any_states, inherited_bindings, newbindings) =
-    Common.save_excursion Flag_ctl.loop_in_src_code (fun () ->
-      Flag_ctl.loop_in_src_code := !Flag_ctl.loop_in_src_code||c.contain_loop;
+   show_or_not_celem "trying" c.ast_c;
+   Flag.currentfile := Some (f ^ ":" ^get_celem c.ast_c);
+   match (r.ctl,c.ast_c) with
+     ((Asttoctl2.NONDECL ctl,t),Ast_c.Declaration _) -> None
+   | ((Asttoctl2.NONDECL ctl,t), _)
+   | ((Asttoctl2.CODE ctl,t), _) ->
+       let ctl = (ctl,t) in (* ctl and other info *)
+       let (trans_info, returned_any_states, inherited_bindings, newbindings) =
+        Common.save_excursion Flag_ctl.loop_in_src_code (fun () ->
+          Flag_ctl.loop_in_src_code :=
+            !Flag_ctl.loop_in_src_code||c.contain_loop;
 
       (***************************************)
       (* !Main point! The call to the engine *)
       (***************************************)
-      let model_ctl  = CCI.model_for_ctl r.dropped_isos (Common.some c.flow) e
-      in CCI.mysat model_ctl r.ctl (r.rule_info.used_after, e)
-    )
-  in
-  if not returned_any_states
-  then None
-  else begin
-    show_or_not_celem "found match in" c.ast_c;
-    show_or_not_trans_info trans_info;
-    List.iter (show_or_not_binding "out") newbindings;
-
-    r.rule_info.was_matched := true;
-
-    if not (null trans_info)
-    then begin
-      c.was_modified := true;
-      try
-        (* les "more than one var in a decl" et "already tagged token"
-         * font crasher coccinelle. Si on a 5 fichiers, donc on a 5
-         * failed. Le try limite le scope des crashes pendant la
-         * trasformation au fichier concerne. *)
-
-        (* modify ast via side effect *)
-        ignore(Transformation_c.transform r.rule_info.rulename r.dropped_isos
-                  inherited_bindings trans_info (Common.some c.flow));
-      with Timeout -> raise Timeout | UnixExit i -> raise (UnixExit i)
-    end;
-
-    Some (List.map (function x -> x@inherited_bindings) newbindings)
-  end
- )
+            let model_ctl =
+              CCI.model_for_ctl r.dropped_isos (Common.some c.flow) e
+            in CCI.mysat model_ctl ctl (r.rule_info.used_after, e))
+       in
+       if not returned_any_states
+       then None
+       else
+        begin
+          show_or_not_celem "found match in" c.ast_c;
+          show_or_not_trans_info trans_info;
+          List.iter (show_or_not_binding "out") newbindings;
+
+          r.rule_info.was_matched := true;
+
+          if not (null trans_info) &&
+            not (!Flag.sgrep_mode2 && not !Flag_cocci.show_diff)
+          then
+            begin
+              c.was_modified := true;
+              try
+               (* les "more than one var in a decl" et "already tagged token"
+                * font crasher coccinelle. Si on a 5 fichiers, donc on a 5
+                * failed. Le try limite le scope des crashes pendant la
+                * trasformation au fichier concerne. *)
+
+               (* modify ast via side effect *)
+                ignore
+                  (Transformation_c.transform r.rule_info.rulename
+                     r.dropped_isos
+                     inherited_bindings trans_info (Common.some c.flow));
+              with Timeout -> raise Timeout | UnixExit i -> raise (UnixExit i)
+            end;
+
+          Some (List.map (function x -> x@inherited_bindings) newbindings)
+        end
+   )
 
 and process_a_ctl_a_env_a_toplevel  a b c f=
   Common.profile_code "process_a_ctl_a_env_a_toplevel"
@@ -1630,7 +1723,7 @@ let rec bigloop2 rs (ccs: file_info list) =
        then
          Common.push2 r.scr_rule_info.rulename rules_that_have_ever_matched);
 
-        es := (if newes = [] then init_es else newes);
+        es := newes (*(if newes = [] then init_es else newes)*);
     | CocciRuleCocciInfo r ->
        apply_cocci_rule r rules_that_have_ever_matched
          es ccs);
@@ -1681,8 +1774,8 @@ let initial_final_bigloop2 ty rebuild r =
       let _ = apply_script_rule r [] [] [] [] (ref []) ocaml_application in
       ()
   | _ ->
-      Printf.printf "Unknown language for initial/final script: %s\n"
-       r.language
+      failwith ("Unknown language for initial/final script: "^
+               r.language)
 
 let initial_final_bigloop a b c =
   Common.profile_code "initial_final_bigloop"
@@ -1707,7 +1800,7 @@ let pre_engine2 (coccifile, isofile) =
   (* useful opti when use -dir *)
   let (metavars,astcocci,
        free_var_lists,negated_pos_lists,used_after_lists,
-       positions_lists,toks,_) =
+       positions_lists,(toks,_,_)) =
       sp_of_file coccifile isofile in
   let ctls = ctls_of_ast astcocci used_after_lists positions_lists in
 
@@ -1733,32 +1826,42 @@ let pre_engine2 (coccifile, isofile) =
           | _ -> languages)
       [] cocci_infos in
 
+  let runrule r =
+    let rlang = r.language in
+    let rname = r.scr_rule_info.rulename in
+    try
+      let _ = List.assoc (rlang,rname) !Iteration.initialization_stack in
+      ()
+    with Not_found ->
+      begin
+       Iteration.initialization_stack :=
+         ((rlang,rname),!Flag.defined_virtual_rules) ::
+         !Iteration.initialization_stack;
+       initial_final_bigloop Initial
+         (fun (x,_,_,y) -> fun deps ->
+           Ast_cocci.InitialScriptRule(rname,x,deps,y))
+         r
+      end in
+  
   let initialized_languages =
     List.fold_left
       (function languages ->
-        function
-            InitialScriptRuleCocciInfo(r) ->
-              (if List.mem r.language languages
-               then
-                failwith
-                  ("double initializer found for "^r.language));
-              if interpret_dependencies [] [] r.scr_rule_info.dependencies
-              then
-                begin
-                  initial_final_bigloop Initial
-                    (fun (x,_,_,y) -> fun deps ->
-                      Ast_cocci.InitialScriptRule(r.scr_rule_info.rulename,x,deps,y))
-                    r;
-                  r.language::languages
-                end
-              else languages
-          | _ -> languages)
+       function
+           InitialScriptRuleCocciInfo(r) ->
+             let rlang = r.language in
+             (if List.mem rlang languages
+             then failwith ("double initializer found for "^rlang));
+             if interpret_dependencies [] [] r.scr_rule_info.dependencies
+             then begin runrule r; rlang::languages end
+             else languages
+         | _ -> languages)
       [] cocci_infos in
 
   let uninitialized_languages =
     List.filter
       (fun used -> not (List.mem used initialized_languages))
       used_languages in
+
   List.iter
     (fun lgg ->
       let rule_info =
@@ -1767,10 +1870,7 @@ let pre_engine2 (coccifile, isofile) =
          used_after = [];
          ruleid = (-1);
          was_matched = ref false;} in
-      initial_final_bigloop Initial
-       (fun (x,_,_,y) -> fun deps ->
-         Ast_cocci.InitialScriptRule("",x,deps,y))
-       (make_init lgg "" rule_info))
+      runrule (make_init lgg "" rule_info))
     uninitialized_languages;
 
   (cocci_infos,toks)
@@ -1843,21 +1943,26 @@ let full_engine a b =
     (fun () -> let res = full_engine2 a b in (*Gc.print_stat stderr; *)res)
 
 let post_engine2 (cocci_infos,_) =
-  let _ =
-    List.fold_left
-      (function languages ->
-       function
-           FinalScriptRuleCocciInfo(r) ->
-             (if List.mem r.language languages
-             then failwith ("double finalizer found for "^r.language));
-             initial_final_bigloop Final
-               (fun (x,_,_,y) -> fun deps ->
-                 Ast_cocci.FinalScriptRule(r.scr_rule_info.rulename,x,deps,y))
-               r;
-             r.language::languages
-         | _ -> languages)
-      [] cocci_infos in
-  ()
+  List.iter
+    (function ((language,_),virt_rules) ->
+      Flag.defined_virtual_rules := virt_rules;
+      let _ =
+       List.fold_left
+         (function languages ->
+           function
+               FinalScriptRuleCocciInfo(r) ->
+                 (if r.language = language && List.mem r.language languages
+                 then failwith ("double finalizer found for "^r.language));
+                 initial_final_bigloop Final
+                   (fun (x,_,_,y) -> fun deps ->
+                     Ast_cocci.FinalScriptRule(r.scr_rule_info.rulename,
+                                               x,deps,y))
+                   r;
+                 r.language::languages
+             | _ -> languages)
+         [] cocci_infos in
+      ())
+    !Iteration.initialization_stack
 
 let post_engine a =
   Common.profile_code "post_engine" (fun () -> post_engine2 a)