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