parsing_cocci/ast_cocci.ml

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