parsing_cocci/get_constants2.ml

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