parsing_cocci/ast_cocci.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 (* --------------------------------------------------------------------- *)
  50 (* Modified code *)
  51
  52 type added_string = Noindent of string | Indent of string
  53
  54 type info = { line : int; column : int;
  55               strbef : (added_string * int (* line *) * int (* col *)) list;
  56               straft : (added_string * int (* line *) * int (* col *)) list }
  57 type line = int
  58 type meta_name = string * string
  59 (* need to be careful about rewrapping, to avoid duplicating pos info
  60 currently, the pos info is always None until asttoctl2. *)
  61 type 'a wrap =
  62     {node : 'a;
  63       node_line : line;
  64       free_vars : meta_name list; (*free vars*)
  65       minus_free_vars : meta_name list; (*minus free vars*)
  66       fresh_vars : (meta_name * seed) list; (*fresh vars*)
  67       inherited : meta_name list; (*inherited vars*)
  68       saved_witness : meta_name list; (*witness vars*)
  69       bef_aft : dots_bef_aft;
  70       (* the following is for or expressions *)
  71       pos_info : meta_name mcode option; (* pos info, try not to duplicate *)
  72       true_if_test_exp : bool;(* true if "test_exp from iso", only for exprs *)
  73       (* isos relevant to the term; ultimately only used for rule_elems *)
  74       iso_info : (string*anything) list }
  75
  76 and 'a befaft =
  77     BEFORE      of 'a list list * count
  78   | AFTER       of 'a list list * count
  79   | BEFOREAFTER of 'a list list * 'a list list * count
  80   | NOTHING
  81
  82 and 'a mcode = 'a * info * mcodekind * meta_pos (* pos variable *)
  83     (* pos is an offset indicating where in the C code the mcodekind
  84        has an effect *)
  85     (* int list is the match instances, which are only meaningful in annotated
  86        C code *)
  87     (* int is the adjacency index, which is incremented on context dots *)
  88 (* iteration is only allowed on context code, the intuition vaguely being
  89 that there is no way to replace something more than once.  Actually,
  90 allowing iterated additions on minus code would cause problems with some
  91 heuristics for adding braces, because one couldn't identify simple
  92 replacements with certainty.  Anyway, iteration doesn't seem to be needed
  93 on - code for the moment.  Although it may be confusing that there can be
  94 iterated addition of code before context code where the context code is
  95 immediately followed by removed code. *)
  96 and mcodekind =
  97     MINUS       of pos * int list * int * anything list list
  98   | CONTEXT     of pos * anything befaft
  99   | PLUS        of count
 100 and count = ONE (* + *) | MANY (* ++ *)
 101 and fixpos =
 102     Real of int (* charpos *) | Virt of int * int (* charpos + offset *)
 103 and pos = NoPos | DontCarePos | FixPos of (fixpos * fixpos)
 104
 105 and dots_bef_aft =
 106     NoDots
 107   | AddingBetweenDots of statement * int (*index of let var*)
 108   | DroppingBetweenDots of statement * int (*index of let var*)
 109
 110 and inherited = Type_cocci.inherited
 111 and keep_binding = Type_cocci.keep_binding
 112 and multi = bool (*true if a nest is one or more, false if it is zero or more*)
 113
 114 and end_info =
 115     meta_name list (*free vars*) * (meta_name * seed) list (*fresh*) *
 116       meta_name list (*inherited vars*) * mcodekind
 117
 118 (* --------------------------------------------------------------------- *)
 119 (* Metavariables *)
 120
 121 and arity = UNIQUE | OPT | MULTI | NONE
 122
 123 and metavar =
 124     MetaIdDecl of arity * meta_name (* name *)
 125   | MetaFreshIdDecl of meta_name (* name *) * seed (* seed *)
 126   | MetaTypeDecl of arity * meta_name (* name *)
 127   | MetaInitDecl of arity * meta_name (* name *)
 128   | MetaListlenDecl of meta_name (* name *)
 129   | MetaParamDecl of arity * meta_name (* name *)
 130   | MetaParamListDecl of arity * meta_name (*name*) * list_len (*len*)
 131   | MetaConstDecl of
 132       arity * meta_name (* name *) * Type_cocci.typeC list option
 133   | MetaErrDecl of arity * meta_name (* name *)
 134   | MetaExpDecl of
 135       arity * meta_name (* name *) * Type_cocci.typeC list option
 136   | MetaIdExpDecl of
 137       arity * meta_name (* name *) * Type_cocci.typeC list option
 138   | MetaLocalIdExpDecl of
 139       arity * meta_name (* name *) * Type_cocci.typeC list option
 140   | MetaExpListDecl of arity * meta_name (*name*) * list_len (*len*)
 141   | MetaDeclDecl of arity * meta_name (* name *)
 142   | MetaFieldDecl of arity * meta_name (* name *)
 143   | MetaStmDecl of arity * meta_name (* name *)
 144   | MetaStmListDecl of arity * meta_name (* name *)
 145   | MetaFuncDecl of arity * meta_name (* name *)
 146   | MetaLocalFuncDecl of arity * meta_name (* name *)
 147   | MetaPosDecl of arity * meta_name (* name *)
 148   | MetaDeclarerDecl of arity * meta_name (* name *)
 149   | MetaIteratorDecl of arity * meta_name (* name *)
 150
 151 and list_len = AnyLen | MetaLen of meta_name | CstLen of int
 152
 153 and seed = NoVal | StringSeed of string | ListSeed of seed_elem list
 154 and seed_elem = SeedString of string | SeedId of meta_name
 155
 156 (* --------------------------------------------------------------------- *)
 157 (* --------------------------------------------------------------------- *)
 158 (* Dots *)
 159
 160 and 'a base_dots =
 161     DOTS of 'a list
 162   | CIRCLES of 'a list
 163   | STARS of 'a list
 164
 165 and 'a dots = 'a base_dots wrap
 166
 167 (* --------------------------------------------------------------------- *)
 168 (* Identifier *)
 169
 170 and base_ident =
 171     Id            of string mcode
 172   | MetaId        of meta_name mcode * idconstraint * keep_binding * inherited
 173   | MetaFunc      of meta_name mcode * idconstraint * keep_binding * inherited
 174   | MetaLocalFunc of meta_name mcode * idconstraint * keep_binding * inherited
 175
 176   | OptIdent      of ident
 177   | UniqueIdent   of ident
 178
 179 and ident = base_ident wrap
 180
 181 (* --------------------------------------------------------------------- *)
 182 (* Expression *)
 183
 184 and base_expression =
 185     Ident          of ident
 186   | Constant       of constant mcode
 187   | FunCall        of expression * string mcode (* ( *) *
 188                       expression dots * string mcode (* ) *)
 189   | Assignment     of expression * assignOp mcode * expression *
 190                       bool (* true if it can match an initialization *)
 191   | CondExpr       of expression * string mcode (* ? *) * expression option *
 192                       string mcode (* : *) * expression
 193   | Postfix        of expression * fixOp mcode
 194   | Infix          of expression * fixOp mcode
 195   | Unary          of expression * unaryOp mcode
 196   | Binary         of expression * binaryOp mcode * expression
 197   | Nested         of expression * binaryOp mcode * expression
 198   | ArrayAccess    of expression * string mcode (* [ *) * expression *
 199                       string mcode (* ] *)
 200   | RecordAccess   of expression * string mcode (* . *) * ident
 201   | RecordPtAccess of expression * string mcode (* -> *) * ident
 202   | Cast           of string mcode (* ( *) * fullType * string mcode (* ) *) *
 203                       expression
 204   | SizeOfExpr     of string mcode (* sizeof *) * expression
 205   | SizeOfType     of string mcode (* sizeof *) * string mcode (* ( *) *
 206                       fullType * string mcode (* ) *)
 207   | TypeExp        of fullType (*type name used as an expression, only in
 208                                   arg or #define*)
 209
 210   | Paren          of string mcode (* ( *) * expression *
 211                       string mcode (* ) *)
 212
 213   | MetaErr        of meta_name mcode * constraints * keep_binding *
 214                       inherited
 215   | MetaExpr       of meta_name mcode * constraints * keep_binding *
 216                       Type_cocci.typeC list option * form * inherited
 217   | MetaExprList   of meta_name mcode * listlen * keep_binding *
 218                       inherited (* only in arg lists *)
 219
 220   | EComma         of string mcode (* only in arg lists *)
 221
 222   | DisjExpr       of expression list
 223   | NestExpr       of string mcode (* <.../<+... *) *
 224                       expression dots *
 225                       string mcode (* ...>/...+> *) *
 226                       expression option * multi
 227
 228   (* can appear in arg lists, and also inside Nest, as in:
 229    if(< ... X ... Y ...>)
 230    In the following, the expression option is the WHEN  *)
 231   | Edots          of string mcode (* ... *) * expression option
 232   | Ecircles       of string mcode (* ooo *) * expression option
 233   | Estars         of string mcode (* *** *) * expression option
 234
 235   | OptExp         of expression
 236   | UniqueExp      of expression
 237
 238 and constraints =
 239     NoConstraint
 240   | NotIdCstrt     of reconstraint
 241   | NotExpCstrt    of expression list
 242   | SubExpCstrt    of meta_name list
 243
 244 (* Constraints on Meta-* Identifiers, Functions *)
 245 and idconstraint =
 246     IdNoConstraint
 247   | IdNegIdSet         of string list * meta_name list
 248   | IdRegExpConstraint of reconstraint
 249
 250 and reconstraint =
 251   | IdRegExp        of string * Str.regexp
 252   | IdNotRegExp     of string * Str.regexp
 253
 254 (* ANY = int E; ID = idexpression int X; CONST = constant int X; *)
 255 and form = ANY | ID | LocalID | CONST (* form for MetaExp *)
 256
 257 and expression = base_expression wrap
 258
 259 and listlen =
 260     MetaListLen of meta_name mcode * keep_binding * inherited
 261   | CstListLen of int
 262   | AnyListLen
 263
 264 and  unaryOp = GetRef | DeRef | UnPlus |  UnMinus | Tilde | Not
 265 and  assignOp = SimpleAssign | OpAssign of arithOp
 266 and  fixOp = Dec | Inc
 267
 268 and  binaryOp = Arith of arithOp | Logical of logicalOp
 269 and  arithOp =
 270     Plus | Minus | Mul | Div | Mod | DecLeft | DecRight | And | Or | Xor
 271 and  logicalOp = Inf | Sup | InfEq | SupEq | Eq | NotEq | AndLog | OrLog
 272
 273 and constant =
 274     String of string
 275   | Char   of string
 276   | Int    of string
 277   | Float  of string
 278
 279 (* --------------------------------------------------------------------- *)
 280 (* Types *)
 281
 282 and base_fullType =
 283     Type            of const_vol mcode option * typeC
 284   | DisjType        of fullType list (* only after iso *)
 285   | OptType         of fullType
 286   | UniqueType      of fullType
 287
 288 and base_typeC =
 289     BaseType        of baseType * string mcode list (* Yoann style *)
 290   | SignedT         of sign mcode * typeC option
 291   | Pointer         of fullType * string mcode (* * *)
 292   | FunctionPointer of fullType *
 293                   string mcode(* ( *)*string mcode(* * *)*string mcode(* ) *)*
 294                   string mcode (* ( *)*parameter_list*string mcode(* ) *)
 295
 296   (* used for the automatic managment of prototypes *)
 297   | FunctionType     of bool (* true if all minus for dropping return type *) *
 298                    fullType option *
 299                    string mcode (* ( *) * parameter_list *
 300                    string mcode (* ) *)
 301
 302   | Array           of fullType * string mcode (* [ *) *
 303                        expression option * string mcode (* ] *)
 304   | EnumName        of string mcode (*enum*) * ident option (* name *)
 305   | EnumDef  of fullType (* either EnumName or metavar *) *
 306         string mcode (* { *) * expression dots * string mcode (* } *)
 307   | StructUnionName of structUnion mcode * ident option (* name *)
 308   | StructUnionDef  of fullType (* either StructUnionName or metavar *) *
 309         string mcode (* { *) * declaration dots * string mcode (* } *)
 310   | TypeName        of string mcode (* pad: should be 'of ident' ? *)
 311
 312   | MetaType        of meta_name mcode * keep_binding * inherited
 313
 314 and fullType = base_fullType wrap
 315 and typeC = base_typeC wrap
 316
 317 and baseType = VoidType | CharType | ShortType | IntType | DoubleType
 318   | FloatType | LongType | LongLongType | SizeType | SSizeType | PtrDiffType
 319
 320 and structUnion = Struct | Union
 321
 322 and sign = Signed | Unsigned
 323
 324 and const_vol = Const | Volatile
 325
 326 (* --------------------------------------------------------------------- *)
 327 (* Variable declaration *)
 328 (* Even if the Cocci program specifies a list of declarations, they are
 329    split out into multiple declarations of a single variable each. *)
 330
 331 and base_declaration =
 332     Init of storage mcode option * fullType * ident * string mcode (*=*) *
 333         initialiser * string mcode (*;*)
 334   | UnInit of storage mcode option * fullType * ident * string mcode (* ; *)
 335   | TyDecl of fullType * string mcode (* ; *)
 336   | MacroDecl of ident (* name *) * string mcode (* ( *) *
 337         expression dots * string mcode (* ) *) * string mcode (* ; *)
 338   | Typedef of string mcode (*typedef*) * fullType *
 339                typeC (* either TypeName or metavar *) * string mcode (*;*)
 340   | DisjDecl of declaration list
 341   (* Ddots is for a structure declaration *)
 342   | Ddots    of string mcode (* ... *) * declaration option (* whencode *)
 343
 344   | MetaDecl of meta_name mcode * keep_binding * inherited
 345   | MetaField of meta_name mcode * keep_binding * inherited
 346
 347   | OptDecl    of declaration
 348   | UniqueDecl of declaration
 349
 350 and declaration = base_declaration wrap
 351
 352 (* --------------------------------------------------------------------- *)
 353 (* Initializers *)
 354
 355 and base_initialiser =
 356     MetaInit of meta_name mcode * keep_binding * inherited
 357   | InitExpr of expression
 358   | ArInitList of string mcode (*{*) * initialiser dots * string mcode (*}*)
 359   | StrInitList of bool (* true if all are - *) *
 360         string mcode (*{*) * initialiser list * string mcode (*}*) *
 361         initialiser list (* whencode: elements that shouldn't appear in init *)
 362   | InitGccExt of
 363       designator list (* name *) * string mcode (*=*) *
 364         initialiser (* gccext: *)
 365   | InitGccName of ident (* name *) * string mcode (*:*) *
 366         initialiser
 367   | IComma of string mcode (* , *)
 368   | Idots  of string mcode (* ... *) * initialiser option (* whencode *)
 369
 370   | OptIni    of initialiser
 371   | UniqueIni of initialiser
 372
 373 and designator =
 374     DesignatorField of string mcode (* . *) * ident
 375   | DesignatorIndex of string mcode (* [ *) * expression * string mcode (* ] *)
 376   | DesignatorRange of
 377       string mcode (* [ *) * expression * string mcode (* ... *) *
 378       expression * string mcode (* ] *)
 379
 380 and initialiser = base_initialiser wrap
 381
 382 (* --------------------------------------------------------------------- *)
 383 (* Parameter *)
 384
 385 and base_parameterTypeDef =
 386     VoidParam     of fullType
 387   | Param         of fullType * ident option
 388
 389   | MetaParam     of meta_name mcode * keep_binding * inherited
 390   | MetaParamList of meta_name mcode * listlen * keep_binding * inherited
 391
 392   | PComma        of string mcode
 393
 394   | Pdots         of string mcode (* ... *)
 395   | Pcircles      of string mcode (* ooo *)
 396
 397   | OptParam      of parameterTypeDef
 398   | UniqueParam   of parameterTypeDef
 399
 400 and parameterTypeDef = base_parameterTypeDef wrap
 401
 402 and parameter_list = parameterTypeDef dots
 403
 404 (* --------------------------------------------------------------------- *)
 405 (* #define Parameters *)
 406
 407 and base_define_param =
 408     DParam        of ident
 409   | DPComma       of string mcode
 410   | DPdots        of string mcode (* ... *)
 411   | DPcircles     of string mcode (* ooo *)
 412   | OptDParam     of define_param
 413   | UniqueDParam  of define_param
 414
 415 and define_param = base_define_param wrap
 416
 417 and base_define_parameters =
 418     NoParams     (* not parameter list, not an empty one *)
 419   | DParams      of string mcode(*( *) * define_param dots * string mcode(* )*)
 420
 421 and define_parameters = base_define_parameters wrap
 422
 423 (* --------------------------------------------------------------------- *)
 424 (* positions *)
 425
 426 (* PER = keep bindings separate, ALL = collect them *)
 427 and meta_collect = PER | ALL
 428
 429 and meta_pos =
 430     MetaPos of meta_name mcode * meta_name list *
 431         meta_collect * keep_binding * inherited
 432   | NoMetaPos
 433
 434 (* --------------------------------------------------------------------- *)
 435 (* Function declaration *)
 436
 437 and storage = Static | Auto | Register | Extern
 438
 439 (* --------------------------------------------------------------------- *)
 440 (* Top-level code *)
 441
 442 and base_rule_elem =
 443     FunHeader     of mcodekind (* before the function header *) *
 444                      bool (* true if all minus, for dropping static, etc *) *
 445                      fninfo list * ident (* name *) *
 446                      string mcode (* ( *) * parameter_list *
 447                      string mcode (* ) *)
 448   | Decl          of mcodekind (* before the decl *) *
 449                      bool (* true if all minus *) * declaration
 450
 451   | SeqStart      of string mcode (* { *)
 452   | SeqEnd        of string mcode (* } *)
 453
 454   | ExprStatement of expression * string mcode (*;*)
 455   | IfHeader      of string mcode (* if *) * string mcode (* ( *) *
 456                      expression * string mcode (* ) *)
 457   | Else          of string mcode (* else *)
 458   | WhileHeader   of string mcode (* while *) * string mcode (* ( *) *
 459                      expression * string mcode (* ) *)
 460   | DoHeader      of string mcode (* do *)
 461   | WhileTail     of string mcode (* while *) * string mcode (* ( *) *
 462                      expression * string mcode (* ) *) *
 463                      string mcode (* ; *)
 464   | ForHeader     of string mcode (* for *) * string mcode (* ( *) *
 465                      expression option * string mcode (*;*) *
 466                      expression option * string mcode (*;*) *
 467                      expression option * string mcode (* ) *)
 468   | IteratorHeader of ident (* name *) * string mcode (* ( *) *
 469                      expression dots * string mcode (* ) *)
 470   | SwitchHeader  of string mcode (* switch *) * string mcode (* ( *) *
 471                      expression * string mcode (* ) *)
 472   | Break         of string mcode (* break *) * string mcode (* ; *)
 473   | Continue      of string mcode (* continue *) * string mcode (* ; *)
 474   | Label         of ident * string mcode (* : *)
 475   | Goto          of string mcode (* goto *) * ident * string mcode (* ; *)
 476   | Return        of string mcode (* return *) * string mcode (* ; *)
 477   | ReturnExpr    of string mcode (* return *) * expression *
 478                      string mcode (* ; *)
 479
 480   | MetaRuleElem  of meta_name mcode * keep_binding * inherited
 481   | MetaStmt      of meta_name mcode * keep_binding * metaStmtInfo *
 482                      inherited
 483   | MetaStmtList  of meta_name mcode * keep_binding * inherited
 484
 485   | Exp           of expression (* matches a subterm *)
 486   | TopExp        of expression (* for macros body, exp at top level,
 487                                    not subexp *)
 488   | Ty            of fullType (* only at SP top level, matches a subterm *)
 489   | TopInit       of initialiser (* only at top level *)
 490   | Include       of string mcode (*#include*) * inc_file mcode (*file *)
 491   | DefineHeader  of string mcode (* #define *) * ident (* name *) *
 492                      define_parameters (*params*)
 493   | Case          of string mcode (* case *) * expression * string mcode (*:*)
 494   | Default       of string mcode (* default *) * string mcode (*:*)
 495   | DisjRuleElem  of rule_elem list
 496
 497 and fninfo =
 498     FStorage of storage mcode
 499   | FType of fullType
 500   | FInline of string mcode
 501   | FAttr of string mcode
 502
 503 and metaStmtInfo =
 504     NotSequencible | SequencibleAfterDots of dots_whencode list | Sequencible
 505
 506 and rule_elem = base_rule_elem wrap
 507
 508 and base_statement =
 509     Seq           of rule_elem (* { *) *
 510                      statement dots * rule_elem (* } *)
 511   | IfThen        of rule_elem (* header *) * statement * end_info (* endif *)
 512   | IfThenElse    of rule_elem (* header *) * statement *
 513                      rule_elem (* else *) * statement * end_info (* endif *)
 514   | While         of rule_elem (* header *) * statement * end_info (*endwhile*)
 515   | Do            of rule_elem (* do *) * statement * rule_elem (* tail *)
 516   | For           of rule_elem (* header *) * statement * end_info (*endfor*)
 517   | Iterator      of rule_elem (* header *) * statement * end_info (*enditer*)
 518   | Switch        of rule_elem (* header *) * rule_elem (* { *) *
 519                      statement (*decl*) dots * case_line list * rule_elem(*}*)
 520   | Atomic        of rule_elem
 521   | Disj          of statement dots list
 522   | Nest          of string mcode (* <.../<+... *) * statement dots *
 523                      string mcode (* ...>/...+> *) *
 524                      (statement dots,statement) whencode list * multi *
 525                      dots_whencode list * dots_whencode list
 526   | FunDecl       of rule_elem (* header *) * rule_elem (* { *) *
 527                      statement dots * rule_elem (* } *)
 528   | Define        of rule_elem (* header *) * statement dots
 529   | Dots          of string mcode (* ... *) *
 530                      (statement dots,statement) whencode list *
 531                      dots_whencode list * dots_whencode list
 532   | Circles       of string mcode (* ooo *) *
 533                      (statement dots,statement) whencode list *
 534                      dots_whencode list * dots_whencode list
 535   | Stars         of string mcode (* *** *) *
 536                      (statement dots,statement) whencode list *
 537                      dots_whencode list * dots_whencode list
 538   | OptStm        of statement
 539   | UniqueStm     of statement
 540
 541 and ('a,'b) whencode =
 542     WhenNot of 'a
 543   | WhenAlways of 'b
 544   | WhenModifier of when_modifier
 545   | WhenNotTrue of rule_elem (* useful for fvs *)
 546   | WhenNotFalse of rule_elem
 547
 548 and when_modifier =
 549   (* The following removes the shortest path constraint.  It can be used
 550      with other when modifiers *)
 551     WhenAny
 552   (* The following removes the special consideration of error paths.  It
 553      can be used with other when modifiers *)
 554   | WhenStrict
 555   | WhenForall
 556   | WhenExists
 557
 558 (* only used with asttoctl *)
 559 and dots_whencode =
 560     WParen of rule_elem * meta_name (*pren_var*)
 561   | Other of statement
 562   | Other_dots of statement dots
 563
 564 and statement = base_statement wrap
 565
 566 and base_case_line =
 567     CaseLine of rule_elem (* case/default header *) * statement dots
 568   | OptCase of case_line
 569
 570 and case_line = base_case_line wrap
 571
 572 and inc_file =
 573     Local of inc_elem list
 574   | NonLocal of inc_elem list
 575
 576 and inc_elem =
 577     IncPath of string
 578   | IncDots
 579
 580 and base_top_level =
 581     DECL of statement
 582   | CODE of statement dots
 583   | FILEINFO of string mcode (* old file *) * string mcode (* new file *)
 584   | ERRORWORDS of expression list
 585
 586 and top_level = base_top_level wrap
 587
 588 and rulename =
 589     CocciRulename of string option * dependency *
 590         string list * string list * exists * bool
 591   | GeneratedRulename of string option * dependency *
 592         string list * string list * exists * bool
 593   | ScriptRulename of string option (* name *) * string (* language *) *
 594         dependency
 595   | InitialScriptRulename of string option (* name *) * string (* language *) *
 596         dependency
 597   | FinalScriptRulename of string option (* name *) * string (* language *) *
 598         dependency
 599
 600 and ruletype = Normal | Generated
 601
 602 and rule =
 603     CocciRule of string (* name *) *
 604         (dependency * string list (* dropped isos *) * exists) * top_level list
 605         * bool list * ruletype
 606   | ScriptRule of string (* name *) *
 607       (* metaname for python (untyped), metavar for ocaml (typed) *)
 608       string * dependency *
 609         (script_meta_name * meta_name * metavar) list (*inherited vars*) *
 610         meta_name list (*script vars*) * string
 611   | InitialScriptRule of  string (* name *) *
 612         string (*language*) * dependency * string (*code*)
 613   | FinalScriptRule of  string (* name *) *
 614         string (*language*) * dependency * string (*code*)
 615
 616 and script_meta_name = string option (*string*) * string option (*ast*)
 617
 618 and dependency =
 619     Dep of string (* rule applies for the current binding *)
 620   | AntiDep of string (* rule doesn't apply for the current binding *)
 621   | EverDep of string (* rule applies for some binding *)
 622   | NeverDep of string (* rule never applies for any binding *)
 623   | AndDep of dependency * dependency
 624   | OrDep of dependency * dependency
 625   | NoDep | FailDep
 626
 627 and rule_with_metavars = metavar list * rule
 628
 629 and anything =
 630     FullTypeTag         of fullType
 631   | BaseTypeTag         of baseType
 632   | StructUnionTag      of structUnion
 633   | SignTag             of sign
 634   | IdentTag            of ident
 635   | ExpressionTag       of expression
 636   | ConstantTag         of constant
 637   | UnaryOpTag          of unaryOp
 638   | AssignOpTag         of assignOp
 639   | FixOpTag            of fixOp
 640   | BinaryOpTag         of binaryOp
 641   | ArithOpTag          of arithOp
 642   | LogicalOpTag        of logicalOp
 643   | DeclarationTag      of declaration
 644   | InitTag             of initialiser
 645   | StorageTag          of storage
 646   | IncFileTag          of inc_file
 647   | Rule_elemTag        of rule_elem
 648   | StatementTag        of statement
 649   | CaseLineTag         of case_line
 650   | ConstVolTag         of const_vol
 651   | Token               of string * info option
 652   | Pragma              of added_string list
 653   | Code                of top_level
 654   | ExprDotsTag         of expression dots
 655   | ParamDotsTag        of parameterTypeDef dots
 656   | StmtDotsTag         of statement dots
 657   | DeclDotsTag         of declaration dots
 658   | TypeCTag            of typeC
 659   | ParamTag            of parameterTypeDef
 660   | SgrepStartTag       of string
 661   | SgrepEndTag         of string
 662
 663 (* --------------------------------------------------------------------- *)
 664
 665 and exists = Exists | Forall | Undetermined
 666 (* | ReverseForall - idea: look back on all flow paths; not implemented *)
 667
 668 (* --------------------------------------------------------------------- *)
 669
 670 let mkToken x = Token (x,None)
 671
 672 (* --------------------------------------------------------------------- *)
 673
 674 let lub_count i1 i2 =
 675   match (i1,i2) with
 676     (MANY,MANY) -> MANY
 677   | _ -> ONE
 678
 679 (* --------------------------------------------------------------------- *)
 680
 681 let rewrap model x         = {model with node = x}
 682 let rewrap_mcode (_,a,b,c) x = (x,a,b,c)
 683 let unwrap x               = x.node
 684 let unwrap_mcode (x,_,_,_)  = x
 685 let get_mcodekind (_,_,x,_) = x
 686 let get_line x             = x.node_line
 687 let get_mcode_line (_,l,_,_) = l.line
 688 let get_mcode_col (_,l,_,_)  = l.column
 689 let get_fvs x              = x.free_vars
 690 let set_fvs fvs x          = {x with free_vars = fvs}
 691 let get_mfvs x             = x.minus_free_vars
 692 let set_mfvs mfvs x        = {x with minus_free_vars = mfvs}
 693 let get_fresh x            = x.fresh_vars
 694 let get_inherited x        = x.inherited
 695 let get_saved x            = x.saved_witness
 696 let get_dots_bef_aft x     = x.bef_aft
 697 let set_dots_bef_aft d x   = {x with bef_aft = d}
 698 let get_pos x              = x.pos_info
 699 let set_pos x pos          = {x with pos_info = pos}
 700 let get_test_exp x      = x.true_if_test_exp
 701 let set_test_exp x      = {x with true_if_test_exp = true}
 702 let get_isos x             = x.iso_info
 703 let set_isos x isos        = {x with iso_info = isos}
 704 let get_pos_var (_,_,_,p)  = p
 705 let set_pos_var vr (a,b,c,_) = (a,b,c,vr)
 706 let drop_pos (a,b,c,_)     = (a,b,c,NoMetaPos)
 707
 708 let get_wcfvs (whencode : ('a wrap, 'b wrap) whencode list) =
 709   Common.union_all
 710     (List.map
 711        (function
 712            WhenNot(a) -> get_fvs a
 713          | WhenAlways(a) -> get_fvs a
 714          | WhenModifier(_) -> []
 715          | WhenNotTrue(e) -> get_fvs e
 716          | WhenNotFalse(e) -> get_fvs e)
 717        whencode)
 718
 719 (* --------------------------------------------------------------------- *)
 720
 721 let get_meta_name = function
 722     MetaIdDecl(ar,nm) -> nm
 723   | MetaFreshIdDecl(nm,seed) -> nm
 724   | MetaTypeDecl(ar,nm) -> nm
 725   | MetaInitDecl(ar,nm) -> nm
 726   | MetaListlenDecl(nm) -> nm
 727   | MetaParamDecl(ar,nm) -> nm
 728   | MetaParamListDecl(ar,nm,nm1) -> nm
 729   | MetaConstDecl(ar,nm,ty) -> nm
 730   | MetaErrDecl(ar,nm) -> nm
 731   | MetaExpDecl(ar,nm,ty) -> nm
 732   | MetaIdExpDecl(ar,nm,ty) -> nm
 733   | MetaLocalIdExpDecl(ar,nm,ty) -> nm
 734   | MetaExpListDecl(ar,nm,nm1) -> nm
 735   | MetaDeclDecl(ar,nm) -> nm
 736   | MetaFieldDecl(ar,nm) -> nm
 737   | MetaStmDecl(ar,nm) -> nm
 738   | MetaStmListDecl(ar,nm) -> nm
 739   | MetaFuncDecl(ar,nm) -> nm
 740   | MetaLocalFuncDecl(ar,nm) -> nm
 741   | MetaPosDecl(ar,nm) -> nm
 742   | MetaDeclarerDecl(ar,nm) -> nm
 743   | MetaIteratorDecl(ar,nm) -> nm
 744
 745 (* --------------------------------------------------------------------- *)
 746
 747 and tag2c = function
 748     FullTypeTag _ -> "FullTypeTag"
 749   | BaseTypeTag _ -> "BaseTypeTag"
 750   | StructUnionTag _ -> "StructUnionTag"
 751   | SignTag _ -> "SignTag"
 752   | IdentTag _ -> "IdentTag"
 753   | ExpressionTag _ -> "ExpressionTag"
 754   | ConstantTag _ -> "ConstantTag"
 755   | UnaryOpTag _ -> "UnaryOpTag"
 756   | AssignOpTag _ -> "AssignOpTag"
 757   | FixOpTag _ -> "FixOpTag"
 758   | BinaryOpTag _ -> "BinaryOpTag"
 759   | ArithOpTag _ -> "ArithOpTag"
 760   | LogicalOpTag _ -> "LogicalOpTag"
 761   | DeclarationTag _ -> "DeclarationTag"
 762   | InitTag _ -> "InitTag"
 763   | StorageTag _ -> "StorageTag"
 764   | IncFileTag _ -> "IncFileTag"
 765   | Rule_elemTag _ -> "Rule_elemTag"
 766   | StatementTag _ -> "StatementTag"
 767   | CaseLineTag _ -> "CaseLineTag"
 768   | ConstVolTag _ -> "ConstVolTag"
 769   | Token _ -> "Token"
 770   | Pragma _ -> "Pragma"
 771   | Code _ -> "Code"
 772   | ExprDotsTag _ -> "ExprDotsTag"
 773   | ParamDotsTag _ -> "ParamDotsTag"
 774   | StmtDotsTag _ -> "StmtDotsTag"
 775   | DeclDotsTag _ -> "DeclDotsTag"
 776   | TypeCTag _ -> "TypeCTag"
 777   | ParamTag _ -> "ParamTag"
 778   | SgrepStartTag _ -> "SgrepStartTag"
 779   | SgrepEndTag _ -> "SgrepEndTag"
 780
 781 (* --------------------------------------------------------------------- *)
 782
 783 let no_info = { line = 0; column = -1; strbef = []; straft = [] }
 784
 785 let make_term x =
 786   {node = x;
 787     node_line = 0;
 788     free_vars = [];
 789     minus_free_vars = [];
 790     fresh_vars = [];
 791     inherited = [];
 792     saved_witness = [];
 793     bef_aft = NoDots;
 794     pos_info = None;
 795     true_if_test_exp = false;
 796     iso_info = [] }
 797
 798 let make_meta_rule_elem s d (fvs,fresh,inh) =
 799   let rule = "" in
 800   {(make_term
 801       (MetaRuleElem(((rule,s),no_info,d,NoMetaPos),Type_cocci.Unitary,false)))
 802   with free_vars = fvs; fresh_vars = fresh; inherited = inh}
 803
 804 let make_meta_decl s d (fvs,fresh,inh) =
 805   let rule = "" in
 806   {(make_term
 807       (MetaDecl(((rule,s),no_info,d,NoMetaPos),Type_cocci.Unitary,false))) with
 808     free_vars = fvs; fresh_vars = fresh; inherited = inh}
 809
 810 let make_mcode x = (x,no_info,CONTEXT(NoPos,NOTHING),NoMetaPos)
 811
 812 (* --------------------------------------------------------------------- *)
 813
 814 let equal_pos x y = x = y
 815
 816 (* --------------------------------------------------------------------- *)
 817
 818 let undots x =
 819   match unwrap x with
 820     DOTS    e -> e
 821   | CIRCLES e -> e
 822   | STARS   e -> e