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