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 module Ast = Ast_cocci
  26 module V = Visitor_ast
  27 module TC = Type_cocci
  28
  29 (* Issues:
  30
  31 1.  If a rule X depends on a rule Y (in a positive way), then we can ignore
  32     the constants in X.
  33
  34 2.  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
  37 3.  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
  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
  47 (* ----------------------------------------------------------------------- *)
  48 (* This phase collects everything.  One can then filter out what it not
  49 wanted *)
  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 *)
  54 type combine =
  55     And of combine list | Or of combine list | Elem of string | False | True
  56
  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).
  59 This tries just removing one of them and then orders the results by
  60 increasing number of ors (ors are long, increasing the chance of failure,
  61 and are less restrictive, possibly increasing the chance of irrelevant
  62 code. *)
  63 let 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
 103 let interpret_glimpse strict x =
 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))
 110     | True ->
 111         if strict
 112         then failwith "True should not be in the final result"
 113         else "True"
 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"
 122   | _ ->
 123       Some (if strict then List.map loop (x::reduce_glimpse x) else [loop x])
 124
 125 (* grep only does or *)
 126 let 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
 145 let 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
 172 let combine2c x =
 173   match interpret_glimpse false x with
 174     None -> "None"
 175   | Some x -> String.concat " || " x
 176
 177 let norm = function
 178     And l -> And (List.sort compare l)
 179   | Or l  -> Or (List.sort compare l)
 180   | x -> x
 181
 182 let 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
 193 let intersect l1 l2 = List.filter (function l1e -> List.mem l1e l2) l1
 194
 195 let minus_set l1 l2 = List.filter (function l1e -> not (List.mem l1e l2)) l1
 196
 197 let rec insert x l = merge [x] l
 198
 199 let 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
 228 and 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
 257 let keep x = Elem x
 258 let drop x = True
 259
 260 let 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) =
 265     (* ignore virtuals *)
 266     if nm1 = "virtual" then option_default
 267     (* perhaps inherited, but value not required, so no constraints *)
 268     else if List.mem x neg_pos then option_default
 269     else (try List.assoc nm1 env with Not_found -> False) in
 270   let minherited name = inherited (Ast.unwrap_mcode name) in
 271   let mcode _ x =
 272     match Ast.get_pos_var x with
 273       Ast.MetaPos(name,constraints,_,keep,inh) -> minherited name
 274     | _ -> option_default in
 275
 276   (* if one branch gives no information, then we have to take anything *)
 277   let disj_union_all = List.fold_left build_or False in
 278
 279   let ident r k i =
 280     match Ast.unwrap i with
 281       Ast.Id(name) ->
 282         bind (k i)
 283           (match Ast.unwrap_mcode name with
 284             "NULL" -> keywords "NULL"
 285           | nm -> constants nm)
 286     | Ast.MetaId(name,_,_,_) | Ast.MetaFunc(name,_,_,_)
 287     | Ast.MetaLocalFunc(name,_,_,_) -> bind (k i) (minherited name)
 288     | Ast.DisjId(ids) -> disj_union_all (List.map r.V.combiner_ident ids)
 289     | _ -> k i in
 290
 291   let rec type_collect res = function
 292       TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
 293     | TC.Array(ty) -> type_collect res ty
 294     | TC.MetaType(tyname,_,_) ->
 295         inherited tyname
 296     | TC.TypeName(s) -> constants s
 297     | TC.EnumName(TC.Name s) -> constants s
 298     | TC.StructUnionName(_,TC.Name s) -> constants s
 299     | ty -> res in
 300
 301   (* no point to do anything special for records because glimpse is
 302      word-oriented *)
 303   let expression r k e =
 304     match Ast.unwrap e with
 305       Ast.Constant(const) ->
 306         bind (k e)
 307           (match Ast.unwrap_mcode const with
 308             Ast.String s -> constants s
 309           | Ast.Char "\\0" -> option_default (* glimpse doesn't like it *)
 310           | Ast.Char s -> option_default (* probably not chars either *)
 311           (* the following were eg keywords "1", but not good for glimpse *)
 312           | Ast.Int s -> option_default (* glimpse doesn't index integers *)
 313           | Ast.Float s -> option_default (* probably not floats either *))
 314     | Ast.MetaExpr(name,_,_,Some type_list,_,_) ->
 315         let types = List.fold_left type_collect option_default type_list in
 316         bind (k e) (bind (minherited name) types)
 317     | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) ->
 318         bind (k e) (minherited name)
 319     | Ast.MetaExprList(name,Ast.MetaListLen (lenname,_,_),_,_) ->
 320         bind (k e) (bind (minherited name) (minherited lenname))
 321     | Ast.MetaExprList(name,_,_,_) -> minherited name
 322     | Ast.SizeOfExpr(sizeof,exp) -> bind (keywords "sizeof") (k e)
 323     | Ast.SizeOfType(sizeof,lp,ty,rp) -> bind (keywords "sizeof") (k e)
 324     | Ast.NestExpr(starter,expr_dots,ender,wc,false) -> option_default
 325     | Ast.NestExpr(starter,expr_dots,ender,wc,true) ->
 326         r.V.combiner_expression_dots expr_dots
 327     | Ast.DisjExpr(exps) ->
 328         disj_union_all (List.map r.V.combiner_expression exps)
 329     | Ast.OptExp(exp) -> option_default
 330     | Ast.Edots(_,_) | Ast.Ecircles(_,_) | Ast.Estars(_,_) -> option_default
 331     | _ -> k e in
 332
 333   let fullType r k ft =
 334     match Ast.unwrap ft with
 335       Ast.DisjType(decls) ->
 336         disj_union_all (List.map r.V.combiner_fullType decls)
 337     | Ast.OptType(ty) -> option_default
 338     | _ -> k ft in
 339
 340   let baseType = function
 341       Ast.VoidType -> keywords "void "
 342     | Ast.CharType -> keywords "char "
 343     | Ast.ShortType -> keywords "short "
 344     | Ast.IntType -> keywords "int "
 345     | Ast.DoubleType -> keywords "double "
 346     | Ast.FloatType -> keywords "float "
 347     | Ast.LongType | Ast.LongLongType -> keywords "long "
 348     | Ast.SizeType -> keywords "size_t "
 349     | Ast.SSizeType -> keywords "ssize_t "
 350     | Ast.PtrDiffType -> keywords "ptrdiff_t " in
 351
 352   let typeC r k ty =
 353     match Ast.unwrap ty with
 354       Ast.BaseType(ty1,strings) -> bind (k ty) (baseType ty1)
 355     | Ast.TypeName(name) -> bind (k ty) (constants (Ast.unwrap_mcode name))
 356     | Ast.MetaType(name,_,_) -> bind (minherited name) (k ty)
 357     | _ -> k ty in
 358
 359   let declaration r k d =
 360     match Ast.unwrap d with
 361       Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) ->
 362         bind (k d) (minherited name)
 363     | Ast.MetaFieldList(name,Ast.MetaListLen(lenname,_,_),_,_) ->
 364         bind (minherited name) (bind (minherited lenname) (k d))
 365     | Ast.DisjDecl(decls) ->
 366         disj_union_all (List.map r.V.combiner_declaration decls)
 367     | Ast.OptDecl(decl) -> option_default
 368     | Ast.Ddots(dots,whencode) -> option_default
 369     | _ -> k d in
 370
 371   let initialiser r k i =
 372     match Ast.unwrap i with
 373       Ast.OptIni(ini) -> option_default
 374     | _ -> k i in
 375
 376   let parameter r k p =
 377     match Ast.unwrap p with
 378       Ast.OptParam(param) -> option_default
 379     | Ast.MetaParam(name,_,_) -> bind (k p) (minherited name)
 380     | Ast.MetaParamList(name,Ast.MetaListLen(lenname,_,_),_,_) ->
 381         bind (minherited name) (bind (minherited lenname) (k p))
 382     | Ast.MetaParamList(name,_,_,_) -> bind (k p) (minherited name)
 383     | _ -> k p in
 384
 385   let rule_elem r k re =
 386     match Ast.unwrap re with
 387       Ast.MetaRuleElem(name,_,_) | Ast.MetaStmt(name,_,_,_)
 388     | Ast.MetaStmtList(name,_,_) -> bind (minherited name) (k re)
 389     | Ast.WhileHeader(whl,lp,exp,rp) ->
 390         bind (keywords "while") (k re)
 391     | Ast.WhileTail(whl,lp,exp,rp,sem) ->
 392         bind (keywords "do") (k re)
 393     | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
 394         bind (keywords "for") (k re)
 395     | Ast.SwitchHeader(switch,lp,exp,rp) ->
 396         bind (keywords "switch") (k re)
 397     | Ast.Break(br,sem) ->
 398         bind (keywords "break") (k re)
 399     | Ast.Continue(cont,sem) ->
 400         bind (keywords "continue") (k re)
 401     | Ast.Goto(_,i,_) ->
 402         bind (keywords "goto") (k re)
 403     | Ast.Default(def,colon) ->
 404         bind (keywords "default") (k re)
 405     | Ast.Include(inc,s) ->
 406         bind (k re)
 407           (match Ast.unwrap_mcode s with
 408             Ast.Local l | Ast.NonLocal l ->
 409               let strings =
 410                 List.fold_left
 411                   (function prev ->
 412                     function
 413                         (* just take the last thing, probably the most
 414                            specific.  everything is necessary anyway. *)
 415                         Ast.IncPath s -> [Elem s]
 416                       | Ast.IncDots -> prev)
 417                   [] l in
 418               (match strings with
 419                 [] -> True
 420               | x::xs -> List.fold_left bind x xs))
 421     | Ast.DisjRuleElem(res) ->
 422         disj_union_all (List.map r.V.combiner_rule_elem res)
 423     | _ -> k re in
 424
 425   let statement r k s =
 426     match Ast.unwrap s with
 427       Ast.Disj(stmt_dots) ->
 428         disj_union_all (List.map r.V.combiner_statement_dots stmt_dots)
 429     | Ast.Nest(starter,stmt_dots,ender,whn,false,_,_) -> option_default
 430     | Ast.Nest(starter,stmt_dots,ender,whn,true,_,_) ->
 431         r.V.combiner_statement_dots stmt_dots
 432     | Ast.OptStm(s) -> option_default
 433     | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) ->
 434         option_default
 435     | _ -> k s in
 436
 437   V.combiner bind option_default
 438     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 439     donothing donothing donothing donothing donothing
 440     ident expression fullType typeC initialiser parameter declaration
 441     rule_elem statement donothing donothing donothing
 442
 443 (* ------------------------------------------------------------------------ *)
 444
 445 let filter_combine combine to_drop =
 446   let rec and_loop = function
 447       Elem x when List.mem x to_drop -> True
 448     | Or l ->  List.fold_left build_or  False (List.map or_loop l)
 449     | x -> x
 450   and or_loop = function
 451       Elem x when List.mem x to_drop -> False
 452     | And l -> List.fold_left build_and True  (List.map and_loop l)
 453     | x -> x in
 454  or_loop combine
 455
 456 (* ------------------------------------------------------------------------ *)
 457
 458 let get_all_constants minus_only =
 459   let donothing r k e = k e in
 460   let bind = Common.union_set in
 461   let option_default = [] in
 462   let mcode r (x,_,mcodekind,_) =
 463     match mcodekind with
 464       Ast.MINUS(_,_,_,_) -> [x]
 465     | _ when minus_only -> []
 466     | _ -> [x] in
 467   let other r _ = [] in
 468
 469   V.combiner bind option_default
 470     other mcode other other other other other other other other other other
 471
 472     donothing donothing donothing donothing donothing
 473     donothing donothing donothing donothing donothing donothing donothing
 474     donothing donothing donothing donothing donothing
 475
 476 (* ------------------------------------------------------------------------ *)
 477
 478 let get_plus_constants =
 479   let donothing r k e = k e in
 480   let bind = Common.union_set in
 481   let option_default = [] in
 482
 483   let recurse l =
 484     List.fold_left
 485       (List.fold_left
 486          (function prev ->
 487            function cur ->
 488              bind ((get_all_constants false).V.combiner_anything cur) prev))
 489       [] l in
 490   let process_mcodekind = function
 491       Ast.MINUS(_,_,_,anythings) -> recurse anythings
 492     | Ast.CONTEXT(_,Ast.BEFORE(a,_)) -> recurse a
 493     | Ast.CONTEXT(_,Ast.AFTER(a,_)) -> recurse a
 494     | Ast.CONTEXT(_,Ast.BEFOREAFTER(a1,a2,_)) ->
 495         Common.union_set (recurse a1) (recurse a2)
 496     | _ -> [] in
 497
 498   let mcode r mc = process_mcodekind (Ast.get_mcodekind mc) in
 499   let end_info (_,_,_,mc) = process_mcodekind mc in
 500
 501   let rule_elem r k e =
 502     match Ast.unwrap e with
 503       Ast.FunHeader(bef,_,_,_,_,_,_)
 504     | Ast.Decl(bef,_,_) -> bind (process_mcodekind bef) (k e)
 505     | _ -> k e in
 506
 507   let statement r k e =
 508     match Ast.unwrap e with
 509       Ast.IfThen(_,_,ei) | Ast.IfThenElse(_,_,_,_,ei)
 510     | Ast.While(_,_,ei)  | Ast.For(_,_,ei)
 511     | Ast.Iterator(_,_,ei) -> bind (k e) (end_info ei)
 512     | _ -> k e in
 513
 514   V.combiner bind option_default
 515     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 516     donothing donothing donothing donothing donothing
 517     donothing donothing donothing donothing donothing donothing donothing
 518     rule_elem statement donothing donothing donothing
 519
 520 (* ------------------------------------------------------------------------ *)
 521
 522 (* true means the rule should be analyzed, false means it should be ignored *)
 523 let rec dependencies env = function
 524     Ast.Dep s -> (try List.assoc s env with Not_found -> False)
 525   | Ast.AntiDep s -> True
 526   | Ast.EverDep s -> (try List.assoc s env with Not_found -> False)
 527   | Ast.NeverDep s -> True
 528   | Ast.AndDep (d1,d2) -> build_and (dependencies env d1) (dependencies env d2)
 529   | Ast.OrDep (d1,d2) -> build_or (dependencies env d1) (dependencies env d2)
 530   | Ast.NoDep -> True
 531   | Ast.FailDep -> False
 532
 533 (* ------------------------------------------------------------------------ *)
 534
 535 let all_context =
 536   let bind x y = x && y in
 537   let option_default = true in
 538
 539   let donothing recursor k e = k e in
 540
 541   let process_mcodekind = function
 542       Ast.CONTEXT(_,Ast.NOTHING) -> true
 543     | _ -> false in
 544
 545   let mcode r e = process_mcodekind (Ast.get_mcodekind e) in
 546
 547   let end_info (_,_,_,mc) = process_mcodekind mc in
 548
 549   let initialiser r k e =
 550     match Ast.unwrap e with
 551       Ast.StrInitList(all_minus,_,_,_,_) ->
 552         not all_minus && k e
 553     | _ -> k e in
 554
 555   let rule_elem r k e =
 556     match Ast.unwrap e with
 557       Ast.FunHeader(bef,_,_,_,_,_,_)
 558     | Ast.Decl(bef,_,_) -> bind (process_mcodekind bef) (k e)
 559     | _ -> k e in
 560
 561   let statement r k e =
 562     match Ast.unwrap e with
 563       Ast.IfThen(_,_,ei) | Ast.IfThenElse(_,_,_,_,ei)
 564     | Ast.While(_,_,ei)  | Ast.For(_,_,ei)
 565     | Ast.Iterator(_,_,ei) -> bind (k e) (end_info ei)
 566     | _ -> k e in
 567
 568   V.combiner bind option_default
 569     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 570     donothing donothing donothing donothing donothing
 571     donothing donothing donothing donothing initialiser donothing
 572     donothing rule_elem statement donothing donothing donothing
 573
 574 (* ------------------------------------------------------------------------ *)
 575
 576 let rule_fn tls in_plus env neg_pos =
 577   List.fold_left
 578     (function (rest_info,in_plus) ->
 579       function (cur,neg_pos) ->
 580         let minuses =
 581           let getter = do_get_constants keep drop env neg_pos in
 582           getter.V.combiner_top_level cur in
 583         let all_minuses =
 584           if !Flag.sgrep_mode2
 585           then [] (* nothing removed for sgrep *)
 586           else (get_all_constants true).V.combiner_top_level cur in
 587         let plusses = get_plus_constants.V.combiner_top_level cur in
 588         (* the following is for eg -foo(2) +foo(x) then in another rule
 589            -foo(10); don't want to consider that foo is guaranteed to be
 590            created by the rule.  not sure this works completely: what if foo is
 591            in both - and +, but in an or, so the cases aren't related?
 592            not sure this whole thing is a good idea.  how do we know that
 593            something that is only in plus is really freshly created? *)
 594         let plusses = Common.minus_set plusses all_minuses in
 595         let was_bot = minuses = True in
 596         let new_minuses = filter_combine minuses in_plus in
 597         let new_plusses = Common.union_set plusses in_plus in
 598         (* perhaps it should be build_and here?  we don't realy have multiple
 599            minirules anymore anyway. *)
 600         match new_minuses with
 601           True ->
 602             let getter = do_get_constants drop keep env neg_pos in
 603             let retry = getter.V.combiner_top_level cur in
 604             (match retry with
 605               True when not was_bot -> (rest_info, new_plusses)
 606             | x -> (build_or x rest_info, new_plusses))
 607         | x -> (build_or x rest_info, new_plusses))
 608     (False,in_plus) (List.combine tls neg_pos)
 609
 610 let run rules neg_pos_vars =
 611   let (info,_,_,_) =
 612     List.fold_left
 613       (function (rest_info,in_plus,env,locals(*dom of env*)) ->
 614         function
 615             (Ast.ScriptRule (nm,_,deps,mv,_,_),_) ->
 616               let extra_deps =
 617                 List.fold_left
 618                   (function prev ->
 619                     function (_,(rule,_),_) ->
 620                       if rule = "virtual"
 621                       then prev
 622                       else Ast.AndDep (Ast.Dep rule,prev))
 623                   deps mv in
 624               (match dependencies env extra_deps with
 625                 False -> (rest_info, in_plus, (nm,True)::env, nm::locals)
 626               | dependencies ->
 627                   (build_or dependencies rest_info, in_plus, env, locals))
 628           | (Ast.InitialScriptRule (_,_,deps,_),_)
 629           | (Ast.FinalScriptRule (_,_,deps,_),_) ->
 630                   (* initialize and finalize dependencies are irrelevant to
 631                      get_constants *)
 632               (rest_info, in_plus, env, locals)
 633           | (Ast.CocciRule (nm,(dep,_,_),cur,_,_),neg_pos_vars) ->
 634               let (cur_info,cur_plus) =
 635                 rule_fn cur in_plus ((nm,True)::env)
 636                   neg_pos_vars in
 637               (match dependencies env dep with
 638                 False -> (rest_info,cur_plus,env,locals)
 639               | dependencies ->
 640                   if List.for_all all_context.V.combiner_top_level cur
 641                   then (rest_info,cur_plus,(nm,cur_info)::env,nm::locals)
 642                   else
 643                (* no constants if dependent on another rule; then we need to
 644                   find the constants of that rule *)
 645                     (build_or (build_and dependencies cur_info) rest_info,
 646                      cur_plus,env,locals)))
 647       (False,[],[],[])
 648       (List.combine (rules : Ast.rule list) neg_pos_vars) in
 649   info
 650
 651 let get_constants rules neg_pos_vars =
 652   match !Flag.scanner with
 653     Flag.NoScanner -> (None,None,None)
 654   | Flag.Grep ->
 655       let res = run rules neg_pos_vars in
 656       (interpret_grep true res,None,None)
 657   | Flag.Glimpse ->
 658       let res = run rules neg_pos_vars in
 659       (interpret_grep true res,interpret_glimpse true res,None)
 660   | Flag.Google _ ->
 661       let res = run rules neg_pos_vars in
 662       (interpret_grep true res,interpret_google true res,None)
 663   | Flag.IdUtils ->
 664       let res = run rules neg_pos_vars in
 665       (interpret_grep true res,None,Some res)