-(*
-* 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.
-*)
-
-
(* 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
(List.map (function l -> List.fold_left (@) [] (List.map astfvs l))
anythings) in
match mck with
- Ast.MINUS(_,anythings) -> process_anything_list_list anythings
+ 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
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)))
(* ---------------------------------------------------------------- *)
(* 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 =
[] 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 =
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 =
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
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 =
| Ast.InitialScriptRule (_,_) | Ast.FinalScriptRule (_,_) -> []
| Ast.CocciRule (_,_,rule,_,_) ->
Common.union_set (nub (collect_all_rule_refs rule))
- (collect_in_plus rule) in
+ (collect_in_plus metavar_list rule) in
let inherited =
List.filter (function x -> not (List.mem x locally_defined))
free_vars in
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 =
match r with
Ast.ScriptRule (_,_,_,_)
| Ast.InitialScriptRule (_,_) | Ast.FinalScriptRule (_,_) ->
- ([], [used_after])
+ ([], [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) ->
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)
HCoop / bpt / coccinelle.git / blobdiff