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