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