parsing_cocci/ast_cocci.ml

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