Release coccinelle-0.2.3rc1
[bpt/coccinelle.git] / parsing_cocci / free_vars.ml
index be830b1..09d7bd9 100644 (file)
@@ -1,29 +1,54 @@
 (*
-* 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 2005-2010, 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.
+ *)
+
+
+(*
+ * Copyright 2005-2010, 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.
+ *)
 
 
 (* For each rule return the list of variables that are used after it.
 Also augment various parts of each rule with unitary, inherited, and freshness
 informations *)
 
+(* metavar decls should be better integrated into computations of free
+variables in plus code *)
+
 module Ast = Ast_cocci
 module V = Visitor_ast
 module TC = Type_cocci
@@ -83,24 +108,49 @@ let collect_refs include_constraints =
   let astfvident recursor k i =
     bind (k i)
       (match Ast.unwrap i with
-       Ast.MetaId(name,_,_,_) | Ast.MetaFunc(name,_,_,_)
-      | Ast.MetaLocalFunc(name,_,_,_) -> [metaid name]
+       Ast.MetaId(name,idconstraint,_,_) | Ast.MetaFunc(name,idconstraint,_,_)
+      | Ast.MetaLocalFunc(name,idconstraint,_,_) ->
+         let metas =
+           if include_constraints
+           then
+             match idconstraint with
+               Ast.IdNegIdSet (_,metas) -> metas
+             | _ -> []
+           else [] in
+         bind (List.rev metas) [metaid name]
       | _ -> option_default) in
 
   let rec type_collect res = function
       TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
     | TC.Array(ty) -> type_collect res ty
-    | TC.MetaType(tyname,_,_) -> bind [tyname] res
+    | TC.MetaType(tyname,_,_) ->
+       bind [tyname] res
     | TC.SignedT(_,Some ty) -> type_collect res ty
     | ty -> res in
 
   let astfvexpr recursor k e =
     bind (k e)
       (match Ast.unwrap e with
-       Ast.MetaExpr(name,_,_,Some type_list,_,_) ->
+       Ast.MetaExpr(name,constraints,_,Some type_list,_,_) ->
          let types = List.fold_left type_collect option_default type_list in
-         bind [metaid name] types
-      | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) -> [metaid name]
+         let extra =
+           if include_constraints
+           then
+             match constraints with
+               Ast.SubExpCstrt l -> l
+             | _ -> []
+           else [] in
+         bind extra (bind [metaid name] types)
+      | Ast.MetaErr(name,constraints,_,_)
+      | Ast.MetaExpr(name,constraints,_,_,_,_) ->
+         let extra =
+           if include_constraints
+           then
+             match constraints with
+               Ast.SubExpCstrt l -> l
+             | _ -> []
+           else [] in
+         bind extra [metaid name]
       | Ast.MetaExprList(name,None,_,_) -> [metaid name]
       | Ast.MetaExprList(name,Some (lenname,_,_),_,_) ->
          [metaid name;metaid lenname]
@@ -193,14 +243,17 @@ let collect_saved =
   let astfvident recursor k i =
     bind (k i)
       (match Ast.unwrap i with
-       Ast.MetaId(name,_,TC.Saved,_) | Ast.MetaFunc(name,_,TC.Saved,_)
-      | Ast.MetaLocalFunc(name,_,TC.Saved,_) -> [metaid name]
+       Ast.MetaId(name,_,TC.Saved,_)
+      | Ast.MetaFunc(name,_,TC.Saved,_)
+      | Ast.MetaLocalFunc(name,_,TC.Saved,_) ->
+         [metaid name]
       | _ -> option_default) in
 
   let rec type_collect res = function
       TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
     | TC.Array(ty) -> type_collect res ty
-    | TC.MetaType(tyname,TC.Saved,_) -> bind [tyname] res
+    | TC.MetaType(tyname,TC.Saved,_) ->
+       bind [tyname] res
     | TC.SignedT(_,Some ty) -> type_collect res ty
     | ty -> res in
 
@@ -284,15 +337,50 @@ let cip_mcodekind r mck =
     Ast.MINUS(_,_,_,anythings) -> process_anything_list_list anythings
   | Ast.CONTEXT(_,befaft) ->
       (match befaft with
-       Ast.BEFORE(ll) -> process_anything_list_list ll
-      | Ast.AFTER(ll) -> process_anything_list_list ll
-      | Ast.BEFOREAFTER(llb,lla) ->
+       Ast.BEFORE(ll,_) -> process_anything_list_list ll
+      | Ast.AFTER(ll,_) -> process_anything_list_list ll
+      | Ast.BEFOREAFTER(llb,lla,_) ->
          (process_anything_list_list lla) @
          (process_anything_list_list llb)
       | Ast.NOTHING -> [])
-  | Ast.PLUS -> []
+  | Ast.PLUS _ -> []
+
+
+let collect_fresh_seed_env metavars l =
+  let fresh =
+    List.fold_left
+      (function prev ->
+       function
+           Ast.MetaFreshIdDecl(_,seed) as x ->
+             ((Ast.get_meta_name x),seed)::prev
+         | _ -> prev)
+      [] metavars in
+  let (seed_env,seeds) =
+    List.fold_left
+      (function (seed_env,seeds) as prev ->
+       function x ->
+         try
+           (let v = List.assoc x fresh in
+           match v with
+             Ast.ListSeed l ->
+               let ids =
+                 List.fold_left
+                   (function prev ->
+                     function
+                         Ast.SeedId(id) -> id::prev
+                       | _ -> prev)
+                   [] l in
+               ((x,ids)::seed_env,Common.union_set ids seeds)
+           | _ -> ((x,[])::seed_env,seeds))
+         with Not_found -> prev)
+      ([],l) l in
+  (List.rev seed_env,List.rev seeds)
+
+let collect_fresh_seed metavars l =
+  let (_,seeds) = collect_fresh_seed_env metavars l in seeds
 
 let collect_in_plus_term =
+
   let bind x y = x @ y in
   let option_default = [] in
   let donothing r k e = k e in
@@ -347,10 +435,11 @@ let collect_in_plus_term =
     donothing donothing donothing donothing donothing donothing
     donothing astfvrule_elem astfvstatement donothing donothing donothing
 
-let collect_in_plus minirules =
+let collect_in_plus metavars minirules =
   nub
-    (List.concat
-       (List.map collect_in_plus_term.V.combiner_top_level minirules))
+    (collect_fresh_seed metavars
+       (List.concat
+         (List.map collect_in_plus_term.V.combiner_top_level minirules)))
 
 (* ---------------------------------------------------------------- *)
 
@@ -366,10 +455,10 @@ let collect_all_multirefs minirules =
 (* classify as unitary (no binding) or nonunitary (env binding) or saved
 (witness binding) *)
 
-let classify_variables metavars minirules used_after =
-  let metavars = List.map Ast.get_meta_name metavars in
+let classify_variables metavar_decls minirules used_after =
+  let metavars = List.map Ast.get_meta_name metavar_decls in
   let (unitary,nonunitary) = collect_all_multirefs minirules in
-  let inplus = collect_in_plus minirules in
+  let inplus = collect_in_plus metavar_decls minirules in
 
   let donothing r k e = k e in
   let check_unitary name inherited =
@@ -398,7 +487,8 @@ let classify_variables metavars minirules used_after =
     match Ast.unwrap e with
       Ast.MetaId(name,constraints,_,_) ->
        let (unitary,inherited) = classify name in
-       Ast.rewrap e (Ast.MetaId(name,constraints,unitary,inherited))
+       Ast.rewrap e
+         (Ast.MetaId(name,constraints,unitary,inherited))
     | Ast.MetaFunc(name,constraints,_,_) ->
        let (unitary,inherited) = classify name in
        Ast.rewrap e (Ast.MetaFunc(name,constraints,unitary,inherited))
@@ -520,20 +610,22 @@ let astfvs metavars bound =
       [] metavars in
 
   let collect_fresh l =
-    List.rev
-      (List.fold_left
-       (function prev ->
+    let (matched,freshvars) =
+      List.fold_left
+       (function (matched,freshvars) ->
          function x ->
-           try let v = List.assoc x fresh in (x,v)::prev
-           with Not_found -> prev)
-       [] l) in
+           try let v = List.assoc x fresh in (matched,(x,v)::freshvars)
+           with Not_found -> (x::matched,freshvars))
+       ([],[]) l in
+    (List.rev matched, List.rev freshvars) in
 
   (* cases for the elements of anything *)
-  let astfvrule_elem recursor k re =
-    let minus_free = nub (collect_all_refs.V.combiner_rule_elem re) in
+  let simple_setup getter k re =
+    let minus_free = nub (getter collect_all_refs re) in
     let minus_nc_free =
-      nub (collect_non_constraint_refs.V.combiner_rule_elem re) in
-    let plus_free = collect_in_plus_term.V.combiner_rule_elem re in
+      nub (getter collect_non_constraint_refs re) in
+    let plus_free =
+      collect_fresh_seed metavars (getter collect_in_plus_term re) in
     let free = Common.union_set minus_free plus_free in
     let nc_free = Common.union_set minus_nc_free plus_free in
     let unbound =
@@ -542,18 +634,24 @@ let astfvs metavars bound =
       List.filter (function x -> List.mem x bound) nc_free in
     let munbound =
       List.filter (function x -> not(List.mem x bound)) minus_free in
+    let (matched,fresh) = collect_fresh unbound in
     {(k re) with
-      Ast.free_vars = unbound;
+      Ast.free_vars = matched;
       Ast.minus_free_vars = munbound;
-      Ast.fresh_vars = collect_fresh unbound;
+      Ast.fresh_vars = fresh;
       Ast.inherited = inherited;
       Ast.saved_witness = []} in
 
+  let astfvrule_elem recursor k re =
+    simple_setup (function x -> x.V.combiner_rule_elem) k re in
+
   let astfvstatement recursor k s =
     let minus_free = nub (collect_all_refs.V.combiner_statement s) in
     let minus_nc_free =
       nub (collect_non_constraint_refs.V.combiner_statement s) in
-    let plus_free = collect_in_plus_term.V.combiner_statement s in
+    let plus_free =
+      collect_fresh_seed metavars
+       (collect_in_plus_term.V.combiner_statement s) in
     let free = Common.union_set minus_free plus_free in
     let nc_free = Common.union_set minus_nc_free plus_free in
     let classify free minus_free =
@@ -561,63 +659,48 @@ let astfvs metavars bound =
        List.partition (function x -> not(List.mem x bound)) free in
       let munbound =
        List.filter (function x -> not(List.mem x bound)) minus_free in
-      (unbound,munbound,collect_fresh unbound,inherited) in
+      let (matched,fresh) = collect_fresh unbound in
+      (matched,munbound,fresh,inherited) in
     let res = k s in
     let s =
+      let cip_plus aft =
+       collect_fresh_seed metavars
+         (cip_mcodekind collect_in_plus_term aft) in
       match Ast.unwrap res with
        Ast.IfThen(header,branch,(_,_,_,aft)) ->
-         let (unbound,_,fresh,inherited) =
-           classify (cip_mcodekind collect_in_plus_term aft) [] in
+         let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in
          Ast.IfThen(header,branch,(unbound,fresh,inherited,aft))
       | Ast.IfThenElse(header,branch1,els,branch2,(_,_,_,aft)) ->
-         let (unbound,_,fresh,inherited) =
-           classify (cip_mcodekind collect_in_plus_term aft) [] in
+         let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in
          Ast.IfThenElse(header,branch1,els,branch2,
                         (unbound,fresh,inherited,aft))
       | Ast.While(header,body,(_,_,_,aft)) ->
-         let (unbound,_,fresh,inherited) =
-           classify (cip_mcodekind collect_in_plus_term aft) [] in
+         let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in
          Ast.While(header,body,(unbound,fresh,inherited,aft))
       | Ast.For(header,body,(_,_,_,aft)) ->
-         let (unbound,_,fresh,inherited) =
-           classify (cip_mcodekind collect_in_plus_term aft) [] in
+         let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in
          Ast.For(header,body,(unbound,fresh,inherited,aft))
       | Ast.Iterator(header,body,(_,_,_,aft)) ->
-         let (unbound,_,fresh,inherited) =
-           classify (cip_mcodekind collect_in_plus_term aft) [] in
+         let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in
          Ast.Iterator(header,body,(unbound,fresh,inherited,aft))
       |        s -> s in
 
-    let (unbound,munbound,fresh,_) = classify free minus_free in
+    let (matched,munbound,fresh,_) = classify free minus_free in
     let inherited =
       List.filter (function x -> List.mem x bound) nc_free in
     {res with
       Ast.node = s;
-      Ast.free_vars = unbound;
+      Ast.free_vars = matched;
       Ast.minus_free_vars = munbound;
-      Ast.fresh_vars = collect_fresh unbound;
+      Ast.fresh_vars = fresh;
       Ast.inherited = inherited;
       Ast.saved_witness = []} in
 
   let astfvstatement_dots recursor k sd =
-    let minus_free = nub (collect_all_refs.V.combiner_statement_dots sd) in
-    let minus_nc_free =
-      nub (collect_non_constraint_refs.V.combiner_statement_dots sd) in
-    let plus_free = collect_in_plus_term.V.combiner_statement_dots sd in
-    let free = Common.union_set minus_free plus_free in
-    let nc_free = Common.union_set minus_nc_free plus_free in
-    let unbound =
-      List.filter (function x -> not(List.mem x bound)) free in
-    let inherited =
-      List.filter (function x -> List.mem x bound) nc_free in
-    let munbound =
-      List.filter (function x -> not(List.mem x bound)) minus_free in
-    {(k sd) with
-      Ast.free_vars = unbound;
-      Ast.minus_free_vars = munbound;
-      Ast.fresh_vars = collect_fresh unbound;
-      Ast.inherited = inherited;
-      Ast.saved_witness = []} in
+    simple_setup (function x -> x.V.combiner_statement_dots) k sd in
+
+  let astfvcase_line recursor k cl =
+    simple_setup (function x -> x.V.combiner_case_line) k cl in
 
   let astfvtoplevel recursor k tl =
     let saved = collect_saved.V.combiner_top_level tl in
@@ -630,7 +713,7 @@ let astfvs metavars bound =
     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
     donothing donothing astfvstatement_dots donothing
     donothing donothing donothing donothing donothing donothing donothing
-    astfvrule_elem astfvstatement donothing astfvtoplevel donothing
+    astfvrule_elem astfvstatement astfvcase_line astfvtoplevel donothing
 
 (*
 let collect_astfvs rules =
@@ -651,7 +734,7 @@ let collect_astfvs rules =
     | (metavars, rule)::rules ->
         match rule with
           Ast.ScriptRule (_,_,_,_)
-       | Ast.InitialScriptRule (_,_) | Ast.FinalScriptRule (_,_) ->
+       | Ast.InitialScriptRule (_,_,_) | Ast.FinalScriptRule (_,_,_) ->
            (* bound stays as is because script rules have no names, so no
               inheritance is possible *)
            rule::(loop bound rules)
@@ -717,6 +800,7 @@ their point of definition. *)
 
 
 let collect_top_level_used_after metavar_rule_list =
+  let drop_virt = List.filter (function ("virtual",_) -> false | _ -> true) in
   let (used_after,used_after_lists) =
     List.fold_right
       (function (metavar_list,r) ->
@@ -728,11 +812,12 @@ let collect_top_level_used_after metavar_rule_list =
          let free_vars =
             match r with
               Ast.ScriptRule (_,_,mv,_) ->
-                List.map (function (_,(r,v)) -> (r,v)) mv
-            | Ast.InitialScriptRule (_,_) | Ast.FinalScriptRule (_,_) -> []
+                drop_virt(List.map (function (_,(r,v)) -> (r,v)) mv)
+            | Ast.InitialScriptRule (_,_,_) | Ast.FinalScriptRule (_,_,_) -> []
             | Ast.CocciRule (_,_,rule,_,_) ->
-               Common.union_set (nub (collect_all_rule_refs rule))
-                 (collect_in_plus rule) in
+               drop_virt
+                 (Common.union_set (nub (collect_all_rule_refs rule))
+                    (collect_in_plus metavar_list rule)) in
          let inherited =
            List.filter (function x -> not (List.mem x locally_defined))
              free_vars in
@@ -748,26 +833,85 @@ let collect_top_level_used_after metavar_rule_list =
 
 let collect_local_used_after metavars minirules used_after =
   let locally_defined = List.map Ast.get_meta_name metavars in
-  let rec loop defined = function
-      [] -> (used_after,[],[])
+  let rec loop = function
+      [] -> (used_after,[],[],[],[])
     | minirule::rest ->
-       let free_vars =
-         Common.union_set
-           (nub (collect_all_minirule_refs minirule))
-           (collect_in_plus_term.V.combiner_top_level minirule) in
-       let local_free_vars =
-         List.filter (function x -> List.mem x locally_defined) free_vars in
-       let new_defined = Common.union_set local_free_vars defined in
-       let (mini_used_after,fvs_lists,mini_used_after_lists) =
-         loop new_defined rest in
-       let local_used = Common.union_set local_free_vars mini_used_after in
-       let (new_used_after,new_list) =
-         List.partition (function x -> List.mem x defined) mini_used_after in
-       let new_used_after = Common.union_set local_used new_used_after in
-       (new_used_after,free_vars::fvs_lists,
-        new_list::mini_used_after_lists) in
-  let (_,fvs_lists,used_after_lists) = loop [] minirules in
-  (fvs_lists,used_after_lists)
+       (* In a rule there are three kinds of local variables:
+          1. Variables referenced in the minus or context code.
+          These get a value by matching.  This value can be used in
+          subsequent rules.
+          2. Fresh variables referenced in the plus code.
+          3. Variables referenced in the seeds of the fresh variables.
+          There are also non-local variables. These may either be variables
+          referenced in the minus, context, or plus code, or they may be
+          variables referenced in the seeds of the fresh variables. *)
+       (* Step 1: collect all references in minus/context, plus, seed
+          code *)
+       let variables_referenced_in_minus_context_code =
+         nub (collect_all_minirule_refs minirule) in
+       let variables_referenced_in_plus_code =
+         collect_in_plus_term.V.combiner_top_level minirule in
+       let (env_of_fresh_seeds,seeds_and_plus) =
+         collect_fresh_seed_env
+           metavars variables_referenced_in_plus_code in
+       let all_free_vars =
+         Common.union_set variables_referenced_in_minus_context_code
+           seeds_and_plus in
+       (* Step 2: identify locally defined ones *)
+       let local_fresh = List.map fst env_of_fresh_seeds in
+       let is_local =
+         List.partition (function x -> List.mem x locally_defined) in
+       let local_env_of_fresh_seeds =
+         (* these have to be restricted to only one value if the associated
+            fresh variable is used after *)
+         List.map (function (f,ss) -> (f,is_local ss)) env_of_fresh_seeds in
+       let (local_all_free_vars,nonlocal_all_free_vars) =
+         is_local all_free_vars in
+       (* Step 3, recurse on the rest of the rules, making available whatever
+          has been defined in this one *)
+       let (mini_used_after,fvs_lists,mini_used_after_lists,
+            mini_fresh_used_after_lists,mini_fresh_used_after_seeds) =
+         loop rest in
+       (* Step 4: collect the results.  These are:
+          1. All of the variables used non-locally in the rules starting
+          with this one
+          2. All of the free variables to the end of the semantic patch
+          3. The variables that are used afterwards and defined here by
+          matching (minus or context code)
+          4. The variables that are used afterwards and are defined here as
+          fresh
+          5. The variables that are used as seeds in computing the bindings
+          of the variables collected in part 4. *)
+       let (local_used_after, nonlocal_used_after) =
+         is_local mini_used_after in
+       let (fresh_local_used_after(*4*),matched_local_used_after) =
+         List.partition (function x -> List.mem x local_fresh)
+           local_used_after in
+       let matched_local_used_after(*3*) =
+         Common.union_set matched_local_used_after nonlocal_used_after in
+       let new_used_after = (*1*)
+         Common.union_set nonlocal_all_free_vars nonlocal_used_after in
+       let fresh_local_used_after_seeds =
+         List.filter
+           (* no point to keep variables that already are gtd to have only
+              one value *)
+           (function x -> not (List.mem x matched_local_used_after))
+           (List.fold_left (function p -> function c -> Common.union_set c p)
+              []
+              (List.map
+                 (function fua ->
+                   fst (List.assoc fua local_env_of_fresh_seeds))
+                 fresh_local_used_after)) in
+       (new_used_after,all_free_vars::fvs_lists(*2*),
+        matched_local_used_after::mini_used_after_lists,
+        fresh_local_used_after::mini_fresh_used_after_lists,
+        fresh_local_used_after_seeds::mini_fresh_used_after_seeds) in
+  let (_,fvs_lists,used_after_lists(*ua*),
+       fresh_used_after_lists(*fua*),fresh_used_after_lists_seeds(*fuas*)) =
+    loop minirules in
+  (fvs_lists,used_after_lists,
+   fresh_used_after_lists,fresh_used_after_lists_seeds)
+
 
 
 let collect_used_after metavar_rule_list =
@@ -777,20 +921,27 @@ let collect_used_after metavar_rule_list =
       function used_after ->
         match r with
           Ast.ScriptRule (_,_,_,_)
-       | Ast.InitialScriptRule (_,_) | Ast.FinalScriptRule (_,_) ->
-           ([], [used_after])
+       | Ast.InitialScriptRule (_,_,_) | Ast.FinalScriptRule (_,_,_) ->
+           ([], [used_after], [], [])
         | Ast.CocciRule (name, rule_info, minirules, _,_) ->
           collect_local_used_after metavars minirules used_after
     )
     metavar_rule_list used_after_lists
 
+let rec split4 = function
+    [] -> ([],[],[],[])
+  | (a,b,c,d)::l -> let (a1,b1,c1,d1) = split4 l in (a::a1,b::b1,c::c1,d::d1)
+
 (* ---------------------------------------------------------------- *)
 (* entry point *)
 
 let free_vars rules =
   let metavars = List.map (function (mv,rule) -> mv) rules in
-  let (fvs_lists,used_after_lists) = List.split (collect_used_after rules) in
-  let neg_pos_lists = List.map2 get_neg_pos_list rules used_after_lists in
+  let (fvs_lists,used_after_matched_lists,
+       fresh_used_after_lists,fresh_used_after_lists_seeds) =
+    split4 (collect_used_after rules) in
+  let neg_pos_lists =
+    List.map2 get_neg_pos_list rules used_after_matched_lists in
   let positions_list = (* for all rules, assume all positions are used after *)
     List.map
       (function (mv, r) ->
@@ -808,15 +959,20 @@ let free_vars rules =
   let new_rules =
     List.map2
       (function (mv,r) ->
-       function ua ->
+       function (ua,fua) ->
           match r with
             Ast.ScriptRule _
          | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> r
           | Ast.CocciRule (nm, rule_info, r, is_exp,ruletype) ->
              Ast.CocciRule
-               (nm, rule_info, classify_variables mv r (List.concat ua),
+               (nm, rule_info,
+                classify_variables mv r
+                  ((List.concat ua) @ (List.concat fua)),
                 is_exp,ruletype))
-      rules used_after_lists in
+      rules (List.combine used_after_matched_lists fresh_used_after_lists) in
   let new_rules = collect_astfvs (List.combine metavars new_rules) in
   (metavars,new_rules,
-   fvs_lists,neg_pos_lists,used_after_lists,positions_list)
+   fvs_lists,neg_pos_lists,
+   (used_after_matched_lists,
+    fresh_used_after_lists,fresh_used_after_lists_seeds),
+   positions_list)