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