Commit | Line | Data |
---|---|---|
f537ebc4 | 1 | (* |
17ba0788 C |
2 | * Copyright 2012, INRIA |
3 | * Julia Lawall, Gilles Muller | |
4 | * Copyright 2010-2011, INRIA, University of Copenhagen | |
f537ebc4 C |
5 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix |
6 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
d6ce1786 C |
7 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix |
8 | * This file is part of Coccinelle. | |
9 | * | |
10 | * Coccinelle is free software: you can redistribute it and/or modify | |
11 | * it under the terms of the GNU General Public License as published by | |
12 | * the Free Software Foundation, according to version 2 of the License. | |
13 | * | |
14 | * Coccinelle is distributed in the hope that it will be useful, | |
15 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | * GNU General Public License for more details. | |
18 | * | |
19 | * You should have received a copy of the GNU General Public License | |
20 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
21 | * | |
22 | * The authors reserve the right to distribute this or future versions of | |
23 | * Coccinelle under other licenses. | |
24 | *) | |
25 | ||
26 | ||
27 | # 0 "./free_vars.ml" | |
28 | (* | |
29 | * Copyright 2012, INRIA | |
30 | * Julia Lawall, Gilles Muller | |
31 | * Copyright 2010-2011, INRIA, University of Copenhagen | |
32 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix | |
33 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
f537ebc4 C |
34 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix |
35 | * This file is part of Coccinelle. | |
36 | * | |
37 | * Coccinelle is free software: you can redistribute it and/or modify | |
38 | * it under the terms of the GNU General Public License as published by | |
39 | * the Free Software Foundation, according to version 2 of the License. | |
40 | * | |
41 | * Coccinelle is distributed in the hope that it will be useful, | |
42 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
43 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
44 | * GNU General Public License for more details. | |
45 | * | |
46 | * You should have received a copy of the GNU General Public License | |
47 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
48 | * | |
49 | * The authors reserve the right to distribute this or future versions of | |
50 | * Coccinelle under other licenses. | |
51 | *) | |
52 | ||
53 | ||
feec80c3 | 54 | # 0 "./free_vars.ml" |
34e49164 C |
55 | (* For each rule return the list of variables that are used after it. |
56 | Also augment various parts of each rule with unitary, inherited, and freshness | |
57 | informations *) | |
58 | ||
978fd7e5 C |
59 | (* metavar decls should be better integrated into computations of free |
60 | variables in plus code *) | |
61 | ||
34e49164 C |
62 | module Ast = Ast_cocci |
63 | module V = Visitor_ast | |
64 | module TC = Type_cocci | |
65 | ||
66 | let rec nub = function | |
67 | [] -> [] | |
68 | | (x::xs) when (List.mem x xs) -> nub xs | |
69 | | (x::xs) -> x::(nub xs) | |
70 | ||
71 | (* Collect all variable references in a minirule. For a disj, we collect | |
72 | the maximum number (2 is enough) of references in any branch. *) | |
73 | ||
74 | let collect_unitary_nonunitary free_usage = | |
75 | let free_usage = List.sort compare free_usage in | |
76 | let rec loop1 todrop = function (* skips multiple occurrences *) | |
77 | [] -> [] | |
78 | | (x::xs) as all -> if x = todrop then loop1 todrop xs else all in | |
79 | let rec loop2 = function | |
80 | [] -> ([],[]) | |
81 | | [x] -> ([x],[]) | |
82 | | x::y::xs -> | |
83 | if x = y (* occurs more than once in free_usage *) | |
84 | then | |
85 | let (unitary,non_unitary) = loop2(loop1 x xs) in | |
86 | (unitary,x::non_unitary) | |
87 | else (* occurs only once in free_usage *) | |
88 | let (unitary,non_unitary) = loop2 (y::xs) in | |
89 | (x::unitary,non_unitary) in | |
90 | loop2 free_usage | |
91 | ||
92 | let collect_refs include_constraints = | |
93 | let bind x y = x @ y in | |
94 | let option_default = [] in | |
95 | ||
96 | let donothing recursor k e = k e in (* just combine in the normal way *) | |
97 | ||
98 | let donothing_a recursor k e = (* anything is not wrapped *) | |
99 | k e in (* just combine in the normal way *) | |
100 | ||
101 | (* the following considers that anything that occurs non-unitarily in one | |
102 | branch occurs nonunitarily in all branches. This is not optimal, but | |
103 | doing better seems to require a breadth-first traversal, which is | |
104 | perhaps better to avoid. Also, unitarily is represented as occuring once, | |
105 | while nonunitarily is represented as twice - more is irrelevant *) | |
106 | (* cases for disjs and metavars *) | |
107 | let bind_disj refs_branches = | |
108 | let (unitary,nonunitary) = | |
109 | List.split (List.map collect_unitary_nonunitary refs_branches) in | |
110 | let unitary = nub (List.concat unitary) in | |
111 | let nonunitary = nub (List.concat nonunitary) in | |
112 | let unitary = | |
113 | List.filter (function x -> not (List.mem x nonunitary)) unitary in | |
114 | unitary@nonunitary@nonunitary in | |
115 | ||
116 | let metaid (x,_,_,_) = x in | |
117 | ||
118 | let astfvident recursor k i = | |
119 | bind (k i) | |
120 | (match Ast.unwrap i with | |
5636bb2c C |
121 | Ast.MetaId(name,idconstraint,_,_) | Ast.MetaFunc(name,idconstraint,_,_) |
122 | | Ast.MetaLocalFunc(name,idconstraint,_,_) -> | |
123 | let metas = | |
124 | if include_constraints | |
125 | then | |
126 | match idconstraint with | |
127 | Ast.IdNegIdSet (_,metas) -> metas | |
128 | | _ -> [] | |
129 | else [] in | |
130 | bind (List.rev metas) [metaid name] | |
d3f655c6 | 131 | | Ast.DisjId(ids) -> bind_disj (List.map k ids) |
34e49164 C |
132 | | _ -> option_default) in |
133 | ||
134 | let rec type_collect res = function | |
135 | TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty) | |
136 | | TC.Array(ty) -> type_collect res ty | |
e6509c05 C |
137 | | TC.EnumName(TC.MV(tyname,_,_)) -> |
138 | bind [tyname] res | |
139 | | TC.StructUnionName(_,TC.MV(tyname,_,_)) -> | |
140 | bind [tyname] res | |
ae4735db C |
141 | | TC.MetaType(tyname,_,_) -> |
142 | bind [tyname] res | |
faf9a90c | 143 | | TC.SignedT(_,Some ty) -> type_collect res ty |
34e49164 C |
144 | | ty -> res in |
145 | ||
146 | let astfvexpr recursor k e = | |
147 | bind (k e) | |
148 | (match Ast.unwrap e with | |
5636bb2c | 149 | Ast.MetaExpr(name,constraints,_,Some type_list,_,_) -> |
34e49164 | 150 | let types = List.fold_left type_collect option_default type_list in |
5636bb2c C |
151 | let extra = |
152 | if include_constraints | |
153 | then | |
154 | match constraints with | |
155 | Ast.SubExpCstrt l -> l | |
156 | | _ -> [] | |
157 | else [] in | |
158 | bind extra (bind [metaid name] types) | |
159 | | Ast.MetaErr(name,constraints,_,_) | |
160 | | Ast.MetaExpr(name,constraints,_,_,_,_) -> | |
161 | let extra = | |
162 | if include_constraints | |
163 | then | |
164 | match constraints with | |
165 | Ast.SubExpCstrt l -> l | |
166 | | _ -> [] | |
167 | else [] in | |
168 | bind extra [metaid name] | |
88e71198 | 169 | | Ast.MetaExprList(name,Ast.MetaListLen (lenname,_,_),_,_) -> |
34e49164 | 170 | [metaid name;metaid lenname] |
88e71198 | 171 | | Ast.MetaExprList(name,_,_,_) -> [metaid name] |
34e49164 C |
172 | | Ast.DisjExpr(exps) -> bind_disj (List.map k exps) |
173 | | _ -> option_default) in | |
174 | ||
175 | let astfvdecls recursor k d = | |
176 | bind (k d) | |
177 | (match Ast.unwrap d with | |
413ffc02 | 178 | Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) -> [metaid name] |
190f1acf C |
179 | | Ast.MetaFieldList(name,Ast.MetaListLen(lenname,_,_),_,_) -> |
180 | [metaid name;metaid lenname] | |
181 | | Ast.MetaFieldList(name,_,_,_) -> | |
182 | [metaid name] | |
413ffc02 | 183 | | Ast.DisjDecl(decls) -> bind_disj (List.map k decls) |
34e49164 C |
184 | | _ -> option_default) in |
185 | ||
186 | let astfvfullType recursor k ty = | |
187 | bind (k ty) | |
188 | (match Ast.unwrap ty with | |
189 | Ast.DisjType(types) -> bind_disj (List.map k types) | |
190 | | _ -> option_default) in | |
191 | ||
192 | let astfvtypeC recursor k ty = | |
193 | bind (k ty) | |
194 | (match Ast.unwrap ty with | |
195 | Ast.MetaType(name,_,_) -> [metaid name] | |
196 | | _ -> option_default) in | |
197 | ||
113803cf C |
198 | let astfvinit recursor k ty = |
199 | bind (k ty) | |
200 | (match Ast.unwrap ty with | |
201 | Ast.MetaInit(name,_,_) -> [metaid name] | |
8f657093 C |
202 | | Ast.MetaInitList(name,Ast.MetaListLen(lenname,_,_),_,_) -> |
203 | [metaid name;metaid lenname] | |
204 | | Ast.MetaInitList(name,_,_,_) -> [metaid name] | |
113803cf C |
205 | | _ -> option_default) in |
206 | ||
34e49164 C |
207 | let astfvparam recursor k p = |
208 | bind (k p) | |
209 | (match Ast.unwrap p with | |
210 | Ast.MetaParam(name,_,_) -> [metaid name] | |
88e71198 | 211 | | Ast.MetaParamList(name,Ast.MetaListLen(lenname,_,_),_,_) -> |
34e49164 | 212 | [metaid name;metaid lenname] |
88e71198 | 213 | | Ast.MetaParamList(name,_,_,_) -> [metaid name] |
34e49164 C |
214 | | _ -> option_default) in |
215 | ||
216 | let astfvrule_elem recursor k re = | |
217 | (*within a rule_elem, pattern3 manages the coherence of the bindings*) | |
218 | bind (k re) | |
219 | (nub | |
220 | (match Ast.unwrap re with | |
221 | Ast.MetaRuleElem(name,_,_) | Ast.MetaStmt(name,_,_,_) | |
222 | | Ast.MetaStmtList(name,_,_) -> [metaid name] | |
223 | | _ -> option_default)) in | |
224 | ||
225 | let astfvstatement recursor k s = | |
226 | bind (k s) | |
227 | (match Ast.unwrap s with | |
228 | Ast.Disj(stms) -> | |
229 | bind_disj (List.map recursor.V.combiner_statement_dots stms) | |
230 | | _ -> option_default) in | |
231 | ||
232 | let mcode r mc = | |
233 | if include_constraints | |
234 | then | |
8f657093 C |
235 | List.concat |
236 | (List.map | |
237 | (function Ast.MetaPos(name,constraints,_,_,_) -> | |
238 | (metaid name)::constraints) | |
239 | (Ast.get_pos_var mc)) | |
34e49164 C |
240 | else option_default in |
241 | ||
242 | V.combiner bind option_default | |
243 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode | |
c491d8ee | 244 | donothing donothing donothing donothing donothing |
113803cf | 245 | astfvident astfvexpr astfvfullType astfvtypeC astfvinit astfvparam |
34e49164 C |
246 | astfvdecls astfvrule_elem astfvstatement donothing donothing donothing_a |
247 | ||
248 | let collect_all_refs = collect_refs true | |
249 | let collect_non_constraint_refs = collect_refs false | |
250 | ||
251 | let collect_all_rule_refs minirules = | |
252 | List.fold_left (@) [] | |
253 | (List.map collect_all_refs.V.combiner_top_level minirules) | |
254 | ||
255 | let collect_all_minirule_refs = collect_all_refs.V.combiner_top_level | |
256 | ||
257 | (* ---------------------------------------------------------------- *) | |
258 | ||
259 | let collect_saved = | |
260 | let bind = Common.union_set in | |
261 | let option_default = [] in | |
262 | ||
263 | let donothing recursor k e = k e in (* just combine in the normal way *) | |
264 | ||
265 | let metaid (x,_,_,_) = x in | |
266 | ||
267 | (* cases for metavariables *) | |
268 | let astfvident recursor k i = | |
269 | bind (k i) | |
270 | (match Ast.unwrap i with | |
ae4735db C |
271 | Ast.MetaId(name,_,TC.Saved,_) |
272 | | Ast.MetaFunc(name,_,TC.Saved,_) | |
d3f655c6 | 273 | | Ast.MetaLocalFunc(name,_,TC.Saved,_) -> [metaid name] |
34e49164 C |
274 | | _ -> option_default) in |
275 | ||
276 | let rec type_collect res = function | |
277 | TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty) | |
278 | | TC.Array(ty) -> type_collect res ty | |
e6509c05 C |
279 | | TC.EnumName(TC.MV(tyname,TC.Saved,_)) -> |
280 | bind [tyname] res | |
281 | | TC.StructUnionName(_,TC.MV(tyname,TC.Saved,_)) -> | |
282 | bind [tyname] res | |
ae4735db C |
283 | | TC.MetaType(tyname,TC.Saved,_) -> |
284 | bind [tyname] res | |
faf9a90c | 285 | | TC.SignedT(_,Some ty) -> type_collect res ty |
34e49164 C |
286 | | ty -> res in |
287 | ||
288 | let astfvexpr recursor k e = | |
289 | let tymetas = | |
290 | match Ast.unwrap e with | |
291 | Ast.MetaExpr(name,_,_,Some type_list,_,_) -> | |
292 | List.fold_left type_collect option_default type_list | |
293 | | _ -> [] in | |
294 | let vars = | |
295 | bind (k e) | |
296 | (match Ast.unwrap e with | |
297 | Ast.MetaErr(name,_,TC.Saved,_) | Ast.MetaExpr(name,_,TC.Saved,_,_,_) | |
88e71198 C |
298 | -> [metaid name] |
299 | | Ast.MetaExprList(name,Ast.MetaListLen (lenname,ls,_),ns,_) -> | |
34e49164 C |
300 | let namesaved = |
301 | match ns with TC.Saved -> [metaid name] | _ -> [] in | |
302 | let lensaved = | |
303 | match ls with TC.Saved -> [metaid lenname] | _ -> [] in | |
304 | lensaved @ namesaved | |
88e71198 | 305 | | Ast.MetaExprList(name,_,TC.Saved,_) -> [metaid name] |
34e49164 C |
306 | | _ -> option_default) in |
307 | bind tymetas vars in | |
308 | ||
309 | let astfvtypeC recursor k ty = | |
310 | bind (k ty) | |
311 | (match Ast.unwrap ty with | |
312 | Ast.MetaType(name,TC.Saved,_) -> [metaid name] | |
313 | | _ -> option_default) in | |
314 | ||
113803cf C |
315 | let astfvinit recursor k ty = |
316 | bind (k ty) | |
317 | (match Ast.unwrap ty with | |
318 | Ast.MetaInit(name,TC.Saved,_) -> [metaid name] | |
8f657093 C |
319 | | Ast.MetaInitList(name,Ast.MetaListLen (lenname,ls,_),ns,_) -> |
320 | let namesaved = | |
321 | match ns with TC.Saved -> [metaid name] | _ -> [] in | |
322 | let lensaved = | |
323 | match ls with TC.Saved -> [metaid lenname] | _ -> [] in | |
324 | lensaved @ namesaved | |
113803cf C |
325 | | _ -> option_default) in |
326 | ||
34e49164 C |
327 | let astfvparam recursor k p = |
328 | bind (k p) | |
329 | (match Ast.unwrap p with | |
88e71198 C |
330 | Ast.MetaParam(name,TC.Saved,_) -> [metaid name] |
331 | | Ast.MetaParamList(name,Ast.MetaListLen (lenname,ls,_),ns,_) -> | |
34e49164 C |
332 | let namesaved = |
333 | match ns with TC.Saved -> [metaid name] | _ -> [] in | |
334 | let lensaved = | |
335 | match ls with TC.Saved -> [metaid lenname] | _ -> [] in | |
336 | lensaved @ namesaved | |
190f1acf | 337 | | Ast.MetaParamList(name,_,TC.Saved,_) -> [metaid name] |
34e49164 C |
338 | | _ -> option_default) in |
339 | ||
413ffc02 C |
340 | let astfvdecls recursor k d = |
341 | bind (k d) | |
342 | (match Ast.unwrap d with | |
343 | Ast.MetaDecl(name,TC.Saved,_) | Ast.MetaField(name,TC.Saved,_) -> | |
344 | [metaid name] | |
190f1acf C |
345 | | Ast.MetaFieldList(name,Ast.MetaListLen (lenname,ls,_),ns,_) -> |
346 | let namesaved = | |
347 | match ns with TC.Saved -> [metaid name] | _ -> [] in | |
348 | let lensaved = | |
349 | match ls with TC.Saved -> [metaid lenname] | _ -> [] in | |
350 | lensaved @ namesaved | |
351 | | Ast.MetaFieldList(name,_,TC.Saved,_) -> [metaid name] | |
413ffc02 C |
352 | | _ -> option_default) in |
353 | ||
34e49164 C |
354 | let astfvrule_elem recursor k re = |
355 | (*within a rule_elem, pattern3 manages the coherence of the bindings*) | |
356 | bind (k re) | |
357 | (nub | |
358 | (match Ast.unwrap re with | |
359 | Ast.MetaRuleElem(name,TC.Saved,_) | Ast.MetaStmt(name,TC.Saved,_,_) | |
360 | | Ast.MetaStmtList(name,TC.Saved,_) -> [metaid name] | |
361 | | _ -> option_default)) in | |
362 | ||
363 | let mcode r e = | |
8f657093 C |
364 | List.fold_left |
365 | (function acc -> | |
366 | function | |
367 | Ast.MetaPos(name,_,_,TC.Saved,_) -> (metaid name) :: acc | |
368 | | _ -> acc) | |
369 | option_default (Ast.get_pos_var e) in | |
34e49164 C |
370 | |
371 | V.combiner bind option_default | |
372 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode | |
c491d8ee | 373 | donothing donothing donothing donothing donothing |
113803cf | 374 | astfvident astfvexpr donothing astfvtypeC astfvinit astfvparam |
413ffc02 | 375 | astfvdecls astfvrule_elem donothing donothing donothing donothing |
34e49164 C |
376 | |
377 | (* ---------------------------------------------------------------- *) | |
378 | ||
379 | (* For the rules under a given metavariable declaration, collect all of the | |
380 | variables that occur in the plus code *) | |
381 | ||
382 | let cip_mcodekind r mck = | |
383 | let process_anything_list_list anythings = | |
384 | let astfvs = collect_all_refs.V.combiner_anything in | |
385 | List.fold_left (@) [] | |
386 | (List.map (function l -> List.fold_left (@) [] (List.map astfvs l)) | |
387 | anythings) in | |
388 | match mck with | |
8babbc8f C |
389 | Ast.MINUS(_,_,_,replacement) -> |
390 | (match replacement with | |
391 | Ast.REPLACEMENT(anythings,_) -> process_anything_list_list anythings | |
392 | | Ast.NOREPLACEMENT -> []) | |
34e49164 C |
393 | | Ast.CONTEXT(_,befaft) -> |
394 | (match befaft with | |
951c7801 C |
395 | Ast.BEFORE(ll,_) -> process_anything_list_list ll |
396 | | Ast.AFTER(ll,_) -> process_anything_list_list ll | |
397 | | Ast.BEFOREAFTER(llb,lla,_) -> | |
34e49164 C |
398 | (process_anything_list_list lla) @ |
399 | (process_anything_list_list llb) | |
400 | | Ast.NOTHING -> []) | |
951c7801 | 401 | | Ast.PLUS _ -> [] |
34e49164 | 402 | |
978fd7e5 C |
403 | |
404 | let collect_fresh_seed_env metavars l = | |
405 | let fresh = | |
406 | List.fold_left | |
407 | (function prev -> | |
408 | function | |
409 | Ast.MetaFreshIdDecl(_,seed) as x -> | |
410 | ((Ast.get_meta_name x),seed)::prev | |
411 | | _ -> prev) | |
412 | [] metavars in | |
413 | let (seed_env,seeds) = | |
414 | List.fold_left | |
415 | (function (seed_env,seeds) as prev -> | |
416 | function x -> | |
417 | try | |
418 | (let v = List.assoc x fresh in | |
419 | match v with | |
420 | Ast.ListSeed l -> | |
421 | let ids = | |
422 | List.fold_left | |
423 | (function prev -> | |
424 | function | |
425 | Ast.SeedId(id) -> id::prev | |
426 | | _ -> prev) | |
427 | [] l in | |
428 | ((x,ids)::seed_env,Common.union_set ids seeds) | |
429 | | _ -> ((x,[])::seed_env,seeds)) | |
430 | with Not_found -> prev) | |
431 | ([],l) l in | |
432 | (List.rev seed_env,List.rev seeds) | |
433 | ||
434 | let collect_fresh_seed metavars l = | |
435 | let (_,seeds) = collect_fresh_seed_env metavars l in seeds | |
436 | ||
34e49164 | 437 | let collect_in_plus_term = |
978fd7e5 | 438 | |
34e49164 C |
439 | let bind x y = x @ y in |
440 | let option_default = [] in | |
441 | let donothing r k e = k e in | |
442 | ||
443 | (* no positions in the + code *) | |
444 | let mcode r (_,_,mck,_) = cip_mcodekind r mck in | |
445 | ||
446 | (* case for things with bef/aft mcode *) | |
447 | ||
448 | let astfvrule_elem recursor k re = | |
449 | match Ast.unwrap re with | |
450 | Ast.FunHeader(bef,_,fi,nm,_,params,_) -> | |
451 | let fi_metas = | |
452 | List.concat | |
453 | (List.map | |
454 | (function | |
455 | Ast.FType(ty) -> collect_all_refs.V.combiner_fullType ty | |
456 | | _ -> []) | |
457 | fi) in | |
458 | let nm_metas = collect_all_refs.V.combiner_ident nm in | |
459 | let param_metas = | |
460 | match Ast.unwrap params with | |
461 | Ast.DOTS(params) | Ast.CIRCLES(params) -> | |
462 | List.concat | |
463 | (List.map | |
464 | (function p -> | |
465 | match Ast.unwrap p with | |
466 | Ast.VoidParam(t) | Ast.Param(t,_) -> | |
467 | collect_all_refs.V.combiner_fullType t | |
468 | | _ -> []) | |
469 | params) | |
470 | | _ -> failwith "not allowed for params" in | |
471 | bind fi_metas | |
472 | (bind nm_metas | |
473 | (bind param_metas | |
474 | (bind (cip_mcodekind recursor bef) (k re)))) | |
475 | | Ast.Decl(bef,_,_) -> | |
476 | bind (cip_mcodekind recursor bef) (k re) | |
477 | | _ -> k re in | |
478 | ||
479 | let astfvstatement recursor k s = | |
480 | match Ast.unwrap s with | |
481 | Ast.IfThen(_,_,(_,_,_,aft)) | Ast.IfThenElse(_,_,_,_,(_,_,_,aft)) | |
482 | | Ast.While(_,_,(_,_,_,aft)) | Ast.For(_,_,(_,_,_,aft)) | |
483 | | Ast.Iterator(_,_,(_,_,_,aft)) -> | |
484 | bind (k s) (cip_mcodekind recursor aft) | |
485 | | _ -> k s in | |
486 | ||
487 | V.combiner bind option_default | |
488 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode | |
c491d8ee | 489 | donothing donothing donothing donothing donothing |
34e49164 C |
490 | donothing donothing donothing donothing donothing donothing |
491 | donothing astfvrule_elem astfvstatement donothing donothing donothing | |
492 | ||
978fd7e5 | 493 | let collect_in_plus metavars minirules = |
34e49164 | 494 | nub |
978fd7e5 C |
495 | (collect_fresh_seed metavars |
496 | (List.concat | |
497 | (List.map collect_in_plus_term.V.combiner_top_level minirules))) | |
34e49164 C |
498 | |
499 | (* ---------------------------------------------------------------- *) | |
500 | ||
501 | (* For the rules under a given metavariable declaration, collect all of the | |
502 | variables that occur only once and more than once in the minus code *) | |
503 | ||
504 | let collect_all_multirefs minirules = | |
505 | let refs = List.map collect_all_refs.V.combiner_top_level minirules in | |
506 | collect_unitary_nonunitary (List.concat refs) | |
507 | ||
508 | (* ---------------------------------------------------------------- *) | |
509 | ||
510 | (* classify as unitary (no binding) or nonunitary (env binding) or saved | |
511 | (witness binding) *) | |
512 | ||
978fd7e5 C |
513 | let classify_variables metavar_decls minirules used_after = |
514 | let metavars = List.map Ast.get_meta_name metavar_decls in | |
34e49164 | 515 | let (unitary,nonunitary) = collect_all_multirefs minirules in |
978fd7e5 | 516 | let inplus = collect_in_plus metavar_decls minirules in |
faf9a90c | 517 | |
34e49164 C |
518 | let donothing r k e = k e in |
519 | let check_unitary name inherited = | |
520 | if List.mem name inplus or List.mem name used_after | |
521 | then TC.Saved | |
522 | else if not inherited && List.mem name unitary | |
523 | then TC.Unitary | |
524 | else TC.Nonunitary in | |
525 | ||
526 | let get_option f = function Some x -> Some (f x) | None -> None in | |
527 | ||
528 | let classify (name,_,_,_) = | |
529 | let inherited = not (List.mem name metavars) in | |
530 | (check_unitary name inherited,inherited) in | |
531 | ||
532 | let mcode mc = | |
8f657093 C |
533 | let p = |
534 | List.map | |
535 | (function Ast.MetaPos(name,constraints,per,unitary,inherited) -> | |
536 | let (unitary,inherited) = classify name in | |
537 | Ast.MetaPos(name,constraints,per,unitary,inherited)) | |
538 | (Ast.get_pos_var mc) in | |
539 | Ast.set_pos_var p mc in | |
34e49164 C |
540 | |
541 | let ident r k e = | |
542 | let e = k e in | |
543 | match Ast.unwrap e with | |
544 | Ast.MetaId(name,constraints,_,_) -> | |
545 | let (unitary,inherited) = classify name in | |
ae4735db C |
546 | Ast.rewrap e |
547 | (Ast.MetaId(name,constraints,unitary,inherited)) | |
34e49164 C |
548 | | Ast.MetaFunc(name,constraints,_,_) -> |
549 | let (unitary,inherited) = classify name in | |
550 | Ast.rewrap e (Ast.MetaFunc(name,constraints,unitary,inherited)) | |
551 | | Ast.MetaLocalFunc(name,constraints,_,_) -> | |
552 | let (unitary,inherited) = classify name in | |
553 | Ast.rewrap e (Ast.MetaLocalFunc(name,constraints,unitary,inherited)) | |
554 | | _ -> e in | |
555 | ||
556 | let rec type_infos = function | |
557 | TC.ConstVol(cv,ty) -> TC.ConstVol(cv,type_infos ty) | |
558 | | TC.Pointer(ty) -> TC.Pointer(type_infos ty) | |
559 | | TC.FunctionPointer(ty) -> TC.FunctionPointer(type_infos ty) | |
560 | | TC.Array(ty) -> TC.Array(type_infos ty) | |
e6509c05 | 561 | | TC.EnumName(TC.MV(name,_,_)) -> |
8f657093 | 562 | let (unitary,inherited) = classify (name,(),(),[]) in |
e6509c05 C |
563 | TC.EnumName(TC.MV(name,unitary,inherited)) |
564 | | TC.StructUnionName(su,TC.MV(name,_,_)) -> | |
8f657093 | 565 | let (unitary,inherited) = classify (name,(),(),[]) in |
e6509c05 | 566 | TC.StructUnionName(su,TC.MV(name,unitary,inherited)) |
34e49164 | 567 | | TC.MetaType(name,_,_) -> |
8f657093 | 568 | let (unitary,inherited) = classify (name,(),(),[]) in |
34e49164 | 569 | Type_cocci.MetaType(name,unitary,inherited) |
faf9a90c | 570 | | TC.SignedT(sgn,Some ty) -> TC.SignedT(sgn,Some (type_infos ty)) |
34e49164 C |
571 | | ty -> ty in |
572 | ||
573 | let expression r k e = | |
574 | let e = k e in | |
575 | match Ast.unwrap e with | |
576 | Ast.MetaErr(name,constraints,_,_) -> | |
577 | let (unitary,inherited) = classify name in | |
578 | Ast.rewrap e (Ast.MetaErr(name,constraints,unitary,inherited)) | |
579 | | Ast.MetaExpr(name,constraints,_,ty,form,_) -> | |
580 | let (unitary,inherited) = classify name in | |
581 | let ty = get_option (List.map type_infos) ty in | |
582 | Ast.rewrap e (Ast.MetaExpr(name,constraints,unitary,ty,form,inherited)) | |
88e71198 | 583 | | Ast.MetaExprList(name,Ast.MetaListLen(lenname,_,_),_,_) -> |
34e49164 C |
584 | (* lenname should have the same properties of being unitary or |
585 | inherited as name *) | |
586 | let (unitary,inherited) = classify name in | |
587 | let (lenunitary,leninherited) = classify lenname in | |
588 | Ast.rewrap e | |
589 | (Ast.MetaExprList | |
88e71198 C |
590 | (name, |
591 | Ast.MetaListLen(lenname,lenunitary,leninherited), | |
592 | unitary,inherited)) | |
593 | | Ast.MetaExprList(name,lenname,_,_) -> | |
594 | (* lenname should have the same properties of being unitary or | |
595 | inherited as name *) | |
596 | let (unitary,inherited) = classify name in | |
597 | Ast.rewrap e (Ast.MetaExprList(name,lenname,unitary,inherited)) | |
34e49164 C |
598 | | _ -> e in |
599 | ||
600 | let typeC r k e = | |
601 | let e = k e in | |
602 | match Ast.unwrap e with | |
603 | Ast.MetaType(name,_,_) -> | |
604 | let (unitary,inherited) = classify name in | |
605 | Ast.rewrap e (Ast.MetaType(name,unitary,inherited)) | |
606 | | _ -> e in | |
607 | ||
113803cf C |
608 | let init r k e = |
609 | let e = k e in | |
610 | match Ast.unwrap e with | |
611 | Ast.MetaInit(name,_,_) -> | |
612 | let (unitary,inherited) = classify name in | |
613 | Ast.rewrap e (Ast.MetaInit(name,unitary,inherited)) | |
8f657093 C |
614 | | Ast.MetaInitList(name,Ast.MetaListLen (lenname,_,_),_,_) -> |
615 | let (unitary,inherited) = classify name in | |
616 | let (lenunitary,leninherited) = classify lenname in | |
617 | Ast.rewrap e | |
618 | (Ast.MetaInitList | |
619 | (name,Ast.MetaListLen(lenname,lenunitary,leninherited), | |
620 | unitary,inherited)) | |
621 | | Ast.MetaInitList(name,lenname,_,_) -> | |
622 | let (unitary,inherited) = classify name in | |
623 | Ast.rewrap e (Ast.MetaInitList(name,lenname,unitary,inherited)) | |
113803cf C |
624 | | _ -> e in |
625 | ||
34e49164 C |
626 | let param r k e = |
627 | let e = k e in | |
628 | match Ast.unwrap e with | |
629 | Ast.MetaParam(name,_,_) -> | |
630 | let (unitary,inherited) = classify name in | |
631 | Ast.rewrap e (Ast.MetaParam(name,unitary,inherited)) | |
88e71198 | 632 | | Ast.MetaParamList(name,Ast.MetaListLen (lenname,_,_),_,_) -> |
34e49164 C |
633 | let (unitary,inherited) = classify name in |
634 | let (lenunitary,leninherited) = classify lenname in | |
635 | Ast.rewrap e | |
636 | (Ast.MetaParamList | |
88e71198 C |
637 | (name,Ast.MetaListLen(lenname,lenunitary,leninherited), |
638 | unitary,inherited)) | |
639 | | Ast.MetaParamList(name,lenname,_,_) -> | |
640 | let (unitary,inherited) = classify name in | |
641 | Ast.rewrap e (Ast.MetaParamList(name,lenname,unitary,inherited)) | |
34e49164 C |
642 | | _ -> e in |
643 | ||
413ffc02 C |
644 | let decl r k e = |
645 | let e = k e in | |
646 | match Ast.unwrap e with | |
647 | Ast.MetaDecl(name,_,_) -> | |
648 | let (unitary,inherited) = classify name in | |
649 | Ast.rewrap e (Ast.MetaDecl(name,unitary,inherited)) | |
650 | | Ast.MetaField(name,_,_) -> | |
651 | let (unitary,inherited) = classify name in | |
652 | Ast.rewrap e (Ast.MetaField(name,unitary,inherited)) | |
190f1acf C |
653 | | Ast.MetaFieldList(name,Ast.MetaListLen (lenname,_,_),_,_) -> |
654 | let (unitary,inherited) = classify name in | |
655 | let (lenunitary,leninherited) = classify lenname in | |
656 | Ast.rewrap e | |
657 | (Ast.MetaFieldList | |
658 | (name,Ast.MetaListLen(lenname,lenunitary,leninherited), | |
659 | unitary,inherited)) | |
660 | | Ast.MetaFieldList(name,lenname,_,_) -> | |
661 | let (unitary,inherited) = classify name in | |
662 | Ast.rewrap e (Ast.MetaFieldList(name,lenname,unitary,inherited)) | |
413ffc02 C |
663 | | _ -> e in |
664 | ||
34e49164 C |
665 | let rule_elem r k e = |
666 | let e = k e in | |
667 | match Ast.unwrap e with | |
668 | Ast.MetaStmt(name,_,msi,_) -> | |
669 | let (unitary,inherited) = classify name in | |
670 | Ast.rewrap e (Ast.MetaStmt(name,unitary,msi,inherited)) | |
671 | | Ast.MetaStmtList(name,_,_) -> | |
672 | let (unitary,inherited) = classify name in | |
673 | Ast.rewrap e (Ast.MetaStmtList(name,unitary,inherited)) | |
674 | | _ -> e in | |
675 | ||
676 | let fn = V.rebuilder | |
677 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode | |
c491d8ee | 678 | donothing donothing donothing donothing donothing |
413ffc02 | 679 | ident expression donothing typeC init param decl rule_elem |
34e49164 C |
680 | donothing donothing donothing donothing in |
681 | ||
682 | List.map fn.V.rebuilder_top_level minirules | |
683 | ||
684 | (* ---------------------------------------------------------------- *) | |
685 | ||
686 | (* For a minirule, collect the set of non-local (not in "bound") variables that | |
687 | are referenced. Store them in a hash table. *) | |
688 | ||
689 | (* bound means the metavariable was declared previously, not locally *) | |
690 | ||
691 | (* Highly inefficient, because we call collect_all_refs on nested code | |
692 | multiple times. But we get the advantage of not having too many variants | |
693 | of the same functions. *) | |
694 | ||
695 | (* Inherited doesn't include position constraints. If they are not bound | |
696 | then there is no constraint. *) | |
697 | ||
698 | let astfvs metavars bound = | |
699 | let fresh = | |
700 | List.fold_left | |
701 | (function prev -> | |
702 | function | |
b1b2de81 C |
703 | Ast.MetaFreshIdDecl(_,seed) as x -> |
704 | ((Ast.get_meta_name x),seed)::prev | |
34e49164 C |
705 | | _ -> prev) |
706 | [] metavars in | |
707 | ||
b1b2de81 | 708 | let collect_fresh l = |
978fd7e5 C |
709 | let (matched,freshvars) = |
710 | List.fold_left | |
711 | (function (matched,freshvars) -> | |
b1b2de81 | 712 | function x -> |
978fd7e5 C |
713 | try let v = List.assoc x fresh in (matched,(x,v)::freshvars) |
714 | with Not_found -> (x::matched,freshvars)) | |
715 | ([],[]) l in | |
716 | (List.rev matched, List.rev freshvars) in | |
34e49164 C |
717 | |
718 | (* cases for the elements of anything *) | |
fc1ad971 C |
719 | let simple_setup getter k re = |
720 | let minus_free = nub (getter collect_all_refs re) in | |
34e49164 | 721 | let minus_nc_free = |
fc1ad971 | 722 | nub (getter collect_non_constraint_refs re) in |
978fd7e5 | 723 | let plus_free = |
fc1ad971 | 724 | collect_fresh_seed metavars (getter collect_in_plus_term re) in |
34e49164 C |
725 | let free = Common.union_set minus_free plus_free in |
726 | let nc_free = Common.union_set minus_nc_free plus_free in | |
727 | let unbound = | |
728 | List.filter (function x -> not(List.mem x bound)) free in | |
729 | let inherited = | |
730 | List.filter (function x -> List.mem x bound) nc_free in | |
731 | let munbound = | |
732 | List.filter (function x -> not(List.mem x bound)) minus_free in | |
978fd7e5 | 733 | let (matched,fresh) = collect_fresh unbound in |
34e49164 | 734 | {(k re) with |
978fd7e5 | 735 | Ast.free_vars = matched; |
34e49164 | 736 | Ast.minus_free_vars = munbound; |
978fd7e5 | 737 | Ast.fresh_vars = fresh; |
34e49164 C |
738 | Ast.inherited = inherited; |
739 | Ast.saved_witness = []} in | |
740 | ||
fc1ad971 C |
741 | let astfvrule_elem recursor k re = |
742 | simple_setup (function x -> x.V.combiner_rule_elem) k re in | |
743 | ||
34e49164 C |
744 | let astfvstatement recursor k s = |
745 | let minus_free = nub (collect_all_refs.V.combiner_statement s) in | |
746 | let minus_nc_free = | |
747 | nub (collect_non_constraint_refs.V.combiner_statement s) in | |
978fd7e5 C |
748 | let plus_free = |
749 | collect_fresh_seed metavars | |
750 | (collect_in_plus_term.V.combiner_statement s) in | |
34e49164 C |
751 | let free = Common.union_set minus_free plus_free in |
752 | let nc_free = Common.union_set minus_nc_free plus_free in | |
753 | let classify free minus_free = | |
754 | let (unbound,inherited) = | |
755 | List.partition (function x -> not(List.mem x bound)) free in | |
756 | let munbound = | |
757 | List.filter (function x -> not(List.mem x bound)) minus_free in | |
978fd7e5 C |
758 | let (matched,fresh) = collect_fresh unbound in |
759 | (matched,munbound,fresh,inherited) in | |
34e49164 C |
760 | let res = k s in |
761 | let s = | |
978fd7e5 C |
762 | let cip_plus aft = |
763 | collect_fresh_seed metavars | |
764 | (cip_mcodekind collect_in_plus_term aft) in | |
34e49164 C |
765 | match Ast.unwrap res with |
766 | Ast.IfThen(header,branch,(_,_,_,aft)) -> | |
978fd7e5 | 767 | let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in |
34e49164 C |
768 | Ast.IfThen(header,branch,(unbound,fresh,inherited,aft)) |
769 | | Ast.IfThenElse(header,branch1,els,branch2,(_,_,_,aft)) -> | |
978fd7e5 | 770 | let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in |
34e49164 C |
771 | Ast.IfThenElse(header,branch1,els,branch2, |
772 | (unbound,fresh,inherited,aft)) | |
773 | | Ast.While(header,body,(_,_,_,aft)) -> | |
978fd7e5 | 774 | let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in |
34e49164 C |
775 | Ast.While(header,body,(unbound,fresh,inherited,aft)) |
776 | | Ast.For(header,body,(_,_,_,aft)) -> | |
978fd7e5 | 777 | let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in |
34e49164 C |
778 | Ast.For(header,body,(unbound,fresh,inherited,aft)) |
779 | | Ast.Iterator(header,body,(_,_,_,aft)) -> | |
978fd7e5 | 780 | let (unbound,_,fresh,inherited) = classify (cip_plus aft) [] in |
34e49164 C |
781 | Ast.Iterator(header,body,(unbound,fresh,inherited,aft)) |
782 | | s -> s in | |
faf9a90c | 783 | |
978fd7e5 | 784 | let (matched,munbound,fresh,_) = classify free minus_free in |
34e49164 C |
785 | let inherited = |
786 | List.filter (function x -> List.mem x bound) nc_free in | |
787 | {res with | |
788 | Ast.node = s; | |
978fd7e5 | 789 | Ast.free_vars = matched; |
34e49164 | 790 | Ast.minus_free_vars = munbound; |
978fd7e5 | 791 | Ast.fresh_vars = fresh; |
34e49164 C |
792 | Ast.inherited = inherited; |
793 | Ast.saved_witness = []} in | |
794 | ||
795 | let astfvstatement_dots recursor k sd = | |
fc1ad971 C |
796 | simple_setup (function x -> x.V.combiner_statement_dots) k sd in |
797 | ||
798 | let astfvcase_line recursor k cl = | |
799 | simple_setup (function x -> x.V.combiner_case_line) k cl in | |
34e49164 C |
800 | |
801 | let astfvtoplevel recursor k tl = | |
802 | let saved = collect_saved.V.combiner_top_level tl in | |
803 | {(k tl) with Ast.saved_witness = saved} in | |
804 | ||
805 | let mcode x = x in | |
806 | let donothing r k e = k e in | |
807 | ||
808 | V.rebuilder | |
809 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode | |
c491d8ee | 810 | donothing donothing astfvstatement_dots donothing donothing |
34e49164 | 811 | donothing donothing donothing donothing donothing donothing donothing |
fc1ad971 | 812 | astfvrule_elem astfvstatement astfvcase_line astfvtoplevel donothing |
34e49164 C |
813 | |
814 | (* | |
815 | let collect_astfvs rules = | |
816 | let rec loop bound = function | |
817 | [] -> [] | |
818 | | (metavars,(nm,rule_info,minirules))::rules -> | |
819 | let bound = | |
820 | Common.minus_set bound (List.map Ast.get_meta_name metavars) in | |
821 | (nm,rule_info, | |
822 | (List.map (astfvs metavars bound).V.rebuilder_top_level minirules)):: | |
823 | (loop ((List.map Ast.get_meta_name metavars)@bound) rules) in | |
824 | loop [] rules | |
825 | *) | |
826 | ||
827 | let collect_astfvs rules = | |
828 | let rec loop bound = function | |
829 | [] -> [] | |
830 | | (metavars, rule)::rules -> | |
831 | match rule with | |
413ffc02 C |
832 | Ast.ScriptRule (_,_,_,_,script_vars,_) -> |
833 | (* why are metavars in rule, but outside for cocci rule??? *) | |
834 | let bound = script_vars @ bound in | |
835 | rule::(loop bound rules) | |
174d1640 | 836 | | Ast.InitialScriptRule (_,_,_,_) | Ast.FinalScriptRule (_,_,_,_) -> |
34e49164 C |
837 | (* bound stays as is because script rules have no names, so no |
838 | inheritance is possible *) | |
839 | rule::(loop bound rules) | |
faf9a90c | 840 | | Ast.CocciRule (nm, rule_info, minirules, isexp, ruletype) -> |
34e49164 C |
841 | let bound = |
842 | Common.minus_set bound (List.map Ast.get_meta_name metavars) in | |
843 | (Ast.CocciRule | |
844 | (nm, rule_info, | |
845 | (List.map (astfvs metavars bound).V.rebuilder_top_level | |
846 | minirules), | |
faf9a90c | 847 | isexp, ruletype)):: |
34e49164 C |
848 | (loop ((List.map Ast.get_meta_name metavars)@bound) rules) in |
849 | loop [] rules | |
850 | ||
851 | (* ---------------------------------------------------------------- *) | |
852 | (* position variables that appear as a constraint on another position variable. | |
853 | a position variable also cannot appear both positively and negatively in a | |
854 | single rule. *) | |
855 | ||
856 | let get_neg_pos_list (_,rule) used_after_list = | |
857 | let donothing r k e = k e in | |
858 | let bind (p1,np1) (p2,np2) = | |
859 | (Common.union_set p1 p2, Common.union_set np1 np2) in | |
860 | let option_default = ([],[]) in | |
861 | let metaid (x,_,_,_) = x in | |
862 | let mcode r mc = | |
8f657093 C |
863 | List.fold_left |
864 | (function (a,b) -> | |
865 | (function | |
866 | Ast.MetaPos(name,constraints,Ast.PER,_,_) -> | |
867 | ((metaid name)::a,constraints@b) | |
868 | | Ast.MetaPos(name,constraints,Ast.ALL,_,_) -> | |
869 | (a,(metaid name)::constraints@b))) | |
870 | option_default (Ast.get_pos_var mc) in | |
34e49164 C |
871 | let v = |
872 | V.combiner bind option_default | |
873 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode | |
c491d8ee | 874 | donothing donothing donothing donothing donothing |
34e49164 C |
875 | donothing donothing donothing donothing donothing donothing |
876 | donothing donothing donothing donothing donothing donothing in | |
877 | match rule with | |
faf9a90c | 878 | Ast.CocciRule(_,_,minirules,_,_) -> |
34e49164 C |
879 | List.map |
880 | (function toplevel -> | |
881 | let (positions,neg_positions) = v.V.combiner_top_level toplevel in | |
882 | (if List.exists (function p -> List.mem p neg_positions) positions | |
883 | then | |
884 | failwith | |
885 | "a variable cannot be used both as a position and a constraint"); | |
886 | neg_positions) | |
887 | minirules | |
b1b2de81 C |
888 | | Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> |
889 | (*no negated positions*) [] | |
34e49164 C |
890 | |
891 | (* ---------------------------------------------------------------- *) | |
892 | ||
893 | (* collect used after lists, per minirule *) | |
894 | ||
895 | (* defined is a list of variables that were declared in a previous metavar | |
896 | declaration *) | |
897 | ||
898 | (* Top-level used after: For each rule collect the set of variables that | |
899 | are inherited, ie used but not defined. These are accumulated back to | |
900 | their point of definition. *) | |
901 | ||
902 | ||
903 | let collect_top_level_used_after metavar_rule_list = | |
ae4735db | 904 | let drop_virt = List.filter (function ("virtual",_) -> false | _ -> true) in |
34e49164 C |
905 | let (used_after,used_after_lists) = |
906 | List.fold_right | |
907 | (function (metavar_list,r) -> | |
908 | function (used_after,used_after_lists) -> | |
413ffc02 C |
909 | let locally_defined = |
910 | match r with | |
911 | Ast.ScriptRule (_,_,_,_,free_vars,_) -> free_vars | |
912 | | _ -> List.map Ast.get_meta_name metavar_list in | |
34e49164 C |
913 | let continue_propagation = |
914 | List.filter (function x -> not(List.mem x locally_defined)) | |
915 | used_after in | |
916 | let free_vars = | |
917 | match r with | |
413ffc02 | 918 | Ast.ScriptRule (_,_,_,mv,_,_) -> |
174d1640 C |
919 | drop_virt(List.map (function (_,(r,v),_) -> (r,v)) mv) |
920 | | Ast.InitialScriptRule (_,_,_,_) | |
921 | | Ast.FinalScriptRule (_,_,_,_) -> [] | |
faf9a90c | 922 | | Ast.CocciRule (_,_,rule,_,_) -> |
ae4735db C |
923 | drop_virt |
924 | (Common.union_set (nub (collect_all_rule_refs rule)) | |
925 | (collect_in_plus metavar_list rule)) in | |
34e49164 C |
926 | let inherited = |
927 | List.filter (function x -> not (List.mem x locally_defined)) | |
928 | free_vars in | |
929 | (Common.union_set inherited continue_propagation, | |
930 | used_after::used_after_lists)) | |
931 | metavar_rule_list ([],[]) in | |
932 | match used_after with | |
933 | [] -> used_after_lists | |
934 | | _ -> | |
935 | failwith | |
936 | (Printf.sprintf "collect_top_level_used_after: unbound variables %s" | |
937 | (String.concat " " (List.map (function (_,x) -> x) used_after))) | |
faf9a90c | 938 | |
34e49164 C |
939 | let collect_local_used_after metavars minirules used_after = |
940 | let locally_defined = List.map Ast.get_meta_name metavars in | |
978fd7e5 C |
941 | let rec loop = function |
942 | [] -> (used_after,[],[],[],[]) | |
34e49164 | 943 | | minirule::rest -> |
978fd7e5 C |
944 | (* In a rule there are three kinds of local variables: |
945 | 1. Variables referenced in the minus or context code. | |
946 | These get a value by matching. This value can be used in | |
947 | subsequent rules. | |
948 | 2. Fresh variables referenced in the plus code. | |
949 | 3. Variables referenced in the seeds of the fresh variables. | |
950 | There are also non-local variables. These may either be variables | |
951 | referenced in the minus, context, or plus code, or they may be | |
952 | variables referenced in the seeds of the fresh variables. *) | |
953 | (* Step 1: collect all references in minus/context, plus, seed | |
954 | code *) | |
955 | let variables_referenced_in_minus_context_code = | |
956 | nub (collect_all_minirule_refs minirule) in | |
957 | let variables_referenced_in_plus_code = | |
958 | collect_in_plus_term.V.combiner_top_level minirule in | |
959 | let (env_of_fresh_seeds,seeds_and_plus) = | |
960 | collect_fresh_seed_env | |
961 | metavars variables_referenced_in_plus_code in | |
962 | let all_free_vars = | |
963 | Common.union_set variables_referenced_in_minus_context_code | |
964 | seeds_and_plus in | |
965 | (* Step 2: identify locally defined ones *) | |
966 | let local_fresh = List.map fst env_of_fresh_seeds in | |
967 | let is_local = | |
968 | List.partition (function x -> List.mem x locally_defined) in | |
969 | let local_env_of_fresh_seeds = | |
970 | (* these have to be restricted to only one value if the associated | |
971 | fresh variable is used after *) | |
972 | List.map (function (f,ss) -> (f,is_local ss)) env_of_fresh_seeds in | |
973 | let (local_all_free_vars,nonlocal_all_free_vars) = | |
974 | is_local all_free_vars in | |
975 | (* Step 3, recurse on the rest of the rules, making available whatever | |
976 | has been defined in this one *) | |
977 | let (mini_used_after,fvs_lists,mini_used_after_lists, | |
978 | mini_fresh_used_after_lists,mini_fresh_used_after_seeds) = | |
979 | loop rest in | |
980 | (* Step 4: collect the results. These are: | |
981 | 1. All of the variables used non-locally in the rules starting | |
982 | with this one | |
983 | 2. All of the free variables to the end of the semantic patch | |
984 | 3. The variables that are used afterwards and defined here by | |
985 | matching (minus or context code) | |
986 | 4. The variables that are used afterwards and are defined here as | |
987 | fresh | |
988 | 5. The variables that are used as seeds in computing the bindings | |
989 | of the variables collected in part 4. *) | |
990 | let (local_used_after, nonlocal_used_after) = | |
991 | is_local mini_used_after in | |
992 | let (fresh_local_used_after(*4*),matched_local_used_after) = | |
993 | List.partition (function x -> List.mem x local_fresh) | |
994 | local_used_after in | |
995 | let matched_local_used_after(*3*) = | |
996 | Common.union_set matched_local_used_after nonlocal_used_after in | |
997 | let new_used_after = (*1*) | |
998 | Common.union_set nonlocal_all_free_vars nonlocal_used_after in | |
999 | let fresh_local_used_after_seeds = | |
1000 | List.filter | |
1001 | (* no point to keep variables that already are gtd to have only | |
1002 | one value *) | |
1003 | (function x -> not (List.mem x matched_local_used_after)) | |
1004 | (List.fold_left (function p -> function c -> Common.union_set c p) | |
1005 | [] | |
1006 | (List.map | |
1007 | (function fua -> | |
1008 | fst (List.assoc fua local_env_of_fresh_seeds)) | |
1009 | fresh_local_used_after)) in | |
1010 | (new_used_after,all_free_vars::fvs_lists(*2*), | |
1011 | matched_local_used_after::mini_used_after_lists, | |
1012 | fresh_local_used_after::mini_fresh_used_after_lists, | |
1013 | fresh_local_used_after_seeds::mini_fresh_used_after_seeds) in | |
1014 | let (_,fvs_lists,used_after_lists(*ua*), | |
1015 | fresh_used_after_lists(*fua*),fresh_used_after_lists_seeds(*fuas*)) = | |
1016 | loop minirules in | |
1017 | (fvs_lists,used_after_lists, | |
1018 | fresh_used_after_lists,fresh_used_after_lists_seeds) | |
1019 | ||
34e49164 C |
1020 | |
1021 | ||
1022 | let collect_used_after metavar_rule_list = | |
1023 | let used_after_lists = collect_top_level_used_after metavar_rule_list in | |
1024 | List.map2 | |
1025 | (function (metavars,r) -> | |
1026 | function used_after -> | |
1027 | match r with | |
413ffc02 | 1028 | Ast.ScriptRule (_,_,_,_,_,_) (* no minirules, so nothing to do? *) |
174d1640 | 1029 | | Ast.InitialScriptRule (_,_,_,_) | Ast.FinalScriptRule (_,_,_,_) -> |
413ffc02 | 1030 | ([], [used_after], [[]], []) |
faf9a90c | 1031 | | Ast.CocciRule (name, rule_info, minirules, _,_) -> |
34e49164 C |
1032 | collect_local_used_after metavars minirules used_after |
1033 | ) | |
1034 | metavar_rule_list used_after_lists | |
1035 | ||
978fd7e5 C |
1036 | let rec split4 = function |
1037 | [] -> ([],[],[],[]) | |
1038 | | (a,b,c,d)::l -> let (a1,b1,c1,d1) = split4 l in (a::a1,b::b1,c::c1,d::d1) | |
1039 | ||
34e49164 C |
1040 | (* ---------------------------------------------------------------- *) |
1041 | (* entry point *) | |
1042 | ||
1043 | let free_vars rules = | |
1044 | let metavars = List.map (function (mv,rule) -> mv) rules in | |
978fd7e5 C |
1045 | let (fvs_lists,used_after_matched_lists, |
1046 | fresh_used_after_lists,fresh_used_after_lists_seeds) = | |
1047 | split4 (collect_used_after rules) in | |
1048 | let neg_pos_lists = | |
1049 | List.map2 get_neg_pos_list rules used_after_matched_lists in | |
34e49164 C |
1050 | let positions_list = (* for all rules, assume all positions are used after *) |
1051 | List.map | |
1052 | (function (mv, r) -> | |
1053 | match r with | |
413ffc02 | 1054 | Ast.ScriptRule _ (* doesn't declare position variables *) |
b1b2de81 | 1055 | | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> [] |
faf9a90c | 1056 | | Ast.CocciRule (_,_,rule,_,_) -> |
34e49164 C |
1057 | let positions = |
1058 | List.fold_left | |
1059 | (function prev -> | |
1060 | function Ast.MetaPosDecl(_,nm) -> nm::prev | _ -> prev) | |
1061 | [] mv in | |
1062 | List.map (function _ -> positions) rule) | |
1063 | rules in | |
1064 | let new_rules = | |
1065 | List.map2 | |
1066 | (function (mv,r) -> | |
978fd7e5 | 1067 | function (ua,fua) -> |
34e49164 | 1068 | match r with |
b1b2de81 C |
1069 | Ast.ScriptRule _ |
1070 | | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> r | |
faf9a90c | 1071 | | Ast.CocciRule (nm, rule_info, r, is_exp,ruletype) -> |
34e49164 | 1072 | Ast.CocciRule |
978fd7e5 C |
1073 | (nm, rule_info, |
1074 | classify_variables mv r | |
1075 | ((List.concat ua) @ (List.concat fua)), | |
faf9a90c | 1076 | is_exp,ruletype)) |
978fd7e5 | 1077 | rules (List.combine used_after_matched_lists fresh_used_after_lists) in |
34e49164 | 1078 | let new_rules = collect_astfvs (List.combine metavars new_rules) in |
faf9a90c | 1079 | (metavars,new_rules, |
978fd7e5 C |
1080 | fvs_lists,neg_pos_lists, |
1081 | (used_after_matched_lists, | |
1082 | fresh_used_after_lists,fresh_used_after_lists_seeds), | |
1083 | positions_list) |