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