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