2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
23 (* For each rule return the list of variables that are used after it.
24 Also augment various parts of each rule with unitary, inherited, and freshness
27 module Ast = Ast_cocci
28 module V = Visitor_ast
29 module TC = Type_cocci
31 let rec nub = function
33 | (x::xs) when (List.mem x xs) -> nub xs
34 | (x::xs) -> x::(nub xs)
36 (* Collect all variable references in a minirule. For a disj, we collect
37 the maximum number (2 is enough) of references in any branch. *)
39 let collect_unitary_nonunitary free_usage =
40 let free_usage = List.sort compare free_usage in
41 let rec loop1 todrop = function (* skips multiple occurrences *)
43 | (x::xs) as all -> if x = todrop then loop1 todrop xs else all in
44 let rec loop2 = function
48 if x = y (* occurs more than once in free_usage *)
50 let (unitary,non_unitary) = loop2(loop1 x xs) in
51 (unitary,x::non_unitary)
52 else (* occurs only once in free_usage *)
53 let (unitary,non_unitary) = loop2 (y::xs) in
54 (x::unitary,non_unitary) in
57 let collect_refs include_constraints =
58 let bind x y = x @ y in
59 let option_default = [] in
61 let donothing recursor k e = k e in (* just combine in the normal way *)
63 let donothing_a recursor k e = (* anything is not wrapped *)
64 k e in (* just combine in the normal way *)
66 (* the following considers that anything that occurs non-unitarily in one
67 branch occurs nonunitarily in all branches. This is not optimal, but
68 doing better seems to require a breadth-first traversal, which is
69 perhaps better to avoid. Also, unitarily is represented as occuring once,
70 while nonunitarily is represented as twice - more is irrelevant *)
71 (* cases for disjs and metavars *)
72 let bind_disj refs_branches =
73 let (unitary,nonunitary) =
74 List.split (List.map collect_unitary_nonunitary refs_branches) in
75 let unitary = nub (List.concat unitary) in
76 let nonunitary = nub (List.concat nonunitary) in
78 List.filter (function x -> not (List.mem x nonunitary)) unitary in
79 unitary@nonunitary@nonunitary in
81 let metaid (x,_,_,_) = x in
83 let astfvident recursor k i =
85 (match Ast.unwrap i with
86 Ast.MetaId(name,_,_,_) | Ast.MetaFunc(name,_,_,_)
87 | Ast.MetaLocalFunc(name,_,_,_) -> [metaid name]
88 | _ -> option_default) in
90 let rec type_collect res = function
91 TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
92 | TC.Array(ty) -> type_collect res ty
93 | TC.MetaType(tyname,_,_) -> bind [tyname] res
94 | TC.SignedT(_,Some ty) -> type_collect res ty
97 let astfvexpr recursor k e =
99 (match Ast.unwrap e with
100 Ast.MetaExpr(name,_,_,Some type_list,_,_) ->
101 let types = List.fold_left type_collect option_default type_list in
102 bind [metaid name] types
103 | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) -> [metaid name]
104 | Ast.MetaExprList(name,None,_,_) -> [metaid name]
105 | Ast.MetaExprList(name,Some (lenname,_,_),_,_) ->
106 [metaid name;metaid lenname]
107 | Ast.DisjExpr(exps) -> bind_disj (List.map k exps)
108 | _ -> option_default) in
110 let astfvdecls recursor k d =
112 (match Ast.unwrap d with
113 Ast.DisjDecl(decls) -> bind_disj (List.map k decls)
114 | _ -> option_default) in
116 let astfvfullType recursor k ty =
118 (match Ast.unwrap ty with
119 Ast.DisjType(types) -> bind_disj (List.map k types)
120 | _ -> option_default) in
122 let astfvtypeC recursor k ty =
124 (match Ast.unwrap ty with
125 Ast.MetaType(name,_,_) -> [metaid name]
126 | _ -> option_default) in
128 let astfvparam recursor k p =
130 (match Ast.unwrap p with
131 Ast.MetaParam(name,_,_) -> [metaid name]
132 | Ast.MetaParamList(name,None,_,_) -> [metaid name]
133 | Ast.MetaParamList(name,Some(lenname,_,_),_,_) ->
134 [metaid name;metaid lenname]
135 | _ -> option_default) in
137 let astfvrule_elem recursor k re =
138 (*within a rule_elem, pattern3 manages the coherence of the bindings*)
141 (match Ast.unwrap re with
142 Ast.MetaRuleElem(name,_,_) | Ast.MetaStmt(name,_,_,_)
143 | Ast.MetaStmtList(name,_,_) -> [metaid name]
144 | _ -> option_default)) in
146 let astfvstatement recursor k s =
148 (match Ast.unwrap s with
150 bind_disj (List.map recursor.V.combiner_statement_dots stms)
151 | _ -> option_default) in
154 if include_constraints
156 match Ast.get_pos_var mc with
157 Ast.MetaPos(name,constraints,_,_,_) -> (metaid name)::constraints
158 | _ -> option_default
159 else option_default in
161 V.combiner bind option_default
162 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
163 donothing donothing donothing donothing
164 astfvident astfvexpr astfvfullType astfvtypeC donothing astfvparam
165 astfvdecls astfvrule_elem astfvstatement donothing donothing donothing_a
167 let collect_all_refs = collect_refs true
168 let collect_non_constraint_refs = collect_refs false
170 let collect_all_rule_refs minirules =
171 List.fold_left (@) []
172 (List.map collect_all_refs.V.combiner_top_level minirules)
174 let collect_all_minirule_refs = collect_all_refs.V.combiner_top_level
176 (* ---------------------------------------------------------------- *)
179 let bind = Common.union_set in
180 let option_default = [] in
182 let donothing recursor k e = k e in (* just combine in the normal way *)
184 let metaid (x,_,_,_) = x in
186 (* cases for metavariables *)
187 let astfvident recursor k i =
189 (match Ast.unwrap i with
190 Ast.MetaId(name,_,TC.Saved,_) | Ast.MetaFunc(name,_,TC.Saved,_)
191 | Ast.MetaLocalFunc(name,_,TC.Saved,_) -> [metaid name]
192 | _ -> option_default) in
194 let rec type_collect res = function
195 TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
196 | TC.Array(ty) -> type_collect res ty
197 | TC.MetaType(tyname,TC.Saved,_) -> bind [tyname] res
198 | TC.SignedT(_,Some ty) -> type_collect res ty
201 let astfvexpr recursor k e =
203 match Ast.unwrap e with
204 Ast.MetaExpr(name,_,_,Some type_list,_,_) ->
205 List.fold_left type_collect option_default type_list
209 (match Ast.unwrap e with
210 Ast.MetaErr(name,_,TC.Saved,_) | Ast.MetaExpr(name,_,TC.Saved,_,_,_)
211 | Ast.MetaExprList(name,None,TC.Saved,_) -> [metaid name]
212 | Ast.MetaExprList(name,Some (lenname,ls,_),ns,_) ->
214 match ns with TC.Saved -> [metaid name] | _ -> [] in
216 match ls with TC.Saved -> [metaid lenname] | _ -> [] in
218 | _ -> option_default) in
221 let astfvtypeC recursor k ty =
223 (match Ast.unwrap ty with
224 Ast.MetaType(name,TC.Saved,_) -> [metaid name]
225 | _ -> option_default) in
227 let astfvparam recursor k p =
229 (match Ast.unwrap p with
230 Ast.MetaParam(name,TC.Saved,_)
231 | Ast.MetaParamList(name,None,_,_) -> [metaid name]
232 | Ast.MetaParamList(name,Some (lenname,ls,_),ns,_) ->
234 match ns with TC.Saved -> [metaid name] | _ -> [] in
236 match ls with TC.Saved -> [metaid lenname] | _ -> [] in
238 | _ -> option_default) in
240 let astfvrule_elem recursor k re =
241 (*within a rule_elem, pattern3 manages the coherence of the bindings*)
244 (match Ast.unwrap re with
245 Ast.MetaRuleElem(name,TC.Saved,_) | Ast.MetaStmt(name,TC.Saved,_,_)
246 | Ast.MetaStmtList(name,TC.Saved,_) -> [metaid name]
247 | _ -> option_default)) in
250 match Ast.get_pos_var e with
251 Ast.MetaPos(name,_,_,TC.Saved,_) -> [metaid name]
252 | _ -> option_default in
254 V.combiner bind option_default
255 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
256 donothing donothing donothing donothing
257 astfvident astfvexpr donothing astfvtypeC donothing astfvparam
258 donothing astfvrule_elem donothing donothing donothing donothing
260 (* ---------------------------------------------------------------- *)
262 (* For the rules under a given metavariable declaration, collect all of the
263 variables that occur in the plus code *)
265 let cip_mcodekind r mck =
266 let process_anything_list_list anythings =
267 let astfvs = collect_all_refs.V.combiner_anything in
268 List.fold_left (@) []
269 (List.map (function l -> List.fold_left (@) [] (List.map astfvs l))
272 Ast.MINUS(_,anythings) -> process_anything_list_list anythings
273 | Ast.CONTEXT(_,befaft) ->
275 Ast.BEFORE(ll) -> process_anything_list_list ll
276 | Ast.AFTER(ll) -> process_anything_list_list ll
277 | Ast.BEFOREAFTER(llb,lla) ->
278 (process_anything_list_list lla) @
279 (process_anything_list_list llb)
283 let collect_in_plus_term =
284 let bind x y = x @ y in
285 let option_default = [] in
286 let donothing r k e = k e in
288 (* no positions in the + code *)
289 let mcode r (_,_,mck,_) = cip_mcodekind r mck in
291 (* case for things with bef/aft mcode *)
293 let astfvrule_elem recursor k re =
294 match Ast.unwrap re with
295 Ast.FunHeader(bef,_,fi,nm,_,params,_) ->
300 Ast.FType(ty) -> collect_all_refs.V.combiner_fullType ty
303 let nm_metas = collect_all_refs.V.combiner_ident nm in
305 match Ast.unwrap params with
306 Ast.DOTS(params) | Ast.CIRCLES(params) ->
310 match Ast.unwrap p with
311 Ast.VoidParam(t) | Ast.Param(t,_) ->
312 collect_all_refs.V.combiner_fullType t
315 | _ -> failwith "not allowed for params" in
319 (bind (cip_mcodekind recursor bef) (k re))))
320 | Ast.Decl(bef,_,_) ->
321 bind (cip_mcodekind recursor bef) (k re)
324 let astfvstatement recursor k s =
325 match Ast.unwrap s with
326 Ast.IfThen(_,_,(_,_,_,aft)) | Ast.IfThenElse(_,_,_,_,(_,_,_,aft))
327 | Ast.While(_,_,(_,_,_,aft)) | Ast.For(_,_,(_,_,_,aft))
328 | Ast.Iterator(_,_,(_,_,_,aft)) ->
329 bind (k s) (cip_mcodekind recursor aft)
332 V.combiner bind option_default
333 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
334 donothing donothing donothing donothing
335 donothing donothing donothing donothing donothing donothing
336 donothing astfvrule_elem astfvstatement donothing donothing donothing
338 let collect_in_plus minirules =
341 (List.map collect_in_plus_term.V.combiner_top_level minirules))
343 (* ---------------------------------------------------------------- *)
345 (* For the rules under a given metavariable declaration, collect all of the
346 variables that occur only once and more than once in the minus code *)
348 let collect_all_multirefs minirules =
349 let refs = List.map collect_all_refs.V.combiner_top_level minirules in
350 collect_unitary_nonunitary (List.concat refs)
352 (* ---------------------------------------------------------------- *)
354 (* classify as unitary (no binding) or nonunitary (env binding) or saved
357 let classify_variables metavars minirules used_after =
358 let metavars = List.map Ast.get_meta_name metavars in
359 let (unitary,nonunitary) = collect_all_multirefs minirules in
360 let inplus = collect_in_plus minirules in
362 let donothing r k e = k e in
363 let check_unitary name inherited =
364 if List.mem name inplus or List.mem name used_after
366 else if not inherited && List.mem name unitary
368 else TC.Nonunitary in
370 let get_option f = function Some x -> Some (f x) | None -> None in
372 let classify (name,_,_,_) =
373 let inherited = not (List.mem name metavars) in
374 (check_unitary name inherited,inherited) in
377 match Ast.get_pos_var mc with
378 Ast.MetaPos(name,constraints,per,unitary,inherited) ->
379 let (unitary,inherited) = classify name in
380 Ast.set_pos_var (Ast.MetaPos(name,constraints,per,unitary,inherited))
386 match Ast.unwrap e with
387 Ast.MetaId(name,constraints,_,_) ->
388 let (unitary,inherited) = classify name in
389 Ast.rewrap e (Ast.MetaId(name,constraints,unitary,inherited))
390 | Ast.MetaFunc(name,constraints,_,_) ->
391 let (unitary,inherited) = classify name in
392 Ast.rewrap e (Ast.MetaFunc(name,constraints,unitary,inherited))
393 | Ast.MetaLocalFunc(name,constraints,_,_) ->
394 let (unitary,inherited) = classify name in
395 Ast.rewrap e (Ast.MetaLocalFunc(name,constraints,unitary,inherited))
398 let rec type_infos = function
399 TC.ConstVol(cv,ty) -> TC.ConstVol(cv,type_infos ty)
400 | TC.Pointer(ty) -> TC.Pointer(type_infos ty)
401 | TC.FunctionPointer(ty) -> TC.FunctionPointer(type_infos ty)
402 | TC.Array(ty) -> TC.Array(type_infos ty)
403 | TC.MetaType(name,_,_) ->
404 let (unitary,inherited) = classify (name,(),(),Ast.NoMetaPos) in
405 Type_cocci.MetaType(name,unitary,inherited)
406 | TC.SignedT(sgn,Some ty) -> TC.SignedT(sgn,Some (type_infos ty))
409 let expression r k e =
411 match Ast.unwrap e with
412 Ast.MetaErr(name,constraints,_,_) ->
413 let (unitary,inherited) = classify name in
414 Ast.rewrap e (Ast.MetaErr(name,constraints,unitary,inherited))
415 | Ast.MetaExpr(name,constraints,_,ty,form,_) ->
416 let (unitary,inherited) = classify name in
417 let ty = get_option (List.map type_infos) ty in
418 Ast.rewrap e (Ast.MetaExpr(name,constraints,unitary,ty,form,inherited))
419 | Ast.MetaExprList(name,None,_,_) ->
420 (* lenname should have the same properties of being unitary or
422 let (unitary,inherited) = classify name in
423 Ast.rewrap e (Ast.MetaExprList(name,None,unitary,inherited))
424 | Ast.MetaExprList(name,Some(lenname,_,_),_,_) ->
425 (* lenname should have the same properties of being unitary or
427 let (unitary,inherited) = classify name in
428 let (lenunitary,leninherited) = classify lenname in
431 (name,Some(lenname,lenunitary,leninherited),unitary,inherited))
436 match Ast.unwrap e with
437 Ast.MetaType(name,_,_) ->
438 let (unitary,inherited) = classify name in
439 Ast.rewrap e (Ast.MetaType(name,unitary,inherited))
444 match Ast.unwrap e with
445 Ast.MetaParam(name,_,_) ->
446 let (unitary,inherited) = classify name in
447 Ast.rewrap e (Ast.MetaParam(name,unitary,inherited))
448 | Ast.MetaParamList(name,None,_,_) ->
449 let (unitary,inherited) = classify name in
450 Ast.rewrap e (Ast.MetaParamList(name,None,unitary,inherited))
451 | Ast.MetaParamList(name,Some (lenname,_,_),_,_) ->
452 let (unitary,inherited) = classify name in
453 let (lenunitary,leninherited) = classify lenname in
456 (name,Some (lenname,lenunitary,leninherited),unitary,inherited))
459 let rule_elem r k e =
461 match Ast.unwrap e with
462 Ast.MetaStmt(name,_,msi,_) ->
463 let (unitary,inherited) = classify name in
464 Ast.rewrap e (Ast.MetaStmt(name,unitary,msi,inherited))
465 | Ast.MetaStmtList(name,_,_) ->
466 let (unitary,inherited) = classify name in
467 Ast.rewrap e (Ast.MetaStmtList(name,unitary,inherited))
471 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
472 donothing donothing donothing donothing
473 ident expression donothing typeC donothing param donothing rule_elem
474 donothing donothing donothing donothing in
476 List.map fn.V.rebuilder_top_level minirules
478 (* ---------------------------------------------------------------- *)
480 (* For a minirule, collect the set of non-local (not in "bound") variables that
481 are referenced. Store them in a hash table. *)
483 (* bound means the metavariable was declared previously, not locally *)
485 (* Highly inefficient, because we call collect_all_refs on nested code
486 multiple times. But we get the advantage of not having too many variants
487 of the same functions. *)
489 (* Inherited doesn't include position constraints. If they are not bound
490 then there is no constraint. *)
492 let astfvs metavars bound =
497 Ast.MetaFreshIdDecl(_,_) as x -> (Ast.get_meta_name x)::prev
501 let collect_fresh = List.filter (function x -> List.mem x fresh) in
503 (* cases for the elements of anything *)
504 let astfvrule_elem recursor k re =
505 let minus_free = nub (collect_all_refs.V.combiner_rule_elem re) in
507 nub (collect_non_constraint_refs.V.combiner_rule_elem re) in
508 let plus_free = collect_in_plus_term.V.combiner_rule_elem re in
509 let free = Common.union_set minus_free plus_free in
510 let nc_free = Common.union_set minus_nc_free plus_free in
512 List.filter (function x -> not(List.mem x bound)) free in
514 List.filter (function x -> List.mem x bound) nc_free in
516 List.filter (function x -> not(List.mem x bound)) minus_free in
518 Ast.free_vars = unbound;
519 Ast.minus_free_vars = munbound;
520 Ast.fresh_vars = collect_fresh unbound;
521 Ast.inherited = inherited;
522 Ast.saved_witness = []} in
524 let astfvstatement recursor k s =
525 let minus_free = nub (collect_all_refs.V.combiner_statement s) in
527 nub (collect_non_constraint_refs.V.combiner_statement s) in
528 let plus_free = collect_in_plus_term.V.combiner_statement s in
529 let free = Common.union_set minus_free plus_free in
530 let nc_free = Common.union_set minus_nc_free plus_free in
531 let classify free minus_free =
532 let (unbound,inherited) =
533 List.partition (function x -> not(List.mem x bound)) free in
535 List.filter (function x -> not(List.mem x bound)) minus_free in
536 (unbound,munbound,collect_fresh unbound,inherited) in
539 match Ast.unwrap res with
540 Ast.IfThen(header,branch,(_,_,_,aft)) ->
541 let (unbound,_,fresh,inherited) =
542 classify (cip_mcodekind collect_in_plus_term aft) [] in
543 Ast.IfThen(header,branch,(unbound,fresh,inherited,aft))
544 | Ast.IfThenElse(header,branch1,els,branch2,(_,_,_,aft)) ->
545 let (unbound,_,fresh,inherited) =
546 classify (cip_mcodekind collect_in_plus_term aft) [] in
547 Ast.IfThenElse(header,branch1,els,branch2,
548 (unbound,fresh,inherited,aft))
549 | Ast.While(header,body,(_,_,_,aft)) ->
550 let (unbound,_,fresh,inherited) =
551 classify (cip_mcodekind collect_in_plus_term aft) [] in
552 Ast.While(header,body,(unbound,fresh,inherited,aft))
553 | Ast.For(header,body,(_,_,_,aft)) ->
554 let (unbound,_,fresh,inherited) =
555 classify (cip_mcodekind collect_in_plus_term aft) [] in
556 Ast.For(header,body,(unbound,fresh,inherited,aft))
557 | Ast.Iterator(header,body,(_,_,_,aft)) ->
558 let (unbound,_,fresh,inherited) =
559 classify (cip_mcodekind collect_in_plus_term aft) [] in
560 Ast.Iterator(header,body,(unbound,fresh,inherited,aft))
563 let (unbound,munbound,fresh,_) = classify free minus_free in
565 List.filter (function x -> List.mem x bound) nc_free in
568 Ast.free_vars = unbound;
569 Ast.minus_free_vars = munbound;
570 Ast.fresh_vars = collect_fresh unbound;
571 Ast.inherited = inherited;
572 Ast.saved_witness = []} in
574 let astfvstatement_dots recursor k sd =
575 let minus_free = nub (collect_all_refs.V.combiner_statement_dots sd) in
577 nub (collect_non_constraint_refs.V.combiner_statement_dots sd) in
578 let plus_free = collect_in_plus_term.V.combiner_statement_dots sd in
579 let free = Common.union_set minus_free plus_free in
580 let nc_free = Common.union_set minus_nc_free plus_free in
582 List.filter (function x -> not(List.mem x bound)) free in
584 List.filter (function x -> List.mem x bound) nc_free in
586 List.filter (function x -> not(List.mem x bound)) minus_free in
588 Ast.free_vars = unbound;
589 Ast.minus_free_vars = munbound;
590 Ast.fresh_vars = collect_fresh unbound;
591 Ast.inherited = inherited;
592 Ast.saved_witness = []} in
594 let astfvtoplevel recursor k tl =
595 let saved = collect_saved.V.combiner_top_level tl in
596 {(k tl) with Ast.saved_witness = saved} in
599 let donothing r k e = k e in
602 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
603 donothing donothing astfvstatement_dots donothing
604 donothing donothing donothing donothing donothing donothing donothing
605 astfvrule_elem astfvstatement donothing astfvtoplevel donothing
608 let collect_astfvs rules =
609 let rec loop bound = function
611 | (metavars,(nm,rule_info,minirules))::rules ->
613 Common.minus_set bound (List.map Ast.get_meta_name metavars) in
615 (List.map (astfvs metavars bound).V.rebuilder_top_level minirules))::
616 (loop ((List.map Ast.get_meta_name metavars)@bound) rules) in
620 let collect_astfvs rules =
621 let rec loop bound = function
623 | (metavars, rule)::rules ->
625 Ast.ScriptRule (_,_,_,_) ->
626 (* bound stays as is because script rules have no names, so no
627 inheritance is possible *)
628 rule::(loop bound rules)
629 | Ast.CocciRule (nm, rule_info, minirules, isexp, ruletype) ->
631 Common.minus_set bound (List.map Ast.get_meta_name metavars) in
634 (List.map (astfvs metavars bound).V.rebuilder_top_level
637 (loop ((List.map Ast.get_meta_name metavars)@bound) rules) in
640 (* ---------------------------------------------------------------- *)
641 (* position variables that appear as a constraint on another position variable.
642 a position variable also cannot appear both positively and negatively in a
645 let get_neg_pos_list (_,rule) used_after_list =
646 let donothing r k e = k e in
647 let bind (p1,np1) (p2,np2) =
648 (Common.union_set p1 p2, Common.union_set np1 np2) in
649 let option_default = ([],[]) in
650 let metaid (x,_,_,_) = x in
652 match Ast.get_pos_var mc with
653 Ast.MetaPos(name,constraints,Ast.PER,_,_) ->
654 ([metaid name],constraints)
655 | Ast.MetaPos(name,constraints,Ast.ALL,_,_) ->
656 ([],(metaid name)::constraints)
657 | _ -> option_default in
659 V.combiner bind option_default
660 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
661 donothing donothing donothing donothing
662 donothing donothing donothing donothing donothing donothing
663 donothing donothing donothing donothing donothing donothing in
665 Ast.CocciRule(_,_,minirules,_,_) ->
667 (function toplevel ->
668 let (positions,neg_positions) = v.V.combiner_top_level toplevel in
669 (if List.exists (function p -> List.mem p neg_positions) positions
672 "a variable cannot be used both as a position and a constraint");
675 | Ast.ScriptRule _ -> [] (*no negated positions*)
677 (* ---------------------------------------------------------------- *)
679 (* collect used after lists, per minirule *)
681 (* defined is a list of variables that were declared in a previous metavar
684 (* Top-level used after: For each rule collect the set of variables that
685 are inherited, ie used but not defined. These are accumulated back to
686 their point of definition. *)
689 let collect_top_level_used_after metavar_rule_list =
690 let (used_after,used_after_lists) =
692 (function (metavar_list,r) ->
693 function (used_after,used_after_lists) ->
694 let locally_defined = List.map Ast.get_meta_name metavar_list in
695 let continue_propagation =
696 List.filter (function x -> not(List.mem x locally_defined))
700 Ast.ScriptRule (_,_,mv,_) ->
701 List.map (function (_,(r,v)) -> (r,v)) mv
702 | Ast.CocciRule (_,_,rule,_,_) ->
703 Common.union_set (nub (collect_all_rule_refs rule))
704 (collect_in_plus rule) in
706 List.filter (function x -> not (List.mem x locally_defined))
708 (Common.union_set inherited continue_propagation,
709 used_after::used_after_lists))
710 metavar_rule_list ([],[]) in
711 match used_after with
712 [] -> used_after_lists
715 (Printf.sprintf "collect_top_level_used_after: unbound variables %s"
716 (String.concat " " (List.map (function (_,x) -> x) used_after)))
718 let collect_local_used_after metavars minirules used_after =
719 let locally_defined = List.map Ast.get_meta_name metavars in
720 let rec loop defined = function
721 [] -> (used_after,[],[])
725 (nub (collect_all_minirule_refs minirule))
726 (collect_in_plus_term.V.combiner_top_level minirule) in
727 let local_free_vars =
728 List.filter (function x -> List.mem x locally_defined) free_vars in
729 let new_defined = Common.union_set local_free_vars defined in
730 let (mini_used_after,fvs_lists,mini_used_after_lists) =
731 loop new_defined rest in
732 let local_used = Common.union_set local_free_vars mini_used_after in
733 let (new_used_after,new_list) =
734 List.partition (function x -> List.mem x defined) mini_used_after in
735 let new_used_after = Common.union_set local_used new_used_after in
736 (new_used_after,free_vars::fvs_lists,
737 new_list::mini_used_after_lists) in
738 let (_,fvs_lists,used_after_lists) = loop [] minirules in
739 (fvs_lists,used_after_lists)
742 let collect_used_after metavar_rule_list =
743 let used_after_lists = collect_top_level_used_after metavar_rule_list in
745 (function (metavars,r) ->
746 function used_after ->
748 Ast.ScriptRule (_,_,mv,_) -> ([], [used_after])
749 | Ast.CocciRule (name, rule_info, minirules, _,_) ->
750 collect_local_used_after metavars minirules used_after
752 metavar_rule_list used_after_lists
754 (* ---------------------------------------------------------------- *)
757 let free_vars rules =
758 let metavars = List.map (function (mv,rule) -> mv) rules in
759 let (fvs_lists,used_after_lists) = List.split (collect_used_after rules) in
760 let neg_pos_lists = List.map2 get_neg_pos_list rules used_after_lists in
761 let positions_list = (* for all rules, assume all positions are used after *)
765 Ast.ScriptRule _ -> []
766 | Ast.CocciRule (_,_,rule,_,_) ->
770 function Ast.MetaPosDecl(_,nm) -> nm::prev | _ -> prev)
772 List.map (function _ -> positions) rule)
779 Ast.ScriptRule _ -> r
780 | Ast.CocciRule (nm, rule_info, r, is_exp,ruletype) ->
782 (nm, rule_info, classify_variables mv r (List.concat ua),
784 rules used_after_lists in
785 let new_rules = collect_astfvs (List.combine metavars new_rules) in
787 fvs_lists,neg_pos_lists,used_after_lists,positions_list)