parsing_cocci/ast_cocci.ml

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