Coccinelle release 1.0.0-rc1

[bpt/coccinelle.git] / cocci.ml

diff --git a/cocci.ml b/cocci.ml
index 8c451b5..5a86ffa 100644 (file)
--- a/cocci.ml
+++ b/cocci.ml
@@ -1,23 +1,25 @@
 (*
 (*

-* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
-* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
-* This file is part of Coccinelle.
-* 
-* Coccinelle is free software: you can redistribute it and/or modify
-* it under the terms of the GNU General Public License as published by
-* the Free Software Foundation, according to version 2 of the License.
-* 
-* Coccinelle is distributed in the hope that it will be useful,
-* but WITHOUT ANY WARRANTY; without even the implied warranty of
-* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-* GNU General Public License for more details.
-* 
-* You should have received a copy of the GNU General Public License
-* along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
-* 
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
+ * Copyright 2010, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
+ * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)

 
 
 open Common
 
 
 open Common


@@ -28,7 +30,7 @@ module TAC = Type_annoter_c
 module Ast_to_flow = Control_flow_c_build
 
 (*****************************************************************************)
 module Ast_to_flow = Control_flow_c_build
 
 (*****************************************************************************)

-(* This file is a kind of driver. It gathers all the important functions 
+(* This file is a kind of driver. It gathers all the important functions

  * from coccinelle in one place. The different entities in coccinelle are:
  *  - files
  *  - astc
  * from coccinelle in one place. The different entities in coccinelle are:
  *  - files
  *  - astc


@@ -42,61 +44,94 @@ module Ast_to_flow = Control_flow_c_build
 (* --------------------------------------------------------------------- *)
 (* C related *)
 (* --------------------------------------------------------------------- *)
 (* --------------------------------------------------------------------- *)
 (* C related *)
 (* --------------------------------------------------------------------- *)

-let cprogram_of_file file = 
-  let (program2, _stat) = Parse_c.parse_c_and_cpp file in
-  program2 
-
-let cprogram_of_file_cached file = 
-  let (program2, _stat) = Parse_c.parse_cache 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,typedefs,macros), _stat) = Parse_c.parse_cache file in

   if !Flag_cocci.ifdef_to_if
   if !Flag_cocci.ifdef_to_if

-  then 
-    program2 +> Parse_c.with_program2 (fun asts -> 
-      Cpp_ast_c.cpp_ifdef_statementize asts
-    )
-  else program2
-
-let cfile_of_program program2_with_ppmethod outf = 
+  then
+    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
   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 _hctl = Hashtbl.create 101
 
 (* --------------------------------------------------------------------- *)
 (* Cocci related *)
 (* --------------------------------------------------------------------- *)

-let sp_of_file2 file iso   =
-  Common.memoized _hparse (file, iso) (fun () ->
-    Parse_cocci.process file iso false)
-let sp_of_file file iso    = 
+(* 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)
 
 
 (* --------------------------------------------------------------------- *)
 (* Flow related *)
 (* --------------------------------------------------------------------- *)
   Common.profile_code "parse cocci" (fun () -> sp_of_file2 file iso)
 
 
 (* --------------------------------------------------------------------- *)
 (* Flow related *)
 (* --------------------------------------------------------------------- *)

-let print_flow flow = 
+let print_flow flow =

   Ograph_extended.print_ograph_mutable flow "/tmp/test.dot" true
 
 
 let ast_to_flow_with_error_messages2 x =
   Ograph_extended.print_ograph_mutable flow "/tmp/test.dot" true
 
 
 let ast_to_flow_with_error_messages2 x =

-  let flowopt = 
+  let flowopt =

     try Ast_to_flow.ast_to_control_flow x
     try Ast_to_flow.ast_to_control_flow x

-    with Ast_to_flow.Error x -> 
+    with Ast_to_flow.Error x ->

       Ast_to_flow.report_error x;
       None
   in
       Ast_to_flow.report_error x;
       None
   in

-  flowopt +> do_option (fun flow -> 
+  flowopt +> do_option (fun flow ->

     (* This time even if there is a deadcode, we still have a
      * flow graph, so I can try the transformation and hope the
     (* This time even if there is a deadcode, we still have a
      * flow graph, so I can try the transformation and hope the

-     * deadcode will not bother us. 
+     * deadcode will not bother us.

      *)
     try Ast_to_flow.deadcode_detection flow
      *)
     try Ast_to_flow.deadcode_detection flow

-    with Ast_to_flow.Error (Ast_to_flow.DeadCode x) -> 
+    with Ast_to_flow.Error (Ast_to_flow.DeadCode x) ->

       Ast_to_flow.report_error (Ast_to_flow.DeadCode x);
   );
   flowopt
       Ast_to_flow.report_error (Ast_to_flow.DeadCode x);
   );
   flowopt

-let ast_to_flow_with_error_messages a = 
+let ast_to_flow_with_error_messages a =

   Common.profile_code "flow" (fun () -> ast_to_flow_with_error_messages2 a)
 
 
   Common.profile_code "flow" (fun () -> ast_to_flow_with_error_messages2 a)
 
 


@@ -109,7 +144,7 @@ let ctls_of_ast2 ast (ua,fua,fuas) pos =
     (function ast -> function (ua,(fua,(fuas,pos))) ->
       List.combine
        (if !Flag_cocci.popl
     (function ast -> function (ua,(fua,(fuas,pos))) ->
       List.combine
        (if !Flag_cocci.popl

-       then failwith "no popl here" (* Popl.popl ast *)
+       then Popl.popl ast

        else Asttoctl2.asttoctl ast (ua,fua,fuas) pos)
        (Asttomember.asttomember ast ua))
     ast (List.combine ua (List.combine fua (List.combine fuas pos)))
        else Asttoctl2.asttoctl ast (ua,fua,fuas) pos)
        (Asttomember.asttomember ast ua))
     ast (List.combine ua (List.combine fua (List.combine fuas pos)))


@@ -130,13 +165,13 @@ let show_or_not_cfile2 cfile =
     Common.pr2_xxxxxxxxxxxxxxxxx ();
     Common.command2 ("cat " ^ cfile);
   end
     Common.pr2_xxxxxxxxxxxxxxxxx ();
     Common.command2 ("cat " ^ cfile);
   end

-let show_or_not_cfile a = 
+let show_or_not_cfile a =

   Common.profile_code "show_xxx" (fun () -> show_or_not_cfile2 a)
 
 let show_or_not_cfiles cfiles = List.iter show_or_not_cfile cfiles
 
 
   Common.profile_code "show_xxx" (fun () -> show_or_not_cfile2 a)
 
 let show_or_not_cfiles cfiles = List.iter show_or_not_cfile cfiles
 
 

-let show_or_not_cocci2 coccifile isofile = 
+let show_or_not_cocci2 coccifile isofile =

   if !Flag_cocci.show_cocci then begin
     Common.pr2_xxxxxxxxxxxxxxxxx ();
     pr2 ("processing semantic patch file: " ^ coccifile);
   if !Flag_cocci.show_cocci then begin
     Common.pr2_xxxxxxxxxxxxxxxxx ();
     pr2 ("processing semantic patch file: " ^ coccifile);


@@ -145,14 +180,82 @@ let show_or_not_cocci2 coccifile isofile =
     Common.command2 ("cat " ^ coccifile);
     pr2 "";
   end
     Common.command2 ("cat " ^ coccifile);
     pr2 "";
   end

-let show_or_not_cocci a b = 
+let show_or_not_cocci a b =

   Common.profile_code "show_xxx" (fun () -> show_or_not_cocci2 a b)
 
   Common.profile_code "show_xxx" (fun () -> show_or_not_cocci2 a b)
 

+(* ---------------------------------------------------------------------- *)

 (* the output *)
 
 (* the output *)
 

-let show_or_not_diff2 cfile outfile show_only_minus = 
+let fix_sgrep_diffs l =
+  let l =
+    List.filter (function s -> (s =~ "^\\+\\+\\+") || not (s =~ "^\\+")) l in
+  let l = List.rev l in
+  (* adjust second number for + code *)
+  let rec loop1 n = function
+      [] -> []
+    | s::ss ->
+       if s =~ "^-" && not(s =~ "^---")
+       then s :: loop1 (n+1) ss
+       else if s =~ "^@@"
+       then
+         (match Str.split (Str.regexp " ") s with
+           bef::min::pl::aft ->
+             let (n1,n2) =
+               match Str.split (Str.regexp ",") pl with
+                 [n1;n2] -> (n1,n2)
+               | [n1] -> (n1,"1")
+               | _ -> failwith "bad + line information" in
+             let n2 = int_of_string n2 in
+             (Printf.sprintf "%s %s %s,%d %s" bef min n1 (n2-n)
+                (String.concat " " aft))
+             :: loop1 0 ss
+         | _ -> failwith "bad @@ information")
+       else s :: loop1 n ss in
+  let rec loop2 n = function
+      [] -> []
+    | s::ss ->
+       if s =~ "^---"
+       then s :: loop2 0 ss
+       else if s =~ "^@@"
+       then
+         (match Str.split (Str.regexp " ") s with
+           bef::min::pl::aft ->
+             let (m2,n1,n2) =
+               match (Str.split (Str.regexp ",") min,
+                      Str.split (Str.regexp ",") pl) with
+                 ([_;m2],[n1;n2]) -> (m2,n1,n2)
+               | ([_],[n1;n2]) -> ("1",n1,n2)
+               | ([_;m2],[n1]) -> (m2,n1,"1")
+               | ([_],[n1]) -> ("1",n1,"1")
+               | _ -> failwith "bad -/+ line information" in
+             let n1 =
+               int_of_string (String.sub n1 1 ((String.length n1)-1)) in
+             let m2 = int_of_string m2 in
+             let n2 = int_of_string n2 in
+             (Printf.sprintf "%s %s +%d,%d %s" bef min (n1-n) n2
+                (String.concat " " aft))
+             :: loop2 (n+(m2-n2)) ss
+         | _ -> failwith "bad @@ information")
+       else s :: loop2 n ss in
+  loop2 0 (List.rev (loop1 0 l))
+
+let normalize_path file =
+  let fullpath =
+    if String.get file 0 = '/' then file else (Sys.getcwd()) ^ "/" ^ file in
+  let elements = Str.split_delim (Str.regexp "/") fullpath in
+  let rec loop prev = function
+      [] -> String.concat "/" (List.rev prev)
+    | "." :: rest -> loop prev rest
+    | ".." :: rest ->
+       (match prev with
+         x::xs -> loop xs rest
+       | _ -> failwith "bad path")
+    | x::rest -> loop (x::prev) rest in
+  loop [] elements
+
+let show_or_not_diff2 cfile outfile =

   if !Flag_cocci.show_diff then begin
   if !Flag_cocci.show_diff then begin

-    match Common.fst(Compare_c.compare_default cfile outfile) with
+    match Common.fst(Compare_c.compare_to_original cfile outfile) with

       Compare_c.Correct -> () (* diff only in spacing, etc *)
     | _ ->
         (* may need --strip-trailing-cr under windows *)
       Compare_c.Correct -> () (* diff only in spacing, etc *)
     | _ ->
         (* may need --strip-trailing-cr under windows *)


@@ -167,33 +270,50 @@ let show_or_not_diff2 cfile outfile show_only_minus =
          match (!Flag.patch,res) with
        (* create something that looks like the output of patch *)
            (Some prefix,minus_file::plus_file::rest) ->
          match (!Flag.patch,res) with
        (* create something that looks like the output of patch *)
            (Some prefix,minus_file::plus_file::rest) ->

+             let prefix =
+               let lp = String.length prefix in
+               if String.get prefix (lp-1) = '/'
+               then String.sub prefix 0 (lp-1)
+               else prefix in

              let drop_prefix file =
              let drop_prefix file =

-               if prefix =$= ""
-               then "/"^file
-               else
+               let file = normalize_path file in
+               if Str.string_match (Str.regexp prefix) file 0
+               then

                  let lp = String.length prefix in
                  let lp = String.length prefix in

-                 String.sub file lp ((String.length file) - lp) in
+                 let lf = String.length file in
+                 if lp < lf
+                 then String.sub file lp (lf - lp)
+                 else
+                   failwith
+                     (Printf.sprintf "prefix %s doesn't match file %s"
+                        prefix file)
+               else
+                 failwith
+                   (Printf.sprintf "prefix %s doesn't match file %s"
+                      prefix file) in

              let diff_line =
                match List.rev(Str.split (Str.regexp " ") line) with
                  new_file::old_file::cmdrev ->
              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 " "
                    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
                    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) =
                      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,plus_file)
-               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 " "
                      (String.concat " "
                         ("---"::("a"^old_base_file)::old_rest),
                       String.concat " "


@@ -204,17 +324,15 @@ let show_or_not_diff2 cfile outfile show_only_minus =
                           (String.concat ":" l1) (String.concat ":" l2)) in
              diff_line::minus_line::plus_line::rest
          | _ -> res in
                           (String.concat ":" l1) (String.concat ":" l2)) in
              diff_line::minus_line::plus_line::rest
          | _ -> res in

-       xs +> List.iter (fun s -> 
-         if s =~ "^\\+" && show_only_minus
-         then ()
-         else pr s)
+       let xs = if !Flag.sgrep_mode2 then fix_sgrep_diffs xs else xs in
+       xs +> List.iter pr

   end
   end

-let show_or_not_diff a b c  = 
-  Common.profile_code "show_xxx" (fun () -> show_or_not_diff2 a b c)
-    
-    
+let show_or_not_diff a b =
+  Common.profile_code "show_xxx" (fun () -> show_or_not_diff2 a b)
+
+

 (* the derived input *)
 (* the derived input *)

-    
+

 let show_or_not_ctl_tex2 astcocci ctls =
   if !Flag_cocci.show_ctl_tex then begin
     Ctltotex.totex ("/tmp/__cocci_ctl.tex") astcocci ctls;
 let show_or_not_ctl_tex2 astcocci ctls =
   if !Flag_cocci.show_ctl_tex then begin
     Ctltotex.totex ("/tmp/__cocci_ctl.tex") astcocci ctls;


@@ -222,11 +340,10 @@ let show_or_not_ctl_tex2 astcocci ctls =
                     "dvips __cocci_ctl.dvi -o __cocci_ctl.ps;" ^
                     "gv __cocci_ctl.ps &");
   end
                     "dvips __cocci_ctl.dvi -o __cocci_ctl.ps;" ^
                     "gv __cocci_ctl.ps &");
   end

-let show_or_not_ctl_tex a b  = 
+let show_or_not_ctl_tex a b  =

   Common.profile_code "show_xxx" (fun () -> show_or_not_ctl_tex2 a b)
   Common.profile_code "show_xxx" (fun () -> show_or_not_ctl_tex2 a b)

-    
-    
-    
+
+

 let show_or_not_rule_name ast rulenb =
   if !Flag_cocci.show_ctl_text or !Flag.show_trying or
     !Flag.show_transinfo or !Flag_cocci.show_binding_in_out
 let show_or_not_rule_name ast rulenb =
   if !Flag_cocci.show_ctl_text or !Flag.show_trying or
     !Flag.show_transinfo or !Flag_cocci.show_binding_in_out


@@ -254,19 +371,19 @@ let show_or_not_scr_rule_name rulenb =
 
 let show_or_not_ctl_text2 ctl ast rulenb =
   if !Flag_cocci.show_ctl_text then begin
 
 let show_or_not_ctl_text2 ctl ast rulenb =
   if !Flag_cocci.show_ctl_text then begin

-    
-    adjust_pp_with_indent (fun () -> 
+
+    adjust_pp_with_indent (fun () ->

       Format.force_newline();
       Pretty_print_cocci.print_plus_flag := true;
       Pretty_print_cocci.print_minus_flag := true;
       Pretty_print_cocci.unparse ast;
       );
       Format.force_newline();
       Pretty_print_cocci.print_plus_flag := true;
       Pretty_print_cocci.print_minus_flag := true;
       Pretty_print_cocci.unparse ast;
       );

-    
+

     pr "CTL = ";
     let (ctl,_) = ctl in
     pr "CTL = ";
     let (ctl,_) = ctl in

-    adjust_pp_with_indent (fun () -> 
+    adjust_pp_with_indent (fun () ->

       Format.force_newline();
       Format.force_newline();

-      Pretty_print_engine.pp_ctlcocci 
+      Pretty_print_engine.pp_ctlcocci

         !Flag_cocci.show_mcodekind_in_ctl !Flag_cocci.inline_let_ctl ctl;
       );
     pr "";
         !Flag_cocci.show_mcodekind_in_ctl !Flag_cocci.inline_let_ctl ctl;
       );
     pr "";


@@ -277,19 +394,19 @@ let show_or_not_ctl_text a b c =
 
 
 (* running information *)
 
 
 (* running information *)

-let get_celem celem : string = 
-  match celem with 
-      Ast_c.Definition ({Ast_c.f_name = namefuncs;},_) -> 
+let get_celem celem : string =
+  match celem with
+      Ast_c.Definition ({Ast_c.f_name = namefuncs;},_) ->

         Ast_c.str_of_name namefuncs
     | Ast_c.Declaration
         Ast_c.str_of_name namefuncs
     | Ast_c.Declaration

-       (Ast_c.DeclList ([{Ast_c.v_namei = Some (name, _);}, _], _)) -> 
+       (Ast_c.DeclList ([{Ast_c.v_namei = Some (name, _);}, _], _)) ->

         Ast_c.str_of_name name
     | _ -> ""
 
         Ast_c.str_of_name name
     | _ -> ""
 

-let show_or_not_celem2 prelude celem = 
+let show_or_not_celem2 prelude celem =

   let (tag,trying) =
   let (tag,trying) =

-  (match celem with 
-  | Ast_c.Definition ({Ast_c.f_name = namefuncs},_) -> 
+  (match celem with
+  | Ast_c.Definition ({Ast_c.f_name = namefuncs},_) ->

       let funcs = Ast_c.str_of_name namefuncs in
       Flag.current_element := funcs;
       (" function: ",funcs)
       let funcs = Ast_c.str_of_name namefuncs in
       Flag.current_element := funcs;
       (" function: ",funcs)


@@ -303,12 +420,12 @@ let show_or_not_celem2 prelude celem =
       (" ","something else");
   ) in
   if !Flag.show_trying then pr2 (prelude ^ tag ^ trying)
       (" ","something else");
   ) in
   if !Flag.show_trying then pr2 (prelude ^ tag ^ trying)

-  
-let show_or_not_celem a b  = 
+
+let show_or_not_celem a b  =

   Common.profile_code "show_xxx" (fun () -> show_or_not_celem2 a b)
 
 
   Common.profile_code "show_xxx" (fun () -> show_or_not_celem2 a b)
 
 

-let show_or_not_trans_info2 trans_info = 
+let show_or_not_trans_info2 trans_info =

   (* drop witness tree indices for printing *)
   let trans_info =
     List.map (function (index,trans_info) -> trans_info) trans_info in
   (* drop witness tree indices for printing *)
   let trans_info =
     List.map (function (index,trans_info) -> trans_info) trans_info in


@@ -318,18 +435,18 @@ let show_or_not_trans_info2 trans_info =
       pr2 "transformation info returned:";
       let trans_info =
         List.sort (function (i1,_,_) -> function (i2,_,_) -> compare i1 i2)
       pr2 "transformation info returned:";
       let trans_info =
         List.sort (function (i1,_,_) -> function (i2,_,_) -> compare i1 i2)

-          trans_info 
+          trans_info

       in
       in

-      indent_do (fun () -> 
-        trans_info +> List.iter (fun (i, subst, re) -> 
+      indent_do (fun () ->
+        trans_info +> List.iter (fun (i, subst, re) ->

           pr2 ("transform state: " ^ (Common.i_to_s i));
           pr2 ("transform state: " ^ (Common.i_to_s i));

-          indent_do (fun () -> 
-            adjust_pp_with_indent_and_header "with rule_elem: " (fun () -> 
+          indent_do (fun () ->
+            adjust_pp_with_indent_and_header "with rule_elem: " (fun () ->

               Pretty_print_cocci.print_plus_flag := true;
               Pretty_print_cocci.print_minus_flag := true;
               Pretty_print_cocci.rule_elem "" re;
             );
               Pretty_print_cocci.print_plus_flag := true;
               Pretty_print_cocci.print_minus_flag := true;
               Pretty_print_cocci.rule_elem "" re;
             );

-            adjust_pp_with_indent_and_header "with binding: " (fun () -> 
+            adjust_pp_with_indent_and_header "with binding: " (fun () ->

               Pretty_print_engine.pp_binding subst;
             );
           )
               Pretty_print_engine.pp_binding subst;
             );
           )


@@ -337,18 +454,18 @@ let show_or_not_trans_info2 trans_info =
       )
     end
   end
       )
     end
   end

-let show_or_not_trans_info a  = 
+let show_or_not_trans_info a  =

   Common.profile_code "show_xxx" (fun () -> show_or_not_trans_info2 a)
 
 
 
 let show_or_not_binding2 s binding =
   if !Flag_cocci.show_binding_in_out then begin
   Common.profile_code "show_xxx" (fun () -> show_or_not_trans_info2 a)
 
 
 
 let show_or_not_binding2 s binding =
   if !Flag_cocci.show_binding_in_out then begin

-    adjust_pp_with_indent_and_header ("binding " ^ s ^ " = ") (fun () -> 
+    adjust_pp_with_indent_and_header ("binding " ^ s ^ " = ") (fun () ->

       Pretty_print_engine.pp_binding binding
     )
   end
       Pretty_print_engine.pp_binding binding
     )
   end

-let show_or_not_binding a b  = 
+let show_or_not_binding a b  =

   Common.profile_code "show_xxx" (fun () -> show_or_not_binding2 a b)
 
 
   Common.profile_code "show_xxx" (fun () -> show_or_not_binding2 a b)
 
 


@@ -357,63 +474,61 @@ let show_or_not_binding a b  =
 (* Some  helper functions *)
 (*****************************************************************************)
 
 (* Some  helper functions *)
 (*****************************************************************************)
 

-let worth_trying cfiles tokens = 
+let worth_trying cfiles tokens =

   (* drop the following line for a list of list by rules.  since we don't
      allow multiple minirules, all the tokens within a rule should be in
      a single CFG entity *)
   (* drop the following line for a list of list by rules.  since we don't
      allow multiple minirules, all the tokens within a rule should be in
      a single CFG entity *)

-  let tokens = Common.union_all tokens in
-  if not !Flag_cocci.windows && not (null tokens)
-  then
+  match (!Flag_cocci.windows,tokens) with
+    (true,_) | (_,None) -> true
+  | (_,Some tokens) ->

    (* could also modify the code in get_constants.ml *)
    (* could also modify the code in get_constants.ml *)

-    let tokens = tokens +> List.map (fun s -> 
-      match () with 
-      | _ when s =~ "^[A-Za-z_][A-Za-z_0-9]*$" -> 
-          "\\b" ^ s ^ "\\b"
+      let tokens = tokens +> List.map (fun s ->
+       match () with
+       | _ when s =~ "^[A-Za-z_][A-Za-z_0-9]*$" ->
+            "\\b" ^ s ^ "\\b"

 
 

-      | _ when s =~ "^[A-Za-z_]" -> 
-          "\\b" ^ s
+       | _ when s =~ "^[A-Za-z_]" ->
+            "\\b" ^ s

 
 

-      | _ when s =~ ".*[A-Za-z_]$" -> 
-          s ^ "\\b"
-      | _ -> s
+       | _ when s =~ ".*[A-Za-z_]$" ->
+            s ^ "\\b"
+       | _ -> s

 
 

-    ) in
-    let com = sprintf "egrep -q '(%s)' %s" (join "|" tokens) (join " " cfiles)
-    in
-    (match Sys.command com with
-    | 0 (* success *) -> true
-    | _ (* failure *) ->
-       (if !Flag.show_misc
-       then Printf.printf "grep failed: %s\n" com);
-       false (* no match, so not worth trying *)
-    )
-  else true
-
-let check_macro_in_sp_and_adjust tokens = 
-  let tokens = Common.union_all tokens in
-  tokens +> List.iter (fun s -> 
-    if Hashtbl.mem !Parse_c._defs s
-    then begin
-      if !Flag_cocci.verbose_cocci then begin
-        pr2 "warning: macro in semantic patch was in macro definitions";
-        pr2 ("disabling macro expansion for " ^ s);
-      end;
-      Hashtbl.remove !Parse_c._defs s
-    end
-  )
-
-
-let contain_loop gopt = 
+      ) in
+      let com = sprintf "egrep -q '(%s)' %s" (join "|" tokens) (join " " cfiles)
+      in
+      (match Sys.command com with
+      | 0 (* success *) -> true
+      | _ (* failure *) ->
+         (if !Flag.show_misc
+         then Printf.printf "grep failed: %s\n" com);
+         false (* no match, so not worth trying *))
+
+let check_macro_in_sp_and_adjust = function
+    None -> ()
+  | Some tokens ->
+      tokens +> List.iter (fun s ->
+       if Hashtbl.mem !Parse_c._defs s
+       then begin
+         if !Flag_cocci.verbose_cocci then begin
+            pr2 "warning: macro in semantic patch was in macro definitions";
+            pr2 ("disabling macro expansion for " ^ s);
+         end;
+         Hashtbl.remove !Parse_c._defs s
+       end)
+
+
+let contain_loop gopt =

   match gopt with
   match gopt with

-  | Some g -> 
-      g#nodes#tolist +> List.exists (fun (xi, node) -> 
+  | Some g ->
+      g#nodes#tolist +> List.exists (fun (xi, node) ->

         Control_flow_c.extract_is_loop node
       )
   | None -> true (* means nothing, if no g then will not model check *)
 
 
 
         Control_flow_c.extract_is_loop node
       )
   | None -> true (* means nothing, if no g then will not model check *)
 
 
 

-let sp_contain_typed_metavar_z toplevel_list_list = 
+let sp_contain_typed_metavar_z toplevel_list_list =

   let bind x y = x or y in
   let option_default = false in
   let mcode _ _ = option_default in
   let bind x y = x or y in
   let option_default = false in
   let mcode _ _ = option_default in


@@ -423,24 +538,23 @@ let sp_contain_typed_metavar_z toplevel_list_list =
     match Ast_cocci.unwrap e with
     | Ast_cocci.MetaExpr (_,_,_,Some t,_,_) -> true
     | Ast_cocci.MetaExpr (_,_,_,_,Ast_cocci.LocalID,_) -> true
     match Ast_cocci.unwrap e with
     | Ast_cocci.MetaExpr (_,_,_,Some t,_,_) -> true
     | Ast_cocci.MetaExpr (_,_,_,_,Ast_cocci.LocalID,_) -> true

-    | _ -> k e 
+    | _ -> k e

   in
 
   in
 

-  let combiner = 
+  let combiner =

     Visitor_ast.combiner bind option_default
       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
     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 expression donothing donothing donothing donothing donothing

-      donothing donothing donothing donothing donothing 
+      donothing donothing donothing donothing donothing

   in
   in

-  toplevel_list_list +> 
+  toplevel_list_list +>

     List.exists
     (function (nm,_,rule) ->
       (List.exists combiner.Visitor_ast.combiner_top_level rule))
     List.exists
     (function (nm,_,rule) ->
       (List.exists combiner.Visitor_ast.combiner_top_level rule))

-    

 
 let sp_contain_typed_metavar rules =
 
 let sp_contain_typed_metavar rules =

-  sp_contain_typed_metavar_z 
+  sp_contain_typed_metavar_z

     (List.map
        (function x ->
         match x with
     (List.map
        (function x ->
         match x with


@@ -458,58 +572,103 @@ let sp_contain_typed_metavar rules =
 (* finding among the #include the one that we need to parse
  * because they may contain useful type definition or because
  * we may have to modify them
 (* finding among the #include the one that we need to parse
  * because they may contain useful type definition or because
  * we may have to modify them

- * 
+ *

  * For the moment we base in part our heuristic on the name of the file, e.g.
  * 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> 
+ * serio.c is related we think to #include <linux/serio.h>

  *)
  *)

-
-let interpret_include_path _ =
-  match !Flag_cocci.include_path with
-    None -> "include"
-  | Some x -> x
+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
+  try Some(Hashtbl.find include_table (searchlist,relpath))
+  with Not_found ->
+    search_path native_file_exists searchlist relpath

 
 let (includes_to_parse:
 
 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 ->
         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
-      xs +> List.map (fun (file, cs) -> 
+      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
        let dir = Common.dirname file in

-       
-       cs +> Common.map_filter (fun (c,_info_item) -> 
+
+       cs +> Common.map_filter (fun (c,_info_item) ->

          match c with
          | Ast_c.CppTop
              (Ast_c.Include
          match c with
          | Ast_c.CppTop
              (Ast_c.Include

-                {Ast_c.i_include = ((x,ii)); i_rel_pos = info_h_pos;})  -> 
+                {Ast_c.i_include = ((x,ii)); i_rel_pos = info_h_pos;})  ->

            (match x with
            (match x with

-            | Ast_c.Local xs -> 
-               let f = Filename.concat dir (Common.join "/" xs) in
+            | Ast_c.Local xs ->
+               let relpath = Common.join "/" xs in
+               let f = Filename.concat dir relpath in
+               if (Sys.file_exists f) then
+                 Some f
+               else
+                 if !Flag_cocci.relax_include_path

              (* for our tests, all the files are flat in the current dir *)
              (* for our tests, all the files are flat in the current dir *)

-               if not (Sys.file_exists f) && !Flag_cocci.relax_include_path
-               then
-                 let attempt2 = Filename.concat dir (Common.last xs) in
-                 if not (Sys.file_exists f) && all_includes
-                 then Some (Filename.concat (interpret_include_path())
-                               (Common.join "/" xs))
-                 else Some attempt2
-               else Some f
-
-            | Ast_c.NonLocal xs -> 
+                 then
+                   let attempt2 = Filename.concat dir (Common.last xs) in
+                     if not (Sys.file_exists attempt2) && all_includes
+                     then
+                       interpret_include_path xs
+                     else Some attempt2
+                 else
+                   if all_includes then interpret_include_path xs
+                   else None
+
+            | Ast_c.NonLocal xs ->

                if all_includes ||
                Common.fileprefix (Common.last xs) =$= Common.fileprefix file
                if all_includes ||
                Common.fileprefix (Common.last xs) =$= Common.fileprefix file

-               then 
-                  Some (Filename.concat (interpret_include_path())
-                          (Common.join "/" xs))
+               then
+                 interpret_include_path xs

                else None
             | Ast_c.Weird _ -> None
                  )
          | _ -> None))
        +> List.concat
                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
   | Ast_cocci.AntiDep s  ->
 let rec interpret_dependencies local global = function
     Ast_cocci.Dep s      -> List.mem s local
   | Ast_cocci.AntiDep s  ->


@@ -528,7 +687,8 @@ let rec interpret_dependencies local global = function
       (interpret_dependencies local global s1) or
       (interpret_dependencies local global s2)
   | Ast_cocci.NoDep -> true
       (interpret_dependencies local global s1) or
       (interpret_dependencies local global s2)
   | Ast_cocci.NoDep -> true

-       
+  | Ast_cocci.FailDep -> false
+

 let rec print_dependencies str local global dep =
   if !Flag_cocci.show_dependencies
   then
 let rec print_dependencies str local global dep =
   if !Flag_cocci.show_dependencies
   then


@@ -537,62 +697,61 @@ let rec print_dependencies str local global dep =
       let seen = ref [] in
       let rec loop = function
          Ast_cocci.Dep s | Ast_cocci.AntiDep s ->
       let seen = ref [] in
       let rec loop = function
          Ast_cocci.Dep s | Ast_cocci.AntiDep s ->

-           if not (List.mem s !seen)
-           then
-             begin
-               if List.mem s local
-               then pr2 (s^" satisfied")
-               else pr2 (s^" not satisfied");
-               seen := s :: !seen
-             end 
+             if not (List.mem s !seen)
+             then
+               begin
+                 if List.mem s local
+                 then pr2 (s^" satisfied")
+                 else pr2 (s^" not satisfied");
+                 seen := s :: !seen
+               end

        | Ast_cocci.EverDep s | Ast_cocci.NeverDep s ->
        | Ast_cocci.EverDep s | Ast_cocci.NeverDep s ->

-           if not (List.mem s !seen)
-           then
-             begin
-               if List.mem s global
-               then pr2 (s^" satisfied")
-               else pr2 (s^" not satisfied");
-               seen := s :: !seen
-             end
+             if not (List.mem s !seen)
+             then
+               begin
+                 if List.mem s global
+                 then pr2 (s^" satisfied")
+                 else pr2 (s^" not satisfied");
+                 seen := s :: !seen
+               end

        | Ast_cocci.AndDep(s1,s2) ->
            loop s1;
            loop s2
        | Ast_cocci.OrDep(s1,s2)  ->
            loop s1;
            loop s2
        | Ast_cocci.AndDep(s1,s2) ->
            loop s1;
            loop s2
        | Ast_cocci.OrDep(s1,s2)  ->
            loop s1;
            loop s2

-       | Ast_cocci.NoDep -> () in
+       | Ast_cocci.NoDep -> ()
+       | Ast_cocci.FailDep -> pr2 "False not satisfied" in

       loop dep
     end
       loop dep
     end

-    
-    
-    
+

 (* --------------------------------------------------------------------- *)
 (* #include relative position in the file *)
 (* --------------------------------------------------------------------- *)
 (* --------------------------------------------------------------------- *)
 (* #include relative position in the file *)
 (* --------------------------------------------------------------------- *)

-    
+

 (* compute the set of new prefixes
 (* compute the set of new prefixes

- * on 
+ * on

  *  "a/b/x"; (* in fact it is now a list of string so  ["a";"b";"x"] *)
  *  "a/b/c/x";
  *  "a/x";
  *  "b/x";
  *  "a/b/x"; (* in fact it is now a list of string so  ["a";"b";"x"] *)
  *  "a/b/c/x";
  *  "a/x";
  *  "b/x";

- * it would give for the first element 
+ * it would give for the first element

  *   ""; "a"; "a/b"; "a/b/x"
  * for the second
  *   "a/b/c/x"
  *   ""; "a"; "a/b"; "a/b/x"
  * for the second
  *   "a/b/c/x"

- * 
+ *

  * update: if the include is inside a ifdef a put nothing. cf -test incl.
  * this is because we dont want code added inside ifdef.
  *)
 
  * update: if the include is inside a ifdef a put nothing. cf -test incl.
  * this is because we dont want code added inside ifdef.
  *)
 

-let compute_new_prefixes xs = 
-  xs +> Common.map_withenv (fun already xs -> 
+let compute_new_prefixes xs =
+  xs +> Common.map_withenv (fun already xs ->

     let subdirs_prefixes = Common.inits xs in
     let subdirs_prefixes = Common.inits xs in

-    let new_first = subdirs_prefixes +> List.filter (fun x -> 
+    let new_first = subdirs_prefixes +> List.filter (fun x ->

       not (List.mem x already)
     )
     in
       not (List.mem x already)
     )
     in

-    new_first, 
+    new_first,

     new_first @ already
   ) []
   +> fst
     new_first @ already
   ) []
   +> fst


@@ -600,23 +759,23 @@ let compute_new_prefixes xs =
 
 (* does via side effect on the ref in the Include in Ast_c *)
 let rec update_include_rel_pos cs =
 
 (* does via side effect on the ref in the Include in Ast_c *)
 let rec update_include_rel_pos cs =

-  let only_include = cs +> Common.map_filter (fun c -> 
-    match c with 
+  let only_include = cs +> Common.map_filter (fun c ->
+    match c with

     | Ast_c.CppTop (Ast_c.Include {Ast_c.i_include = ((x,_));
                      i_rel_pos = aref;
                      i_is_in_ifdef = inifdef}) ->
         (match x with
         | Ast_c.Weird _ -> None
     | Ast_c.CppTop (Ast_c.Include {Ast_c.i_include = ((x,_));
                      i_rel_pos = aref;
                      i_is_in_ifdef = inifdef}) ->
         (match x with
         | Ast_c.Weird _ -> None

-        | _ -> 
-            if inifdef 
+        | _ ->
+            if inifdef

             then None
             else Some (x, aref)
         )
     | _ -> None
   )
   in
             then None
             else Some (x, aref)
         )
     | _ -> None
   )
   in

-  let (locals, nonlocals) = 
-    only_include +> Common.partition_either (fun (c, aref)  -> 
+  let (locals, nonlocals) =
+    only_include +> Common.partition_either (fun (c, aref)  ->

       match c with
       | Ast_c.Local x -> Left (x, aref)
       | Ast_c.NonLocal x -> Right (x, aref)
       match c with
       | Ast_c.Local x -> Left (x, aref)
       | Ast_c.NonLocal x -> Right (x, aref)


@@ -626,50 +785,61 @@ let rec update_include_rel_pos cs =
   update_rel_pos_bis locals;
   update_rel_pos_bis nonlocals;
   cs
   update_rel_pos_bis locals;
   update_rel_pos_bis nonlocals;
   cs

-and update_rel_pos_bis xs = 
+and update_rel_pos_bis xs =

   let xs' = List.map fst xs in
   let the_first = compute_new_prefixes xs' in
   let the_last  = List.rev (compute_new_prefixes (List.rev xs')) in
   let merged = Common.zip xs (Common.zip the_first the_last) in
   let xs' = List.map fst xs in
   let the_first = compute_new_prefixes xs' in
   let the_last  = List.rev (compute_new_prefixes (List.rev xs')) in
   let merged = Common.zip xs (Common.zip the_first the_last) in

-  merged +> List.iter (fun ((x, aref), (the_first, the_last)) -> 
-    aref := Some 
-      { 
+  merged +> List.iter (fun ((x, aref), (the_first, the_last)) ->
+    aref := Some
+      {

         Ast_c.first_of = the_first;
         Ast_c.last_of = the_last;
       }
   )
         Ast_c.first_of = the_first;
         Ast_c.last_of = the_last;
       }
   )

-        
-
-
-

 
 
 (*****************************************************************************)
 (* All the information needed around the C elements and Cocci rules *)
 (*****************************************************************************)
 
 
 
 (*****************************************************************************)
 (* All the information needed around the C elements and Cocci rules *)
 (*****************************************************************************)
 

-type toplevel_c_info = { 
+type toplevel_c_info = {

   ast_c: Ast_c.toplevel; (* contain refs so can be modified *)
   tokens_c: Parser_c.token list;
   fullstring: string;
 
   flow: Control_flow_c.cflow option; (* it's the "fixed" flow *)
   contain_loop: bool;
   ast_c: Ast_c.toplevel; (* contain refs so can be modified *)
   tokens_c: Parser_c.token list;
   fullstring: string;
 
   flow: Control_flow_c.cflow option; (* it's the "fixed" flow *)
   contain_loop: bool;

-  
+

   env_typing_before: TAC.environment;
   env_typing_after:  TAC.environment;
 
   was_modified: bool ref;
 
   env_typing_before: TAC.environment;
   env_typing_after:  TAC.environment;
 
   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 *)
 }
 
   (* id: int *)
 }
 

+type rule_info = {
+  rulename: string;
+  dependencies: Ast_cocci.dependency;
+  used_after: Ast_cocci.meta_name list;
+  ruleid: int;
+  was_matched: bool ref;
+} 
+

 type toplevel_cocci_info_script_rule = {
 type toplevel_cocci_info_script_rule = {

-  scr_ast_rule: string * (string * (string * string)) list * string;
+  scr_ast_rule:
+      string *
+      (Ast_cocci.script_meta_name * Ast_cocci.meta_name *
+        Ast_cocci.metavar) list *
+      Ast_cocci.meta_name list (*fresh vars*) *
+      string;

   language: string;
   language: string;

-  scr_dependencies: Ast_cocci.dependency;
-  scr_ruleid: int;

   script_code: string;
   script_code: string;

+  scr_rule_info: rule_info;

 }
 
 type toplevel_cocci_info_cocci_rule = {
 }
 
 type toplevel_cocci_info_cocci_rule = {


@@ -678,33 +848,29 @@ type toplevel_cocci_info_cocci_rule = {
   ast_rule: Ast_cocci.rule;
   isexp: bool; (* true if + code is an exp, only for Flag.make_hrule *)
 
   ast_rule: Ast_cocci.rule;
   isexp: bool; (* true if + code is an exp, only for Flag.make_hrule *)
 

-  rulename: string;
-  dependencies: Ast_cocci.dependency;

   (* There are also some hardcoded rule names in parse_cocci.ml:
   (* There are also some hardcoded rule names in parse_cocci.ml:

-   *  let reserved_names = ["all";"optional_storage";"optional_qualifier"] 
+   *  let reserved_names = ["all";"optional_storage";"optional_qualifier"]

    *)
   dropped_isos: string list;
   free_vars:  Ast_cocci.meta_name list;
   negated_pos_vars:  Ast_cocci.meta_name list;
    *)
   dropped_isos: string list;
   free_vars:  Ast_cocci.meta_name list;
   negated_pos_vars:  Ast_cocci.meta_name list;

-  used_after: Ast_cocci.meta_name list;

   positions: Ast_cocci.meta_name list;
 
   positions: Ast_cocci.meta_name list;
 

-  ruleid: int;

   ruletype: Ast_cocci.ruletype;
 
   ruletype: Ast_cocci.ruletype;
 

-  was_matched: bool ref;
+  rule_info: rule_info;

 }
 
 }
 

-type toplevel_cocci_info = 
+type toplevel_cocci_info =

     ScriptRuleCocciInfo of toplevel_cocci_info_script_rule
   | InitialScriptRuleCocciInfo of toplevel_cocci_info_script_rule
   | FinalScriptRuleCocciInfo of toplevel_cocci_info_script_rule
   | CocciRuleCocciInfo of toplevel_cocci_info_cocci_rule
 
     ScriptRuleCocciInfo of toplevel_cocci_info_script_rule
   | InitialScriptRuleCocciInfo of toplevel_cocci_info_script_rule
   | FinalScriptRuleCocciInfo of toplevel_cocci_info_script_rule
   | CocciRuleCocciInfo of toplevel_cocci_info_cocci_rule
 

-type cocci_info = toplevel_cocci_info list * string list list (* tokens *)
+type cocci_info = toplevel_cocci_info list * string list option (* tokens *)

 
 

-type kind_file = Header | Source 
-type file_info = { 
+type kind_file = Header | Source
+type file_info = {

   fname : string;
   full_fname : string;
   was_modified_once: bool ref;
   fname : string;
   full_fname : string;
   was_modified_once: bool ref;


@@ -713,25 +879,25 @@ type file_info = {
   fkind : kind_file;
 }
 
   fkind : kind_file;
 }
 

-let g_contain_typedmetavar = ref false 
+let g_contain_typedmetavar = ref false

 
 
 let last_env_toplevel_c_info xs =
   (Common.last xs).env_typing_after
 
 
 
 let last_env_toplevel_c_info xs =
   (Common.last xs).env_typing_after
 

-let concat_headers_and_c (ccs: file_info list) 
-    : (toplevel_c_info * string) list = 
-  (List.concat (ccs +> List.map (fun x -> 
+let concat_headers_and_c (ccs: file_info list)
+    : (toplevel_c_info * string) list =
+  (List.concat (ccs +> List.map (fun x ->

                                   x.asts +> List.map (fun x' ->
                                                         (x', x.fname)))))
 
                                   x.asts +> List.map (fun x' ->
                                                         (x', x.fname)))))
 

-let for_unparser xs = 
-  xs +> List.map (fun x -> 
+let for_unparser xs =
+  xs +> List.map (fun x ->

     (x.ast_c, (x.fullstring, x.tokens_c)), Unparse_c.PPviastr
   )
 
 let gen_pdf_graph () =
     (x.ast_c, (x.fullstring, x.tokens_c)), Unparse_c.PPviastr
   )
 
 let gen_pdf_graph () =

-  (Ctl_engine.get_graph_files ()) +> List.iter (fun outfile -> 
+  (Ctl_engine.get_graph_files ()) +> List.iter (fun outfile ->

   Printf.printf "Generation of %s%!" outfile;
   let filename_stack = Ctl_engine.get_graph_comp_files outfile in
   List.iter (fun filename ->
   Printf.printf "Generation of %s%!" outfile;
   let filename_stack = Ctl_engine.get_graph_comp_files outfile in
   List.iter (fun filename ->


@@ -749,20 +915,46 @@ let gen_pdf_graph () =
            ) filename_stack;
   Printf.printf " - Done\n")
 
            ) filename_stack;
   Printf.printf " - Done\n")
 

+let local_python_code =
+    "from coccinelle import *\n"
+
+let python_code =
+  "import coccinelle\n"^
+    "import coccilib\n"^
+    "import coccilib.org\n"^
+    "import coccilib.report\n" ^
+    local_python_code ^
+    "cocci = Cocci()\n"
+
+let make_init lang code rule_info =
+  let mv = [] in
+  {
+  scr_ast_rule = (lang, mv, [], code);
+  language = lang;
+  script_code = (if lang = "python" then python_code else "") ^code;
+  scr_rule_info = rule_info;
+}

 
 (* --------------------------------------------------------------------- *)
 let prepare_cocci ctls free_var_lists negated_pos_lists
 
 (* --------------------------------------------------------------------- *)
 let prepare_cocci ctls free_var_lists negated_pos_lists

-    (ua,fua,fuas) positions_list metavars astcocci = 
+    (ua,fua,fuas) positions_list metavars astcocci =

 
   let gathered = Common.index_list_1
       (zip (zip (zip (zip (zip (zip (zip (zip ctls metavars) astcocci)
                                  free_var_lists)
                   negated_pos_lists) ua) fua) fuas) positions_list)
   in
 
   let gathered = Common.index_list_1
       (zip (zip (zip (zip (zip (zip (zip (zip ctls metavars) astcocci)
                                  free_var_lists)
                   negated_pos_lists) ua) fua) fuas) positions_list)
   in

-  gathered +> List.map 
+  gathered +> List.map

     (fun (((((((((ctl_toplevel_list,metavars),ast),free_var_list),
     (fun (((((((((ctl_toplevel_list,metavars),ast),free_var_list),

-            negated_pos_list),ua),fua),fuas),positions_list),rulenb) -> 
-      
+            negated_pos_list),ua),fua),fuas),positions_list),rulenb) ->
+
+      let build_rule_info rulename deps =
+       {rulename = rulename;
+         dependencies = deps;
+         used_after = (List.hd ua) @ (List.hd fua);
+         ruleid = rulenb;
+         was_matched = ref false;} in
+

       let is_script_rule r =
         match r with
          Ast_cocci.ScriptRule _
       let is_script_rule r =
         match r with
          Ast_cocci.ScriptRule _


@@ -773,84 +965,68 @@ let prepare_cocci ctls free_var_lists negated_pos_lists
       then failwith "not handling multiple minirules";
 
       match ast with
       then failwith "not handling multiple minirules";
 
       match ast with

-        Ast_cocci.ScriptRule (lang,deps,mv,code) ->
-          let r = 
-          {
-            scr_ast_rule = (lang, mv, code);
-            language = lang;
-            scr_dependencies = deps;
-            scr_ruleid = rulenb;
-            script_code = code;
-          }
-          in ScriptRuleCocciInfo r
-      | Ast_cocci.InitialScriptRule (lang,code) ->
-         let mv = [] in
-         let deps = Ast_cocci.NoDep in
+        Ast_cocci.ScriptRule (name,lang,deps,mv,script_vars,code) ->

           let r =
           let r =

-          {
-            scr_ast_rule = (lang, mv, code);
-            language = lang;
-            scr_dependencies = deps;
-            scr_ruleid = rulenb;
-            script_code = code;
-          }
-          in InitialScriptRuleCocciInfo r
-      | Ast_cocci.FinalScriptRule (lang,code) ->
+            {
+             scr_ast_rule = (lang, mv, script_vars, code);
+              language = lang;
+              script_code = code;
+              scr_rule_info = build_rule_info name deps;
+           }
+          in ScriptRuleCocciInfo r
+      | Ast_cocci.InitialScriptRule (name,lang,deps,code) ->
+         let r = make_init lang code (build_rule_info name deps) in
+           InitialScriptRuleCocciInfo r
+      | Ast_cocci.FinalScriptRule (name,lang,deps,code) ->

          let mv = [] in
          let mv = [] in

-         let deps = Ast_cocci.NoDep in

           let r =
           let r =

-          {
-            scr_ast_rule = (lang, mv, code);
-            language = lang;
-            scr_dependencies = deps;
-            scr_ruleid = rulenb;
-            script_code = code;
-          }
+            {
+              scr_ast_rule = (lang, mv, [], code);
+              language = lang;
+              script_code = code;
+              scr_rule_info = build_rule_info name deps;
+            }

           in FinalScriptRuleCocciInfo r
       | Ast_cocci.CocciRule
          (rulename,(dependencies,dropped_isos,z),restast,isexp,ruletype) ->
           in FinalScriptRuleCocciInfo r
       | Ast_cocci.CocciRule
          (rulename,(dependencies,dropped_isos,z),restast,isexp,ruletype) ->

-          CocciRuleCocciInfo (
-          {
-            ctl = List.hd ctl_toplevel_list;
-            metavars = metavars;
-            ast_rule = ast;
-           isexp = List.hd isexp;
-            rulename = rulename;
-            dependencies = dependencies;
-            dropped_isos = dropped_isos;
-            free_vars = List.hd free_var_list;
-            negated_pos_vars = List.hd negated_pos_list;
-            used_after = (List.hd ua) @ (List.hd fua);
-            positions = List.hd positions_list;
-            ruleid = rulenb;
-           ruletype = ruletype;
-            was_matched = ref false;
-          })
+            CocciRuleCocciInfo (
+            {
+              ctl = List.hd ctl_toplevel_list;
+              metavars = metavars;
+              ast_rule = ast;
+             isexp = List.hd isexp;
+              dropped_isos = dropped_isos;
+              free_vars = List.hd free_var_list;
+              negated_pos_vars = List.hd negated_pos_list;
+              positions = List.hd positions_list;
+             ruletype = ruletype;
+             rule_info = build_rule_info rulename dependencies;
+            })

     )
 
     )
 

-

 (* --------------------------------------------------------------------- *)
 
 (* --------------------------------------------------------------------- *)
 

-let build_info_program cprogram env = 
-  
-  let (cs, parseinfos) = 
+let build_info_program (cprogram,typedefs,macros) env =
+
+  let (cs, parseinfos) =

     Common.unzip cprogram in
 
     Common.unzip cprogram in
 

-  let alltoks = 
+  let alltoks =

     parseinfos +> List.map (fun (s,toks) -> toks) +> List.flatten in
 
   (* I use cs' but really annotate_xxx work by doing side effects on cs *)
     parseinfos +> List.map (fun (s,toks) -> toks) +> List.flatten in
 
   (* I use cs' but really annotate_xxx work by doing side effects on cs *)

-  let cs' = 
+  let cs' =

     Comment_annotater_c.annotate_program alltoks cs in
     Comment_annotater_c.annotate_program alltoks cs in

-  let cs_with_envs = 
+  let cs_with_envs =

     Type_annoter_c.annotate_program env (*!g_contain_typedmetavar*) cs'
   in
     Type_annoter_c.annotate_program env (*!g_contain_typedmetavar*) cs'
   in

-  
+

   zip cs_with_envs parseinfos +> List.map (fun ((c, (enva,envb)), parseinfo)->
     let (fullstr, tokens) = parseinfo in
 
   zip cs_with_envs parseinfos +> List.map (fun ((c, (enva,envb)), parseinfo)->
     let (fullstr, tokens) = parseinfo in
 

-    let flow = 
-      ast_to_flow_with_error_messages c +> Common.map_option (fun flow -> 
+    let flow =
+      ast_to_flow_with_error_messages c +>
+      Common.map_option (fun flow ->

         let flow = Ast_to_flow.annotate_loop_nodes flow in
 
         (* remove the fake nodes for julia *)
         let flow = Ast_to_flow.annotate_loop_nodes flow in
 
         (* remove the fake nodes for julia *)


@@ -871,30 +1047,33 @@ let build_info_program cprogram env =
       flow = flow;
 
       contain_loop = contain_loop flow;
       flow = flow;
 
       contain_loop = contain_loop flow;

-  
+

       env_typing_before = enva;
       env_typing_after = envb;
 
       was_modified = ref false;
       env_typing_before = enva;
       env_typing_after = envb;
 
       was_modified = ref false;

+
+      all_typedefs = typedefs;
+      all_macros = macros;

     }
   )
 
 
 
 (* Optimisation. Try not unparse/reparse the whole file when have modifs  *)
     }
   )
 
 
 
 (* Optimisation. Try not unparse/reparse the whole file when have modifs  *)

-let rebuild_info_program cs file isexp = 
+let rebuild_info_program cs file isexp =

   cs +> List.map (fun c ->
     if !(c.was_modified)
     then
       let file = Common.new_temp_file "cocci_small_output" ".c" in
   cs +> List.map (fun c ->
     if !(c.was_modified)
     then
       let file = Common.new_temp_file "cocci_small_output" ".c" in

-      cfile_of_program 
-        [(c.ast_c, (c.fullstring, c.tokens_c)), Unparse_c.PPnormal] 
+      cfile_of_program
+        [(c.ast_c, (c.fullstring, c.tokens_c)), Unparse_c.PPnormal]

         file;
         file;

-         
+

       (* Common.command2 ("cat " ^ 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
       let xs = build_info_program cprogram c.env_typing_before in

-         
+

       (* TODO: assert env has not changed,
       * if yes then must also reparse what follows even if not modified.
       * Do that only if contain_typedmetavar of course, so good opti.
       (* TODO: assert env has not changed,
       * if yes then must also reparse what follows even if not modified.
       * Do that only if contain_typedmetavar of course, so good opti.


@@ -906,106 +1085,116 @@ let rebuild_info_program cs file isexp =
 
 
 let rebuild_info_c_and_headers ccs isexp =
 
 
 let rebuild_info_c_and_headers ccs isexp =

-  ccs +> List.iter (fun c_or_h -> 
+  ccs +> List.iter (fun c_or_h ->

     if c_or_h.asts +> List.exists (fun c -> !(c.was_modified))
     then c_or_h.was_modified_once := true;
   );
     if c_or_h.asts +> List.exists (fun c -> !(c.was_modified))
     then c_or_h.was_modified_once := true;
   );

-  ccs +> List.map (fun c_or_h -> 
+  ccs +> List.map (fun c_or_h ->

     { c_or_h with
     { c_or_h with

-      asts = rebuild_info_program c_or_h.asts c_or_h.full_fname isexp }
+      asts =
+      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 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 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 *)
 
   (* 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 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)));
         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 *)
 (*****************************************************************************)
 
 (* The main algorithm =~
 
 (*****************************************************************************)
 (* Processing the ctls and toplevel C elements *)
 (*****************************************************************************)
 
 (* The main algorithm =~

- * The algorithm is roughly: 
+ * The algorithm is roughly:

  *  for_all ctl rules in SP
  *   for_all minirule in rule (no more)
  *    for_all binding (computed during previous phase)
  *      for_all C elements
  *  for_all ctl rules in SP
  *   for_all minirule in rule (no more)
  *    for_all binding (computed during previous phase)
  *      for_all C elements

- *         match control flow of function vs minirule 
- *         with the binding and update the set of possible 
+ *         match control flow of function vs minirule
+ *         with the binding and update the set of possible

  *         bindings, and returned the possibly modified function.
  *   pretty print modified C elements and reparse it.
  *
  *         bindings, and returned the possibly modified function.
  *   pretty print modified C elements and reparse it.
  *

- * 
+ *

  * On ne prends que les newbinding ou returned_any_state est vrai.
  * Si ca ne donne rien, on prends ce qu'il y avait au depart.
  * On ne prends que les newbinding ou returned_any_state est vrai.
  * Si ca ne donne rien, on prends ce qu'il y avait au depart.

- * Mais au nouveau depart de quoi ?  
+ * Mais au nouveau depart de quoi ?

  * - si ca donne rien apres avoir traité toutes les fonctions avec ce binding ?
  * - si ca donne rien apres avoir traité toutes les fonctions avec ce binding ?

- * - ou alors si ca donne rien, apres avoir traité toutes les fonctions 
+ * - ou alors si ca donne rien, apres avoir traité toutes les fonctions

  *   avec tous les bindings du round d'avant ?
  *   avec tous les bindings du round d'avant ?

- * 
+ *

  * Julia pense qu'il faut prendre la premiere solution.
  * Example: on a deux environnements candidats, E1 et E2 apres avoir traité
  * la regle ctl 1. On arrive sur la regle ctl 2.
  * E1 ne donne rien pour la regle 2, on garde quand meme E1 pour la regle 3.
  * E2 donne un match a un endroit et rend E2' alors on utilise ca pour
  * la regle 3.
  * Julia pense qu'il faut prendre la premiere solution.
  * Example: on a deux environnements candidats, E1 et E2 apres avoir traité
  * la regle ctl 1. On arrive sur la regle ctl 2.
  * E1 ne donne rien pour la regle 2, on garde quand meme E1 pour la regle 3.
  * E2 donne un match a un endroit et rend E2' alors on utilise ca pour
  * la regle 3.

- * 
+ *

  * I have not to look at used_after_list to decide to restart from
  * scratch. I just need to look if the binding list is empty.
  * Indeed, let's suppose that a SP have 3 regions/rules. If we
  * I have not to look at used_after_list to decide to restart from
  * scratch. I just need to look if the binding list is empty.
  * Indeed, let's suppose that a SP have 3 regions/rules. If we


@@ -1017,7 +1206,7 @@ let prepare_c files choose_includes : file_info list =
  * region must bind some metavariables used after, and that we
  * dont find any such region, then mysat() will returns lots of
  * Right, and current_binding will not grow, and so we will have
  * region must bind some metavariables used after, and that we
  * dont find any such region, then mysat() will returns lots of
  * Right, and current_binding will not grow, and so we will have

- * an empty list of binding, and we will catch such a case. 
+ * an empty list of binding, and we will catch such a case.

  *
  * opti: julia says that because the binding is
  * determined by the used_after_list, the items in the list
  *
  * opti: julia says that because the binding is
  * determined by the used_after_list, the items in the list


@@ -1048,64 +1237,137 @@ let merge_env new_e old_e =
       ([],old_e) new_e in
   old_e @ (List.rev ext)
 
       ([],old_e) new_e in
   old_e @ (List.rev ext)
 

-let apply_python_rule r cache newes e rules_that_have_matched
-    rules_that_have_ever_matched =
-  show_or_not_scr_rule_name r.scr_ruleid;
+let contains_binding e (_,(r,m),_) =
+  try
+    let _ = List.find (function ((re, rm), _) -> r =*= re && m =$= rm) e in
+    true
+  with Not_found -> false
+
+let python_application mv ve script_vars r =
+  let mv =
+    List.map
+      (function
+         ((Some x,None),y,z) -> (x,y,z)
+       | _ ->
+           failwith
+             (Printf.sprintf "unexpected ast metavar in rule %s"
+                r.scr_rule_info.rulename))
+      mv in
+  try
+    Pycocci.build_classes (List.map (function (x,y) -> x) ve);
+    Pycocci.construct_variables mv ve;
+    Pycocci.construct_script_variables script_vars;
+    let _ = Pycocci.pyrun_simplestring (local_python_code ^r.script_code) in
+    if !Pycocci.inc_match
+    then Some (Pycocci.retrieve_script_variables script_vars)
+    else None
+  with Pycocci.Pycocciexception ->
+    (pr2 ("Failure in " ^ r.scr_rule_info.rulename);
+     raise Pycocci.Pycocciexception)
+
+let ocaml_application mv ve script_vars r =
+  try
+    let script_vals =
+      Run_ocamlcocci.run mv ve script_vars
+       r.scr_rule_info.rulename r.script_code in
+    if !Coccilib.inc_match
+    then Some script_vals
+    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 () ->
+  show_or_not_scr_rule_name r.scr_rule_info.ruleid;

   if not(interpret_dependencies rules_that_have_matched
   if not(interpret_dependencies rules_that_have_matched

-          !rules_that_have_ever_matched r.scr_dependencies)
+          !rules_that_have_ever_matched r.scr_rule_info.dependencies)

   then
     begin
       print_dependencies "dependencies for script not satisfied:"
        rules_that_have_matched
   then
     begin
       print_dependencies "dependencies for script not satisfied:"
        rules_that_have_matched

-       !rules_that_have_ever_matched r.scr_dependencies;
+       !rules_that_have_ever_matched r.scr_rule_info.dependencies;

       show_or_not_binding "in environment" e;
       (cache, (e, rules_that_have_matched)::newes)
     end
   else
     begin
       show_or_not_binding "in environment" e;
       (cache, (e, rules_that_have_matched)::newes)
     end
   else
     begin

-      let (_, mv, _) = r.scr_ast_rule in
-      let not_bound x = not (Pycocci.contains_binding e x) in
+      let (_, mv, script_vars, _) = r.scr_ast_rule in
+      let ve =
+       (List.map (function (n,v) -> (("virtual",n),Ast_c.MetaIdVal (v,[])))
+          !Flag.defined_virtual_env) @ e in
+      let not_bound x = not (contains_binding ve x) in

       (match List.filter not_bound mv with
        [] ->
          let relevant_bindings =
            List.filter
              (function ((re,rm),_) ->
       (match List.filter not_bound mv with
        [] ->
          let relevant_bindings =
            List.filter
              (function ((re,rm),_) ->

-               List.exists (function (_,(r,m)) -> r =$= re && m =$= rm) mv)
+               List.exists (function (_,(r,m),_) -> r =*= re && m =$= rm) mv)

              e in
              e in

-         let new_cache =
-           if List.mem relevant_bindings cache
-           then cache
-           else
-             begin
-               print_dependencies "dependencies for script satisfied:"
+         (try
+           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_matched

-                 !rules_that_have_ever_matched r.scr_dependencies;
+                 !rules_that_have_ever_matched
+                 r.scr_rule_info.dependencies;

                show_or_not_binding "in" e;
                show_or_not_binding "in" e;

-               Pycocci.build_classes (List.map (function (x,y) -> x) e);
-               Pycocci.construct_variables mv e;
-               let _ = Pycocci.pyrun_simplestring
-                 ("import coccinelle\nfrom coccinelle "^
-                  "import *\ncocci = Cocci()\n" ^
-                  r.script_code) in
-               relevant_bindings :: cache
-             end in
-         if !Pycocci.inc_match
-         then (new_cache, merge_env [(e, rules_that_have_matched)] newes)
-         else (new_cache, newes)
+             (* 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)
+         with Not_found ->
+           begin
+             print_dependencies "dependencies for script satisfied:"
+               rules_that_have_matched
+               !rules_that_have_ever_matched
+               r.scr_rule_info.dependencies;
+             show_or_not_binding "in" e;
+             match script_application mv ve script_vars r with
+               None ->
+                 (* failure means we should drop e, no new bindings *)
+                 (((relevant_bindings,None) :: cache), newes)
+             | Some script_vals ->
+                 let script_vals =
+                   List.map (function x -> Ast_c.MetaIdVal(x,[]))
+                     script_vals in
+                 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
+                 r.scr_rule_info.was_matched := true;
+                 (((relevant_bindings,Some script_vals) :: cache),
+                  merge_env
+                    [(new_e,
+                      r.scr_rule_info.rulename :: rules_that_have_matched)]
+                    newes)
+           end)

       |        unbound ->
          (if !Flag_cocci.show_dependencies
          then
       |        unbound ->
          (if !Flag_cocci.show_dependencies
          then

-           let m2c (_,(r,x)) = r^"."^x in
+           let m2c (_,(r,x),_) = r^"."^x in

            pr2 (Printf.sprintf "script not applied: %s not bound"
                   (String.concat ", " (List.map m2c unbound))));
            pr2 (Printf.sprintf "script not applied: %s not bound"
                   (String.concat ", " (List.map m2c unbound))));

+         let e =
+           e +>
+           List.filter
+             (fun (s,v) -> List.mem s r.scr_rule_info.used_after) in

          (cache, merge_env [(e, rules_that_have_matched)] newes))
          (cache, merge_env [(e, rules_that_have_matched)] newes))

-    end
+    end)

 
 let rec apply_cocci_rule r rules_that_have_ever_matched es
     (ccs:file_info list ref) =
 
 let rec apply_cocci_rule r rules_that_have_ever_matched es
     (ccs:file_info list ref) =

-  Common.profile_code r.rulename (fun () -> 
-    show_or_not_rule_name r.ast_rule r.ruleid;
-    show_or_not_ctl_text r.ctl r.ast_rule r.ruleid;
+  Common.profile_code r.rule_info.rulename (fun () ->
+    show_or_not_rule_name r.ast_rule r.rule_info.ruleid;
+    show_or_not_ctl_text r.ctl r.ast_rule r.rule_info.ruleid;

 
     let reorganized_env =
       reassociate_positions r.free_vars r.negated_pos_vars !es in
 
     let reorganized_env =
       reassociate_positions r.free_vars r.negated_pos_vars !es in


@@ -1116,17 +1378,21 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es
        (function (cache,newes) ->
          function ((e,rules_that_have_matched),relevant_bindings) ->
            if not(interpret_dependencies rules_that_have_matched
        (function (cache,newes) ->
          function ((e,rules_that_have_matched),relevant_bindings) ->
            if not(interpret_dependencies rules_that_have_matched

-                    !rules_that_have_ever_matched r.dependencies)
+                    !rules_that_have_ever_matched
+                    r.rule_info.dependencies)

            then
              begin
                print_dependencies
            then
              begin
                print_dependencies

-                 ("dependencies for rule "^r.rulename^" not satisfied:")
+                 ("dependencies for rule "^r.rule_info.rulename^
+                  " not satisfied:")

                  rules_that_have_matched
                  rules_that_have_matched

-                 !rules_that_have_ever_matched r.dependencies;
+                 !rules_that_have_ever_matched r.rule_info.dependencies;

                show_or_not_binding "in environment" e;
                (cache,
                 merge_env
                show_or_not_binding "in environment" e;
                (cache,
                 merge_env

-                  [(e +> List.filter (fun (s,v) -> List.mem s r.used_after),
+                  [(e +>
+                    List.filter
+                      (fun (s,v) -> List.mem s r.rule_info.used_after),

                     rules_that_have_matched)]
                   newes)
              end
                     rules_that_have_matched)]
                   newes)
              end


@@ -1136,9 +1402,11 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es
                with
                  Not_found ->
                    print_dependencies
                with
                  Not_found ->
                    print_dependencies

-                     ("dependencies for rule "^r.rulename^" satisfied:")
+                     ("dependencies for rule "^r.rule_info.rulename^
+                      " satisfied:")

                      rules_that_have_matched
                      rules_that_have_matched

-                     !rules_that_have_ever_matched r.dependencies;
+                     !rules_that_have_ever_matched
+                     r.rule_info.dependencies;

                    show_or_not_binding "in" e;
                    show_or_not_binding "relevant in" relevant_bindings;
 
                    show_or_not_binding "in" e;
                    show_or_not_binding "relevant in" relevant_bindings;
 


@@ -1149,8 +1417,8 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es
                         .c and .h *)
                        List.rev
                          (concat_headers_and_c !ccs +>
                         .c and .h *)
                        List.rev
                          (concat_headers_and_c !ccs +>

-                          List.fold_left (fun children_e (c,f) -> 
-                            if c.flow <> None 
+                          List.fold_left (fun children_e (c,f) ->
+                            if c.flow <> None

                             then
                              (* does also some side effects on c and r *)
                               let processed =
                             then
                              (* does also some side effects on c and r *)
                               let processed =


@@ -1158,10 +1426,10 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es
                                   relevant_bindings c f in
                               match processed with
                               | None -> children_e
                                   relevant_bindings c f in
                               match processed with
                               | None -> children_e

-                              | Some newbindings -> 
+                              | Some newbindings ->

                                   newbindings +>
                                   List.fold_left
                                   newbindings +>
                                   List.fold_left

-                                    (fun children_e newbinding -> 
+                                    (fun children_e newbinding ->

                                       if List.mem newbinding children_e
                                       then children_e
                                       else newbinding :: children_e)
                                       if List.mem newbinding children_e
                                       then children_e
                                       else newbinding :: children_e)


@@ -1175,7 +1443,9 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es
 
              let old_bindings_to_keep =
                Common.nub
 
              let old_bindings_to_keep =
                Common.nub

-                 (e +> List.filter (fun (s,v) -> List.mem s r.used_after)) in
+                 (e +>
+                  List.filter
+                    (fun (s,v) -> List.mem s r.rule_info.used_after)) in

              let new_e =
                if null new_bindings
                then
              let new_e =
                if null new_bindings
                then


@@ -1184,7 +1454,7 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es
                    if !Flag_ctl.partial_match
                    then
                      printf
                    if !Flag_ctl.partial_match
                    then
                      printf

-                       "Empty list of bindings, I will restart from old env";
+                       "Empty list of bindings, I will restart from old env\n";

                    [(old_bindings_to_keep,rules_that_have_matched)]
                  end
                else
                    [(old_bindings_to_keep,rules_that_have_matched)]
                  end
                else


@@ -1201,21 +1471,24 @@ let rec apply_cocci_rule r rules_that_have_ever_matched es
                      (new_bindings +>
                       List.map
                         (List.filter
                      (new_bindings +>
                       List.map
                         (List.filter

-                           (fun (s,v) ->
-                             List.mem s r.used_after &&
-                             not (List.mem s old_variables)))) in
+                           (function
+                               (* see comment before combine_pos *)
+                               (s,Ast_c.MetaPosValList []) -> false
+                             | (s,v) ->
+                                 List.mem s r.rule_info.used_after &&
+                                 not (List.mem s old_variables)))) in

                  List.map
                    (function new_binding_to_add ->
                      (List.sort compare
                         (Common.union_set
                            old_bindings_to_keep new_binding_to_add),
                  List.map
                    (function new_binding_to_add ->
                      (List.sort compare
                         (Common.union_set
                            old_bindings_to_keep new_binding_to_add),

-                      r.rulename::rules_that_have_matched))
+                      r.rule_info.rulename::rules_that_have_matched))

                    new_bindings_to_add in
              ((relevant_bindings,new_bindings)::cache,
               merge_env new_e newes))
        ([],[]) reorganized_env in (* end iter es *)
                    new_bindings_to_add in
              ((relevant_bindings,new_bindings)::cache,
               merge_env new_e newes))
        ([],[]) reorganized_env in (* end iter es *)

-    if !(r.was_matched)
-    then Common.push2 r.rulename rules_that_have_ever_matched;
+    if !(r.rule_info.was_matched)
+    then Common.push2 r.rule_info.rulename rules_that_have_ever_matched;

 
     es := newes;
 
 
     es := newes;
 


@@ -1284,22 +1557,28 @@ and reassociate_positions free_vars negated_pos_vars envs =
      (List.map (function (non_pos,_) -> List.assoc non_pos extended_relevant)
        splitted_relevant)
 
      (List.map (function (non_pos,_) -> List.assoc non_pos extended_relevant)
        splitted_relevant)
 

+(* If the negated posvar is not bound at all, this function will
+nevertheless bind it to [].  If we get rid of these bindings, then the
+matching of the term the position variable with the constraints will fail
+because some variables are unbound.  So we let the binding be [] and then
+we will have to clean these up afterwards.  This should be the only way
+that a position variable can have an empty binding. *)

 and combine_pos negated_pos_vars others =
   List.map
     (function posvar ->
 and combine_pos negated_pos_vars others =
   List.map
     (function posvar ->

-      (posvar,
-       Ast_c.MetaPosValList
-        (List.sort compare
-           (List.fold_left
-              (function positions ->
-                function other_list ->
-                  try
-                    match List.assoc posvar other_list with
-                      Ast_c.MetaPosValList l1 ->
-                        Common.union_set l1 positions
-                    | _ -> failwith "bad value for a position variable"
-                  with Not_found -> positions)
-              [] others))))
+      let positions =
+       List.sort compare
+         (List.fold_left
+            (function positions ->
+              function other_list ->
+                try
+                  match List.assoc posvar other_list with
+                    Ast_c.MetaPosValList l1 ->
+                      Common.union_set l1 positions
+                  | _ -> failwith "bad value for a position variable"
+                with Not_found -> positions)
+            [] others) in
+      (posvar,Ast_c.MetaPosValList positions))

     negated_pos_vars
 
 and process_a_generated_a_env_a_toplevel2 r env = function
     negated_pos_vars
 
 and process_a_generated_a_env_a_toplevel2 r env = function


@@ -1307,7 +1586,7 @@ and process_a_generated_a_env_a_toplevel2 r env = function
       let free_vars =
        List.filter
          (function
       let free_vars =
        List.filter
          (function

-             (rule,_) when rule =$= r.rulename -> false
+             (rule,_) when rule =$= r.rule_info.rulename -> false

            | (_,"ARGS") -> false
            | _ -> true)
          r.free_vars in
            | (_,"ARGS") -> false
            | _ -> true)
          r.free_vars in


@@ -1315,53 +1594,53 @@ and process_a_generated_a_env_a_toplevel2 r env = function
       let metavars =
        List.filter
          (function md ->
       let metavars =
        List.filter
          (function md ->

-           let (rl,_) = Ast_cocci.get_meta_name md in
-           rl =$= r.rulename)
+           let (rl,_) = Ast_cocci.get_meta_name md in rl =$= r.rule_info.rulename)

          r.metavars in
       if Common.include_set free_vars env_domain
       then Unparse_hrule.pp_rule metavars r.ast_rule env cfile.full_fname
   | _ -> failwith "multiple files not supported"
 
          r.metavars in
       if Common.include_set free_vars env_domain
       then Unparse_hrule.pp_rule metavars r.ast_rule env cfile.full_fname
   | _ -> failwith "multiple files not supported"
 

-and process_a_generated_a_env_a_toplevel rule env ccs = 
-  Common.profile_code "process_a_ctl_a_env_a_toplevel" 
+and process_a_generated_a_env_a_toplevel rule env ccs =
+  Common.profile_code "process_a_ctl_a_env_a_toplevel"

     (fun () -> process_a_generated_a_env_a_toplevel2 rule env ccs)
 
 (* does side effects on C ast and on Cocci info rule *)
     (fun () -> process_a_generated_a_env_a_toplevel2 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 () -> 
+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);
   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 () -> 
+  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;
       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
       (***************************************)
       (* !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.used_after, e)
-    ) 
+      in CCI.mysat model_ctl r.ctl (r.rule_info.used_after, e)
+    )

   in
   in

-  if not returned_any_states 
+  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;
   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;    
+    List.iter (show_or_not_binding "out") newbindings;

 
 

-    r.was_matched := true;
+    r.rule_info.was_matched := true;

 
 

-    if not (null trans_info)
+    if not (null trans_info) &&
+      not (!Flag.sgrep_mode2 && not !Flag_cocci.show_diff)

     then begin
       c.was_modified := true;
     then begin
       c.was_modified := true;

-      try 
+      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 *)
         (* 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.rulename r.dropped_isos
+        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;
                   inherited_bindings trans_info (Common.some c.flow));
       with Timeout -> raise Timeout | UnixExit i -> raise (UnixExit i)
     end;


@@ -1369,33 +1648,35 @@ and process_a_ctl_a_env_a_toplevel2 r e c f =
     Some (List.map (function x -> x@inherited_bindings) newbindings)
   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" 
+
+and process_a_ctl_a_env_a_toplevel  a b c f=
+  Common.profile_code "process_a_ctl_a_env_a_toplevel"

     (fun () -> process_a_ctl_a_env_a_toplevel2 a b c f)
 
 
     (fun () -> process_a_ctl_a_env_a_toplevel2 a b c f)
 
 

-let rec bigloop2 rs (ccs: file_info list) = 
-  let es = ref [(Ast_c.emptyMetavarsBinding,[])] in
+let rec bigloop2 rs (ccs: file_info list) =
+  let init_es = [(Ast_c.emptyMetavarsBinding,[])] in
+  let es = ref init_es in

   let ccs = ref ccs in
   let rules_that_have_ever_matched = ref [] in
 
   (* looping over the rules *)
   let ccs = ref ccs in
   let rules_that_have_ever_matched = ref [] in
 
   (* looping over the rules *)

-  rs +> List.iter (fun r -> 
+  rs +> List.iter (fun r ->

     match r with
       InitialScriptRuleCocciInfo r | FinalScriptRuleCocciInfo r -> ()
     match r with
       InitialScriptRuleCocciInfo r | FinalScriptRuleCocciInfo r -> ()

-    | ScriptRuleCocciInfo r -> 
+    | ScriptRuleCocciInfo r ->

        if !Flag_cocci.show_ctl_text then begin
           Common.pr_xxxxxxxxxxxxxxxxx ();
           pr ("script: " ^ r.language);
           Common.pr_xxxxxxxxxxxxxxxxx ();
        if !Flag_cocci.show_ctl_text then begin
           Common.pr_xxxxxxxxxxxxxxxxx ();
           pr ("script: " ^ r.language);
           Common.pr_xxxxxxxxxxxxxxxxx ();

-         
-          adjust_pp_with_indent (fun () -> 
+
+          adjust_pp_with_indent (fun () ->

             Format.force_newline();
             Format.force_newline();

-            let (l,mv,code) = r.scr_ast_rule in
-           let deps = r.scr_dependencies in
+            let (l,mv,script_vars,code) = r.scr_ast_rule in
+           let nm = r.scr_rule_info.rulename in
+           let deps = r.scr_rule_info.dependencies in

             Pretty_print_cocci.unparse
             Pretty_print_cocci.unparse

-             (Ast_cocci.ScriptRule (l,deps,mv,code)));
+             (Ast_cocci.ScriptRule (nm,l,deps,mv,script_vars,code)));

        end;
 
        if !Flag.show_misc then print_endline "RESULT =";
        end;
 
        if !Flag.show_misc then print_endline "RESULT =";


@@ -1406,28 +1687,35 @@ let rec bigloop2 rs (ccs: file_info list) =
               function (e, rules_that_have_matched) ->
                match r.language with
                   "python" ->
               function (e, rules_that_have_matched) ->
                match r.language with
                   "python" ->

-                   apply_python_rule r cache newes e rules_that_have_matched
-                     rules_that_have_ever_matched
+                   apply_script_rule r cache newes e rules_that_have_matched
+                     rules_that_have_ever_matched python_application
+                | "ocaml" ->
+                   apply_script_rule r cache newes e rules_that_have_matched
+                     rules_that_have_ever_matched ocaml_application

                | "test" ->
                | "test" ->

-                   concat_headers_and_c !ccs +> List.iter (fun (c,_) -> 
-                     if c.flow <> None 
+                   concat_headers_and_c !ccs +> List.iter (fun (c,_) ->
+                     if c.flow <> None

                      then
                        Printf.printf "Flow: %s\r\nFlow!\r\n%!" c.fullstring);
                    (cache, newes)
                | _ ->
                     Printf.printf "Unknown language: %s\n" r.language;
                      then
                        Printf.printf "Flow: %s\r\nFlow!\r\n%!" c.fullstring);
                    (cache, newes)
                | _ ->
                     Printf.printf "Unknown language: %s\n" r.language;

-                    (cache, newes)
-                     )
+                    (cache, newes))

             ([],[]) !es in
 
             ([],[]) !es in
 

-        es := newes;
+       (if !(r.scr_rule_info.was_matched)
+       then
+         Common.push2 r.scr_rule_info.rulename rules_that_have_ever_matched);
+
+        es := newes (*(if newes = [] then init_es else newes)*);

     | CocciRuleCocciInfo r ->
     | CocciRuleCocciInfo r ->

-       apply_cocci_rule r rules_that_have_ever_matched es ccs);
+       apply_cocci_rule r rules_that_have_ever_matched
+         es ccs);

 
   if !Flag.sgrep_mode2
   then begin
     (* sgrep can lead to code that is not parsable, but we must
 
   if !Flag.sgrep_mode2
   then begin
     (* sgrep can lead to code that is not parsable, but we must

-     * still call rebuild_info_c_and_headers to pretty print the 
+     * still call rebuild_info_c_and_headers to pretty print the

      * action (MINUS), so that later the diff will show what was
      * matched by sgrep. But we don't want the parsing error message
      * hence the following flag setting. So this code propably
      * action (MINUS), so that later the diff will show what was
      * matched by sgrep. But we don't want the parsing error message
      * hence the following flag setting. So this code propably


@@ -1439,31 +1727,41 @@ let rec bigloop2 rs (ccs: file_info list) =
   end;
   !ccs (* return final C asts *)
 
   end;
   !ccs (* return final C asts *)
 

-let bigloop a b = 
+let bigloop a b =

   Common.profile_code "bigloop" (fun () -> bigloop2 a b)
 
   Common.profile_code "bigloop" (fun () -> bigloop2 a b)
 

-let initial_final_bigloop2 ty rebuild r = 
+type init_final = Initial | Final
+
+let initial_final_bigloop2 ty rebuild r =

   if !Flag_cocci.show_ctl_text then
     begin
       Common.pr_xxxxxxxxxxxxxxxxx ();
   if !Flag_cocci.show_ctl_text then
     begin
       Common.pr_xxxxxxxxxxxxxxxxx ();

-      pr (ty ^ ": " ^ r.language);
+      pr ((match ty with Initial -> "initial" | Final -> "final") ^ ": " ^
+         r.language);

       Common.pr_xxxxxxxxxxxxxxxxx ();
 
       Common.pr_xxxxxxxxxxxxxxxxx ();
 

-      adjust_pp_with_indent (fun () -> 
+      adjust_pp_with_indent (fun () ->

        Format.force_newline();
        Format.force_newline();

-       Pretty_print_cocci.unparse(rebuild r.scr_ast_rule));
+       Pretty_print_cocci.unparse(rebuild r.scr_ast_rule r.scr_rule_info.dependencies));

     end;
 
   match r.language with
     "python" ->
       (* include_match makes no sense in an initial or final rule, although
     end;
 
   match r.language with
     "python" ->
       (* include_match makes no sense in an initial or final rule, although

-        er have no way to prevent it *)
-      let _ = apply_python_rule r [] [] [] [] (ref []) in ()
+        we have no way to prevent it *)
+      let _ = apply_script_rule r [] [] [] [] (ref []) python_application in
+      ()
+  | "ocaml" when ty = Initial -> () (* nothing to do *)
+  | "ocaml" ->
+      (* include_match makes no sense in an initial or final rule, although
+        we have no way to prevent it *)
+      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 = 
+let initial_final_bigloop a b c =

   Common.profile_code "initial_final_bigloop"
     (fun () -> initial_final_bigloop2 a b c)
 
   Common.profile_code "initial_final_bigloop"
     (fun () -> initial_final_bigloop2 a b c)
 


@@ -1475,17 +1773,18 @@ let pre_engine2 (coccifile, isofile) =
   show_or_not_cocci coccifile isofile;
   Pycocci.set_coccifile coccifile;
 
   show_or_not_cocci coccifile isofile;
   Pycocci.set_coccifile coccifile;
 

-  let isofile = 
+  let isofile =

     if not (Common.lfile_exists isofile)
     if not (Common.lfile_exists isofile)

-    then begin 
+    then begin

       pr2 ("warning: Can't find default iso file: " ^ isofile);
       None
     end
     else Some isofile in
 
   (* useful opti when use -dir *)
       pr2 ("warning: Can't find default iso file: " ^ isofile);
       None
     end
     else Some isofile in
 
   (* useful opti when use -dir *)

-  let (metavars,astcocci,free_var_lists,negated_pos_lists,used_after_lists,
-       positions_lists,toks,_) = 
+  let (metavars,astcocci,
+       free_var_lists,negated_pos_lists,used_after_lists,
+       positions_lists,(toks,_,_)) =

       sp_of_file coccifile isofile in
   let ctls = ctls_of_ast astcocci used_after_lists positions_lists in
 
       sp_of_file coccifile isofile in
   let ctls = ctls_of_ast astcocci used_after_lists positions_lists in
 


@@ -1499,33 +1798,83 @@ let pre_engine2 (coccifile, isofile) =
     prepare_cocci ctls free_var_lists negated_pos_lists
       used_after_lists positions_lists metavars astcocci in
 
     prepare_cocci ctls free_var_lists negated_pos_lists
       used_after_lists positions_lists metavars astcocci in
 

-  let _ =
+  let used_languages =
+    List.fold_left
+      (function languages ->
+        function
+            ScriptRuleCocciInfo(r) ->
+              if List.mem r.language languages then
+                languages
+              else
+                r.language::languages
+          | _ -> 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) ->
     List.fold_left
       (function languages ->
        function
            InitialScriptRuleCocciInfo(r) ->

-             (if List.mem r.language languages
-             then failwith ("double initializer found for "^r.language));
-             initial_final_bigloop "initial"
-               (function(x,_,y) -> Ast_cocci.InitialScriptRule(x,y))
-               r;
-             r.language::languages
+             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
          | _ -> 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 =
+       {rulename = "";
+         dependencies = Ast_cocci.NoDep;
+         used_after = [];
+         ruleid = (-1);
+         was_matched = ref false;} in
+      runrule (make_init lgg "" rule_info))
+    uninitialized_languages;
+

   (cocci_infos,toks)
 
   (cocci_infos,toks)
 

-let pre_engine a = 
+let pre_engine a =

   Common.profile_code "pre_engine" (fun () -> pre_engine2 a)
 
   Common.profile_code "pre_engine" (fun () -> pre_engine2 a)
 

-let full_engine2 (cocci_infos,toks) cfiles = 
+let full_engine2 (cocci_infos,toks) cfiles =

 
   show_or_not_cfiles  cfiles;
 
   (* optimisation allowing to launch coccinelle on all the drivers *)
   if !Flag_cocci.worth_trying_opt && not (worth_trying cfiles toks)
   then
 
   show_or_not_cfiles  cfiles;
 
   (* optimisation allowing to launch coccinelle on all the drivers *)
   if !Flag_cocci.worth_trying_opt && not (worth_trying cfiles toks)
   then

-    begin 
-      pr2 ("not worth trying:" ^ Common.join " " cfiles);
+    begin
+      (match toks with
+       None -> ()
+      | Some toks ->
+         pr2 ("No matches found for " ^ (Common.join " " toks)
+              ^ "\nSkipping:" ^ (Common.join " " cfiles)));

       cfiles +> List.map (fun s -> s, None)
     end
   else
       cfiles +> List.map (fun s -> s, None)
     end
   else


@@ -1552,7 +1901,7 @@ let full_engine2 (cocci_infos,toks) cfiles =
       if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx ();
       if !Flag_ctl.graphical_trace then gen_pdf_graph ();
 
       if !Flag.show_misc then Common.pr_xxxxxxxxxxxxxxxxx ();
       if !Flag_ctl.graphical_trace then gen_pdf_graph ();
 

-      c_infos' +> List.map (fun c_or_h -> 
+      c_infos' +> List.map (fun c_or_h ->

        if !(c_or_h.was_modified_once)
        then
          begin
        if !(c_or_h.was_modified_once)
        then
          begin


@@ -1565,8 +1914,7 @@ let full_engine2 (cocci_infos,toks) cfiles =
             (* and now unparse everything *)
             cfile_of_program (for_unparser c_or_h.asts) outfile;
 
             (* and now unparse everything *)
             cfile_of_program (for_unparser c_or_h.asts) outfile;
 

-            let show_only_minus = !Flag.sgrep_mode2 in
-            show_or_not_diff c_or_h.fpath outfile show_only_minus;
+            show_or_not_diff c_or_h.fpath outfile;

 
             (c_or_h.fpath,
              if !Flag.sgrep_mode2 then None else Some outfile)
 
             (c_or_h.fpath,
              if !Flag.sgrep_mode2 then None else Some outfile)


@@ -1574,56 +1922,63 @@ let full_engine2 (cocci_infos,toks) cfiles =
        else (c_or_h.fpath, None))
     end
 
        else (c_or_h.fpath, None))
     end
 

-let full_engine a b = 
-  Common.profile_code "full_engine" (fun () -> full_engine2 a b)
+let full_engine a b =
+  Common.profile_code "full_engine"
+    (fun () -> let res = full_engine2 a b in (*Gc.print_stat stderr; *)res)

 
 let post_engine2 (cocci_infos,_) =
 
 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"
-               (function(x,_,y) -> Ast_cocci.FinalScriptRule(x,y))
-               r;
-             r.language::languages
-         | _ -> languages)
-      [] cocci_infos in
-  ()
-
-let post_engine a = 
+  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)
 
 (*****************************************************************************)
 (* check duplicate from result of full_engine *)
 (*****************************************************************************)
 
   Common.profile_code "post_engine" (fun () -> post_engine2 a)
 
 (*****************************************************************************)
 (* check duplicate from result of full_engine *)
 (*****************************************************************************)
 

-let check_duplicate_modif2 xs = 
+let check_duplicate_modif2 xs =

   (* opti: let groups = Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) xs *)
   if !Flag_cocci.verbose_cocci
   then pr2 ("Check duplication for " ^ i_to_s (List.length xs) ^ " files");
 
   let groups = Common.group_assoc_bykey_eff xs in
   (* opti: let groups = Common.groupBy (fun (a,resa) (b,resb) -> a =$= b) xs *)
   if !Flag_cocci.verbose_cocci
   then pr2 ("Check duplication for " ^ i_to_s (List.length xs) ^ " files");
 
   let groups = Common.group_assoc_bykey_eff xs in

-  groups +> Common.map_filter (fun (file, xs) -> 
+  groups +> Common.map_filter (fun (file, xs) ->

     match xs with
     | [] -> raise Impossible
     | [res] -> Some (file, res)
     match xs with
     | [] -> raise Impossible
     | [res] -> Some (file, res)

-    | res::xs -> 
-        match res with 
-        | None -> 
+    | res::xs ->
+        match res with
+        | None ->

             if not (List.for_all (fun res2 -> res2 =*= None) xs)
             then begin
               pr2 ("different modification result for " ^ file);
               None
             end
             else Some (file, None)
             if not (List.for_all (fun res2 -> res2 =*= None) xs)
             then begin
               pr2 ("different modification result for " ^ file);
               None
             end
             else Some (file, None)

-        | Some res -> 
-            if not(List.for_all (fun res2 -> 
+        | Some res ->
+            if not(List.for_all (fun res2 ->

               match res2 with
               | None -> false
               match res2 with
               | None -> false

-              | Some res2 -> 
+              | Some res2 ->

                   let diff = Common.cmd_to_list ("diff -u -b -B "^res^" "^res2)
                   in
                   null diff
                   let diff = Common.cmd_to_list ("diff -u -b -B "^res^" "^res2)
                   in
                   null diff


@@ -1632,9 +1987,7 @@ let check_duplicate_modif2 xs =
               None
             end
             else Some (file, Some res)
               None
             end
             else Some (file, Some res)

-            
-        

   )
   )

-let check_duplicate_modif a = 
+let check_duplicate_modif a =

   Common.profile_code "check_duplicate" (fun () -> check_duplicate_modif2 a)
 
   Common.profile_code "check_duplicate" (fun () -> check_duplicate_modif2 a)