coccinelle release 1.0.0-rc6
[bpt/coccinelle.git] / parsing_cocci / get_constants2.ml
CommitLineData
f537ebc4
C
1(*
2 * Copyright 2010, INRIA, University of Copenhagen
3 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
4 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
5 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
6 * This file is part of Coccinelle.
7 *
8 * Coccinelle is free software: you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation, according to version 2 of the License.
11 *
12 * Coccinelle is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
19 *
20 * The authors reserve the right to distribute this or future versions of
21 * Coccinelle under other licenses.
22 *)
23
24
34e49164
C
25module Ast = Ast_cocci
26module V = Visitor_ast
27module TC = Type_cocci
28
29(* Issues:
30
311. If a rule X depends on a rule Y (in a positive way), then we can ignore
32 the constants in X.
33
342. If a rule X contains a metavariable that is not under a disjunction and
35 that is inherited from rule Y, then we can ignore the constants in X.
36
373. If a rule contains a constant x in + code then subsequent rules that
38 have it in - or context should not include it in their list of required
39 constants.
40*)
41
90aeb998
C
42(* This doesn't do the . -> trick of get_constants for record fields, as
43 that does not fit well with the recursive structure. It was not clear
44 that that was completely safe either, although eg putting a newline
45 after the . or -> is probably unusual. *)
46
34e49164
C
47(* ----------------------------------------------------------------------- *)
48(* This phase collects everything. One can then filter out what it not
49wanted *)
50
51(* True means nothing was found
52 False should never drift to the top, it is the neutral element of or
53 and an or is never empty *)
54type combine =
55 And of combine list | Or of combine list | Elem of string | False | True
56
413ffc02
C
57(* glimpse often fails on large queries. We can safely remove arguments of
58&& as long as we don't remove all of them (note that there is no negation).
59This tries just removing one of them and then orders the results by
60increasing number of ors (ors are long, increasing the chance of failure,
61and are less restrictive, possibly increasing the chance of irrelevant
62code. *)
63let reduce_glimpse x =
64 let rec loop x k q =
65 match x with
66 Elem _ -> q()
67 | And [x] -> loop x (function changed_l -> k (And [changed_l])) q
68 | And l ->
69 kloop l
70 (function changed_l -> k (And changed_l))
71 (function _ ->
72 let rec rloop l k =
73 match l with
74 [] -> q()
75 | x::xs ->
76 (k xs) ::
77 rloop xs (function changed_xs -> k (x :: changed_xs)) in
78 rloop l (function changed_l -> k (And changed_l)))
79 | Or l -> kloop l (function changed_l -> k (Or changed_l)) q
80 | _ -> failwith "not possible"
81 and kloop l k q =
82 match l with
83 [] -> q()
84 | x::xs ->
85 loop x
86 (function changed_x -> k (changed_x::xs))
87 (function _ ->
88 kloop xs
89 (function changed_xs -> k (x :: changed_xs))
90 q) in
91 let rec count_ors = function
92 Elem _ -> 0
93 | And l -> List.fold_left (+) 0 (List.map count_ors l)
94 | Or l ->
95 ((List.length l) - 1) +
96 (List.fold_left (+) 0 (List.map count_ors l))
97 | _ -> failwith "not possible" in
98 let res = loop x (function x -> x) (function _ -> []) in
99 let res = List.map (function x -> (count_ors x,x)) res in
100 let res = List.sort compare res in
101 List.map (function (_,x) -> x) res
102
951c7801 103let interpret_glimpse strict x =
34e49164
C
104 let rec loop = function
105 Elem x -> x
106 | And [x] -> loop x
107 | Or [x] -> loop x
108 | And l -> Printf.sprintf "{%s}" (String.concat ";" (List.map loop l))
109 | Or l -> Printf.sprintf "{%s}" (String.concat "," (List.map loop l))
90aeb998
C
110 | True ->
111 if strict
112 then failwith "True should not be in the final result"
113 else "True"
34e49164
C
114 | False ->
115 if strict
116 then failwith "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code"
117 else "False" in
118 match x with
119 True -> None
120 | False when strict ->
121 failwith "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code"
413ffc02
C
122 | _ ->
123 Some (if strict then List.map loop (x::reduce_glimpse x) else [loop x])
951c7801 124
90aeb998
C
125(* grep only does or *)
126let interpret_grep strict x =
127 let rec loop = function
128 Elem x -> [x]
129 | And l -> List.concat (List.map loop l)
130 | Or l -> List.concat (List.map loop l)
131 | True ->
132 if strict
133 then failwith "True should not be in the final result"
134 else ["True"]
135 | False ->
136 if strict
137 then failwith "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code"
138 else ["False"] in
139 match x with
140 True -> None
141 | False when strict ->
142 failwith "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code"
143 | _ -> Some (loop x)
144
951c7801
C
145let interpret_google strict x =
146 (* convert to dnf *)
147 let rec dnf = function
148 Elem x -> [x]
149 | Or l -> List.fold_left Common.union_set [] (List.map dnf l)
150 | And l ->
151 let l = List.map dnf l in
152 List.fold_left
153 (function prev ->
154 function cur ->
155 List.fold_left Common.union_set []
156 (List.map
157 (function x ->
158 List.map (function y -> Printf.sprintf "%s %s" x y) prev)
159 cur))
160 [] l
161 | True -> ["True"]
162 | False ->
163 if strict
164 then failwith "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code"
165 else ["False"] in
166 match x with
167 True -> None
168 | False when strict ->
169 failwith "False should not be in the final result. Perhaps your rule doesn't contain any +/-/* code"
170 | _ -> Some (dnf x)
171
34e49164 172let combine2c x =
90aeb998 173 match interpret_glimpse false x with
34e49164 174 None -> "None"
951c7801 175 | Some x -> String.concat " || " x
34e49164
C
176
177let norm = function
178 And l -> And (List.sort compare l)
179 | Or l -> Or (List.sort compare l)
180 | x -> x
181
182let rec merge l1 l2 =
183 match (l1,l2) with
184 ([],l2) -> l2
185 | (l1,[]) -> l1
186 | (x::xs,y::ys) ->
187 (match compare x y with
188 -1 -> x::(merge xs l2)
189 | 0 -> x::(merge xs ys)
190 | 1 -> y::(merge l1 ys)
191 | _ -> failwith "not possible")
192
193let intersect l1 l2 = List.filter (function l1e -> List.mem l1e l2) l1
194
195let minus_set l1 l2 = List.filter (function l1e -> not (List.mem l1e l2)) l1
196
197let rec insert x l = merge [x] l
198
199let rec build_and x y =
200 if x = y
201 then x
202 else
203 match (x,y) with
204 (True,x) | (x,True) -> x
205 | (False,x) | (x,False) -> False
206 | (And l1,And l2) -> And (merge l1 l2)
207 | (x,Or l) when List.mem x l -> x
208 | (Or l,x) when List.mem x l -> x
209 | (Or l1,Or l2) when not ((intersect l1 l2) = []) ->
210 let inner =
211 build_and
212 (List.fold_left build_or False (minus_set l1 l2))
213 (List.fold_left build_or False (minus_set l2 l1)) in
214 List.fold_left build_or inner (intersect l1 l2)
215 | (x,And l) | (And l,x) ->
216 if List.mem x l
217 then And l
218 else
219 let others =
220 List.filter
221 (function
222 Or l -> not(List.mem x l)
223 | _ -> true)
224 l in
225 And (insert x others)
226 | (x,y) -> norm(And [x;y])
227
228and build_or x y =
229 if x = y
230 then x
231 else
232 match (x,y) with
233 (True,x) | (x,True) -> True
234 | (False,x) | (x,False) -> x
235 | (Or l1,Or l2) -> Or (merge l1 l2)
236 | (x,And l) when List.mem x l -> x
237 | (And l,x) when List.mem x l -> x
238 | (And l1,And l2) when not ((intersect l1 l2) = []) ->
239 let inner =
240 build_or
241 (List.fold_left build_and True (minus_set l1 l2))
242 (List.fold_left build_and True (minus_set l2 l1)) in
243 List.fold_left build_and inner (intersect l1 l2)
244 | (x,Or l) | (Or l,x) ->
245 if List.mem x l
246 then Or l
247 else
248 let others =
249 List.filter
250 (function
251 And l -> not(List.mem x l)
252 | _ -> true)
253 l in
254 Or (insert x others)
255 | (x,y) -> norm(Or [x;y])
256
257let keep x = Elem x
258let drop x = True
259
260let do_get_constants constants keywords env neg_pos =
261 let donothing r k e = k e in
262 let option_default = True in
263 let bind = build_and in
264 let inherited ((nm1,_) as x) =
ae4735db
C
265 (* ignore virtuals *)
266 if nm1 = "virtual" then option_default
34e49164 267 (* perhaps inherited, but value not required, so no constraints *)
ae4735db
C
268 else if List.mem x neg_pos then option_default
269 else (try List.assoc nm1 env with Not_found -> False) in
34e49164
C
270 let minherited name = inherited (Ast.unwrap_mcode name) in
271 let mcode _ x =
8f657093
C
272 List.fold_left bind option_default
273 (List.map
274 (function Ast.MetaPos(name,constraints,_,keep,inh) -> minherited name)
275 (Ast.get_pos_var x)) in
34e49164
C
276
277 (* if one branch gives no information, then we have to take anything *)
278 let disj_union_all = List.fold_left build_or False in
279
280 let ident r k i =
281 match Ast.unwrap i with
282 Ast.Id(name) ->
283 bind (k i)
284 (match Ast.unwrap_mcode name with
285 "NULL" -> keywords "NULL"
286 | nm -> constants nm)
287 | Ast.MetaId(name,_,_,_) | Ast.MetaFunc(name,_,_,_)
288 | Ast.MetaLocalFunc(name,_,_,_) -> bind (k i) (minherited name)
d3f655c6 289 | Ast.DisjId(ids) -> disj_union_all (List.map r.V.combiner_ident ids)
34e49164
C
290 | _ -> k i in
291
292 let rec type_collect res = function
293 TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
294 | TC.Array(ty) -> type_collect res ty
ae4735db
C
295 | TC.MetaType(tyname,_,_) ->
296 inherited tyname
34e49164 297 | TC.TypeName(s) -> constants s
e6509c05
C
298 | TC.EnumName(TC.Name s) -> constants s
299 | TC.StructUnionName(_,TC.Name s) -> constants s
34e49164
C
300 | ty -> res in
301
302 (* no point to do anything special for records because glimpse is
303 word-oriented *)
304 let expression r k e =
305 match Ast.unwrap e with
306 Ast.Constant(const) ->
307 bind (k e)
308 (match Ast.unwrap_mcode const with
309 Ast.String s -> constants s
310 | Ast.Char "\\0" -> option_default (* glimpse doesn't like it *)
fc1ad971 311 | Ast.Char s -> option_default (* probably not chars either *)
34e49164 312 (* the following were eg keywords "1", but not good for glimpse *)
fc1ad971
C
313 | Ast.Int s -> option_default (* glimpse doesn't index integers *)
314 | Ast.Float s -> option_default (* probably not floats either *))
34e49164
C
315 | Ast.MetaExpr(name,_,_,Some type_list,_,_) ->
316 let types = List.fold_left type_collect option_default type_list in
317 bind (k e) (bind (minherited name) types)
318 | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) ->
319 bind (k e) (minherited name)
88e71198 320 | Ast.MetaExprList(name,Ast.MetaListLen (lenname,_,_),_,_) ->
34e49164 321 bind (k e) (bind (minherited name) (minherited lenname))
88e71198 322 | Ast.MetaExprList(name,_,_,_) -> minherited name
34e49164
C
323 | Ast.SizeOfExpr(sizeof,exp) -> bind (keywords "sizeof") (k e)
324 | Ast.SizeOfType(sizeof,lp,ty,rp) -> bind (keywords "sizeof") (k e)
5636bb2c
C
325 | Ast.NestExpr(starter,expr_dots,ender,wc,false) -> option_default
326 | Ast.NestExpr(starter,expr_dots,ender,wc,true) ->
34e49164
C
327 r.V.combiner_expression_dots expr_dots
328 | Ast.DisjExpr(exps) ->
329 disj_union_all (List.map r.V.combiner_expression exps)
330 | Ast.OptExp(exp) -> option_default
331 | Ast.Edots(_,_) | Ast.Ecircles(_,_) | Ast.Estars(_,_) -> option_default
332 | _ -> k e in
faf9a90c 333
34e49164
C
334 let fullType r k ft =
335 match Ast.unwrap ft with
336 Ast.DisjType(decls) ->
337 disj_union_all (List.map r.V.combiner_fullType decls)
338 | Ast.OptType(ty) -> option_default
339 | _ -> k ft in
faf9a90c 340
34e49164 341 let baseType = function
8babbc8f
C
342 Ast.VoidType -> keywords "void"
343 | Ast.CharType -> keywords "char"
344 | Ast.ShortType -> keywords "short"
f3c4ece6 345 | Ast.ShortIntType -> keywords "short"
8babbc8f
C
346 | Ast.IntType -> keywords "int"
347 | Ast.DoubleType -> keywords "double"
f3c4ece6 348 | Ast.LongDoubleType -> keywords "double"
8babbc8f 349 | Ast.FloatType -> keywords "float"
f3c4ece6
C
350 | Ast.LongType | Ast.LongLongType
351 | Ast.LongIntType | Ast.LongLongIntType -> keywords "long"
8babbc8f
C
352 | Ast.SizeType -> keywords "size_t"
353 | Ast.SSizeType -> keywords "ssize_t"
354 | Ast.PtrDiffType -> keywords "ptrdiff_t" in
34e49164
C
355
356 let typeC r k ty =
357 match Ast.unwrap ty with
faf9a90c 358 Ast.BaseType(ty1,strings) -> bind (k ty) (baseType ty1)
34e49164
C
359 | Ast.TypeName(name) -> bind (k ty) (constants (Ast.unwrap_mcode name))
360 | Ast.MetaType(name,_,_) -> bind (minherited name) (k ty)
361 | _ -> k ty in
362
363 let declaration r k d =
364 match Ast.unwrap d with
413ffc02
C
365 Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) ->
366 bind (k d) (minherited name)
190f1acf
C
367 | Ast.MetaFieldList(name,Ast.MetaListLen(lenname,_,_),_,_) ->
368 bind (minherited name) (bind (minherited lenname) (k d))
413ffc02 369 | Ast.DisjDecl(decls) ->
34e49164
C
370 disj_union_all (List.map r.V.combiner_declaration decls)
371 | Ast.OptDecl(decl) -> option_default
372 | Ast.Ddots(dots,whencode) -> option_default
373 | _ -> k d in
374
375 let initialiser r k i =
376 match Ast.unwrap i with
377 Ast.OptIni(ini) -> option_default
378 | _ -> k i in
379
380 let parameter r k p =
381 match Ast.unwrap p with
382 Ast.OptParam(param) -> option_default
383 | Ast.MetaParam(name,_,_) -> bind (k p) (minherited name)
88e71198 384 | Ast.MetaParamList(name,Ast.MetaListLen(lenname,_,_),_,_) ->
34e49164 385 bind (minherited name) (bind (minherited lenname) (k p))
88e71198 386 | Ast.MetaParamList(name,_,_,_) -> bind (k p) (minherited name)
34e49164 387 | _ -> k p in
faf9a90c 388
34e49164
C
389 let rule_elem r k re =
390 match Ast.unwrap re with
391 Ast.MetaRuleElem(name,_,_) | Ast.MetaStmt(name,_,_,_)
392 | Ast.MetaStmtList(name,_,_) -> bind (minherited name) (k re)
393 | Ast.WhileHeader(whl,lp,exp,rp) ->
394 bind (keywords "while") (k re)
395 | Ast.WhileTail(whl,lp,exp,rp,sem) ->
396 bind (keywords "do") (k re)
397 | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
398 bind (keywords "for") (k re)
399 | Ast.SwitchHeader(switch,lp,exp,rp) ->
400 bind (keywords "switch") (k re)
401 | Ast.Break(br,sem) ->
402 bind (keywords "break") (k re)
403 | Ast.Continue(cont,sem) ->
404 bind (keywords "continue") (k re)
405 | Ast.Goto(_,i,_) ->
406 bind (keywords "goto") (k re)
407 | Ast.Default(def,colon) ->
408 bind (keywords "default") (k re)
409 | Ast.Include(inc,s) ->
410 bind (k re)
411 (match Ast.unwrap_mcode s with
412 Ast.Local l | Ast.NonLocal l ->
413 let strings =
414 List.fold_left
415 (function prev ->
416 function
417 (* just take the last thing, probably the most
418 specific. everything is necessary anyway. *)
419 Ast.IncPath s -> [Elem s]
420 | Ast.IncDots -> prev)
421 [] l in
422 (match strings with
423 [] -> True
424 | x::xs -> List.fold_left bind x xs))
425 | Ast.DisjRuleElem(res) ->
426 disj_union_all (List.map r.V.combiner_rule_elem res)
427 | _ -> k re in
faf9a90c 428
34e49164
C
429 let statement r k s =
430 match Ast.unwrap s with
431 Ast.Disj(stmt_dots) ->
432 disj_union_all (List.map r.V.combiner_statement_dots stmt_dots)
5636bb2c
C
433 | Ast.Nest(starter,stmt_dots,ender,whn,false,_,_) -> option_default
434 | Ast.Nest(starter,stmt_dots,ender,whn,true,_,_) ->
34e49164
C
435 r.V.combiner_statement_dots stmt_dots
436 | Ast.OptStm(s) -> option_default
437 | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) ->
438 option_default
439 | _ -> k s in
440
441 V.combiner bind option_default
442 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
c491d8ee 443 donothing donothing donothing donothing donothing
34e49164
C
444 ident expression fullType typeC initialiser parameter declaration
445 rule_elem statement donothing donothing donothing
446
447(* ------------------------------------------------------------------------ *)
448
449let filter_combine combine to_drop =
450 let rec and_loop = function
451 Elem x when List.mem x to_drop -> True
452 | Or l -> List.fold_left build_or False (List.map or_loop l)
453 | x -> x
454 and or_loop = function
455 Elem x when List.mem x to_drop -> False
456 | And l -> List.fold_left build_and True (List.map and_loop l)
457 | x -> x in
458 or_loop combine
459
460(* ------------------------------------------------------------------------ *)
461
462let get_all_constants minus_only =
463 let donothing r k e = k e in
464 let bind = Common.union_set in
465 let option_default = [] in
466 let mcode r (x,_,mcodekind,_) =
467 match mcodekind with
708f4980 468 Ast.MINUS(_,_,_,_) -> [x]
34e49164
C
469 | _ when minus_only -> []
470 | _ -> [x] in
471 let other r _ = [] in
472
473 V.combiner bind option_default
474 other mcode other other other other other other other other other other
34e49164 475
c491d8ee 476 donothing donothing donothing donothing donothing
34e49164
C
477 donothing donothing donothing donothing donothing donothing donothing
478 donothing donothing donothing donothing donothing
479
480(* ------------------------------------------------------------------------ *)
481
482let get_plus_constants =
483 let donothing r k e = k e in
484 let bind = Common.union_set in
485 let option_default = [] in
90aeb998
C
486
487 let recurse l =
488 List.fold_left
489 (List.fold_left
490 (function prev ->
491 function cur ->
492 bind ((get_all_constants false).V.combiner_anything cur) prev))
493 [] l in
494 let process_mcodekind = function
8babbc8f 495 Ast.MINUS(_,_,_,Ast.REPLACEMENT(anythings,_)) -> recurse anythings
951c7801
C
496 | Ast.CONTEXT(_,Ast.BEFORE(a,_)) -> recurse a
497 | Ast.CONTEXT(_,Ast.AFTER(a,_)) -> recurse a
498 | Ast.CONTEXT(_,Ast.BEFOREAFTER(a1,a2,_)) ->
34e49164
C
499 Common.union_set (recurse a1) (recurse a2)
500 | _ -> [] in
501
90aeb998
C
502 let mcode r mc = process_mcodekind (Ast.get_mcodekind mc) in
503 let end_info (_,_,_,mc) = process_mcodekind mc in
504
505 let rule_elem r k e =
506 match Ast.unwrap e with
507 Ast.FunHeader(bef,_,_,_,_,_,_)
508 | Ast.Decl(bef,_,_) -> bind (process_mcodekind bef) (k e)
509 | _ -> k e in
510
511 let statement r k e =
512 match Ast.unwrap e with
513 Ast.IfThen(_,_,ei) | Ast.IfThenElse(_,_,_,_,ei)
514 | Ast.While(_,_,ei) | Ast.For(_,_,ei)
515 | Ast.Iterator(_,_,ei) -> bind (k e) (end_info ei)
516 | _ -> k e in
517
34e49164
C
518 V.combiner bind option_default
519 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
c491d8ee 520 donothing donothing donothing donothing donothing
34e49164 521 donothing donothing donothing donothing donothing donothing donothing
90aeb998 522 rule_elem statement donothing donothing donothing
34e49164
C
523
524(* ------------------------------------------------------------------------ *)
525
526(* true means the rule should be analyzed, false means it should be ignored *)
527let rec dependencies env = function
528 Ast.Dep s -> (try List.assoc s env with Not_found -> False)
529 | Ast.AntiDep s -> True
530 | Ast.EverDep s -> (try List.assoc s env with Not_found -> False)
531 | Ast.NeverDep s -> True
532 | Ast.AndDep (d1,d2) -> build_and (dependencies env d1) (dependencies env d2)
533 | Ast.OrDep (d1,d2) -> build_or (dependencies env d1) (dependencies env d2)
534 | Ast.NoDep -> True
7f004419 535 | Ast.FailDep -> False
34e49164
C
536
537(* ------------------------------------------------------------------------ *)
538
539let all_context =
540 let bind x y = x && y in
541 let option_default = true in
542
543 let donothing recursor k e = k e in
544
90aeb998 545 let process_mcodekind = function
34e49164
C
546 Ast.CONTEXT(_,Ast.NOTHING) -> true
547 | _ -> false in
548
90aeb998
C
549 let mcode r e = process_mcodekind (Ast.get_mcodekind e) in
550
551 let end_info (_,_,_,mc) = process_mcodekind mc in
552
553 let initialiser r k e =
554 match Ast.unwrap e with
c491d8ee 555 Ast.StrInitList(all_minus,_,_,_,_) ->
90aeb998
C
556 not all_minus && k e
557 | _ -> k e in
558
559 let rule_elem r k e =
560 match Ast.unwrap e with
561 Ast.FunHeader(bef,_,_,_,_,_,_)
562 | Ast.Decl(bef,_,_) -> bind (process_mcodekind bef) (k e)
563 | _ -> k e in
564
565 let statement r k e =
566 match Ast.unwrap e with
567 Ast.IfThen(_,_,ei) | Ast.IfThenElse(_,_,_,_,ei)
568 | Ast.While(_,_,ei) | Ast.For(_,_,ei)
569 | Ast.Iterator(_,_,ei) -> bind (k e) (end_info ei)
570 | _ -> k e in
571
34e49164
C
572 V.combiner bind option_default
573 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
c491d8ee 574 donothing donothing donothing donothing donothing
90aeb998
C
575 donothing donothing donothing donothing initialiser donothing
576 donothing rule_elem statement donothing donothing donothing
34e49164
C
577
578(* ------------------------------------------------------------------------ *)
579
580let rule_fn tls in_plus env neg_pos =
581 List.fold_left
582 (function (rest_info,in_plus) ->
583 function (cur,neg_pos) ->
584 let minuses =
ae4735db
C
585 let getter = do_get_constants keep drop env neg_pos in
586 getter.V.combiner_top_level cur in
34e49164
C
587 let all_minuses =
588 if !Flag.sgrep_mode2
589 then [] (* nothing removed for sgrep *)
590 else (get_all_constants true).V.combiner_top_level cur in
591 let plusses = get_plus_constants.V.combiner_top_level cur in
592 (* the following is for eg -foo(2) +foo(x) then in another rule
593 -foo(10); don't want to consider that foo is guaranteed to be
594 created by the rule. not sure this works completely: what if foo is
595 in both - and +, but in an or, so the cases aren't related?
596 not sure this whole thing is a good idea. how do we know that
597 something that is only in plus is really freshly created? *)
598 let plusses = Common.minus_set plusses all_minuses in
599 let was_bot = minuses = True in
600 let new_minuses = filter_combine minuses in_plus in
601 let new_plusses = Common.union_set plusses in_plus in
602 (* perhaps it should be build_and here? we don't realy have multiple
603 minirules anymore anyway. *)
604 match new_minuses with
605 True ->
ae4735db
C
606 let getter = do_get_constants drop keep env neg_pos in
607 let retry = getter.V.combiner_top_level cur in
34e49164
C
608 (match retry with
609 True when not was_bot -> (rest_info, new_plusses)
610 | x -> (build_or x rest_info, new_plusses))
611 | x -> (build_or x rest_info, new_plusses))
612 (False,in_plus) (List.combine tls neg_pos)
613
90aeb998
C
614let run rules neg_pos_vars =
615 let (info,_,_,_) =
616 List.fold_left
617 (function (rest_info,in_plus,env,locals(*dom of env*)) ->
618 function
413ffc02 619 (Ast.ScriptRule (nm,_,deps,mv,_,_),_) ->
90aeb998
C
620 let extra_deps =
621 List.fold_left
622 (function prev ->
174d1640 623 function (_,(rule,_),_) ->
90aeb998
C
624 if rule = "virtual"
625 then prev
626 else Ast.AndDep (Ast.Dep rule,prev))
627 deps mv in
628 (match dependencies env extra_deps with
413ffc02 629 False -> (rest_info, in_plus, (nm,True)::env, nm::locals)
90aeb998
C
630 | dependencies ->
631 (build_or dependencies rest_info, in_plus, env, locals))
174d1640
C
632 | (Ast.InitialScriptRule (_,_,deps,_),_)
633 | (Ast.FinalScriptRule (_,_,deps,_),_) ->
aa721442
C
634 (* initialize and finalize dependencies are irrelevant to
635 get_constants *)
90aeb998
C
636 (rest_info, in_plus, env, locals)
637 | (Ast.CocciRule (nm,(dep,_,_),cur,_,_),neg_pos_vars) ->
638 let (cur_info,cur_plus) =
f3c4ece6 639 rule_fn cur in_plus ((nm,True)::env) neg_pos_vars in
90aeb998
C
640 (match dependencies env dep with
641 False -> (rest_info,cur_plus,env,locals)
642 | dependencies ->
643 if List.for_all all_context.V.combiner_top_level cur
f3c4ece6
C
644 then
645 let cur_info = build_and dependencies cur_info in
646 (rest_info,cur_plus,(nm,cur_info)::env,nm::locals)
90aeb998 647 else
34e49164
C
648 (* no constants if dependent on another rule; then we need to
649 find the constants of that rule *)
f3c4ece6
C
650 (build_or (build_and dependencies cur_info) rest_info,
651 cur_plus,(nm,cur_info)::env,locals)))
90aeb998
C
652 (False,[],[],[])
653 (List.combine (rules : Ast.rule list) neg_pos_vars) in
654 info
655
656let get_constants rules neg_pos_vars =
657 match !Flag.scanner with
1eddfd50 658 Flag.NoScanner -> (None,None,None)
90aeb998
C
659 | Flag.Grep ->
660 let res = run rules neg_pos_vars in
1eddfd50 661 (interpret_grep true res,None,None)
90aeb998
C
662 | Flag.Glimpse ->
663 let res = run rules neg_pos_vars in
1eddfd50 664 (interpret_grep true res,interpret_glimpse true res,None)
90aeb998
C
665 | Flag.Google _ ->
666 let res = run rules neg_pos_vars in
1eddfd50 667 (interpret_grep true res,interpret_google true res,None)
3a314143 668 | Flag.IdUtils ->
1eddfd50
C
669 let res = run rules neg_pos_vars in
670 (interpret_grep true res,None,Some res)