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