Release coccinelle-0.1.8
[bpt/coccinelle.git] / parsing_cocci / ast_cocci.ml
index a98a8dc..0d9bd39 100644 (file)
@@ -1,5 +1,5 @@
 (*
-* Copyright 2005-2008, Ecole des Mines de Nantes, University of Copenhagen
+* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
 * This file is part of Coccinelle.
 * 
@@ -24,7 +24,8 @@
 (* Modified code *)
 
 type info = { line : int; column : int;
-             strbef : string list; straft : string list }
+             strbef : (string * int (* line *) * int (* col *)) list;
+             straft : (string * int (* line *) * int (* col *)) list }
 type line = int
 type meta_name = string * string
 (* need to be careful about rewrapping, to avoid duplicating pos info
@@ -34,7 +35,7 @@ type 'a wrap =
       node_line : line;
       free_vars : meta_name list; (*free vars*)
       minus_free_vars : meta_name list; (*minus free vars*)
-      fresh_vars : meta_name list; (*fresh vars*)
+      fresh_vars : (meta_name * string (*seed*) option) list; (*fresh vars*)
       inherited : meta_name list; (*inherited vars*)
       saved_witness : meta_name list; (*witness vars*)
       bef_aft : dots_bef_aft;
@@ -53,8 +54,11 @@ and 'a befaft =
 and 'a mcode = 'a * info * mcodekind * meta_pos (* pos variable *)
  (* pos is an offset indicating where in the C code the mcodekind has an
  effect *)
+(* int list is the match instances, which are only meaningful in annotated
+C code *)
+(* int is the adjacency index, which is incremented on context dots *)
  and mcodekind =
-    MINUS       of pos * anything list list
+    MINUS       of pos * int list * int * anything list list
   | CONTEXT     of pos * anything befaft
   | PLUS
  and fixpos =
@@ -71,8 +75,8 @@ and keep_binding = Type_cocci.keep_binding
 and multi = bool (*true if a nest is one or more, false if it is zero or more*)
 
 and end_info =
-    meta_name list (*free vars*) * meta_name list (*inherited vars*) *
-      meta_name list (*witness vars*) * mcodekind
+    meta_name list (*free vars*) * (meta_name * string option) list (*fresh*) *
+      meta_name list (*inherited vars*) * mcodekind
 
 (* --------------------------------------------------------------------- *)
 (* Metavariables *)
@@ -81,8 +85,9 @@ and arity = UNIQUE | OPT | MULTI | NONE
 
 and metavar =
     MetaIdDecl of arity * meta_name (* name *)
-  | MetaFreshIdDecl of arity * meta_name (* name *)
+  | MetaFreshIdDecl of meta_name (* name *) * string option (* seed *)
   | MetaTypeDecl of arity * meta_name (* name *)
+  | MetaInitDecl of arity * meta_name (* name *)
   | MetaListlenDecl of meta_name (* name *)
   | MetaParamDecl of arity * meta_name (* name *)
   | MetaParamListDecl of arity * meta_name (*name*) * meta_name option (*len*)
@@ -133,7 +138,7 @@ and ident = base_ident wrap
 (* --------------------------------------------------------------------- *)
 (* Expression *)
 
-and base_expression = 
+and base_expression =
     Ident          of ident
   | Constant       of constant mcode
   | FunCall        of expression * string mcode (* ( *) *
@@ -215,9 +220,9 @@ and base_fullType =
   | OptType         of fullType
   | UniqueType      of fullType
 
-and base_typeC = 
-    BaseType        of baseType mcode * sign mcode option
-  | ImplicitInt     of sign mcode
+and base_typeC =
+    BaseType        of baseType * string mcode list (* Yoann style *)
+  | SignedT         of sign mcode * typeC option
   | Pointer         of fullType * string mcode (* * *)
   | FunctionPointer of fullType *
                  string mcode(* ( *)*string mcode(* * *)*string mcode(* ) *)*
@@ -231,18 +236,19 @@ and base_typeC =
 
   | Array           of fullType * string mcode (* [ *) *
                       expression option * string mcode (* ] *)
+  | EnumName        of string mcode (*enum*) * ident (* name *)
   | StructUnionName of structUnion mcode * ident option (* name *)
   | StructUnionDef  of fullType (* either StructUnionName or metavar *) *
        string mcode (* { *) * declaration dots * string mcode (* } *)
-  | TypeName        of string mcode
+  | TypeName        of string mcode (* pad: should be 'of ident' ? *)
 
   | MetaType        of meta_name mcode * keep_binding * inherited
 
 and fullType = base_fullType wrap
 and typeC = base_typeC wrap
-     
+
 and baseType = VoidType | CharType | ShortType | IntType | DoubleType
-| FloatType | LongType
+  | FloatType | LongType | LongLongType
 
 and structUnion = Struct | Union
 
@@ -262,7 +268,7 @@ and base_declaration =
   | TyDecl of fullType * string mcode (* ; *)
   | MacroDecl of ident (* name *) * string mcode (* ( *) *
         expression dots * string mcode (* ) *) * string mcode (* ; *)
-  | Typedef of string mcode (*typedef*) * fullType * 
+  | Typedef of string mcode (*typedef*) * fullType *
                typeC (* either TypeName or metavar *) * string mcode (*;*)
   | DisjDecl of declaration list
   (* Ddots is for a structure declaration *)
@@ -279,25 +285,27 @@ and declaration = base_declaration wrap
 (* Initializers *)
 
 and base_initialiser =
-    InitExpr of expression 
+    MetaInit of meta_name mcode * keep_binding * inherited
+  | InitExpr of expression
   | InitList of string mcode (*{*) * initialiser list * string mcode (*}*) *
        initialiser list (* whencode: elements that shouldn't appear in init *)
-  | InitGccDotName of
-      string mcode (*.*) * ident (* name *) * string mcode (*=*) *
+  | InitGccExt of
+      designator list (* name *) * string mcode (*=*) *
        initialiser (* gccext: *)
   | InitGccName of ident (* name *) * string mcode (*:*) *
        initialiser
-  | InitGccIndex of
-      string mcode (*[*) * expression * string mcode (*]*) *
-       string mcode (*=*) * initialiser
-  | InitGccRange of
-      string mcode (*[*) * expression * string mcode (*...*) *
-        expression * string mcode (*]*) * string mcode (*=*) * initialiser
   | IComma of string mcode (* , *)
 
   | OptIni    of initialiser
   | UniqueIni of initialiser
 
+and designator =
+    DesignatorField of string mcode (* . *) * ident
+  | DesignatorIndex of string mcode (* [ *) * expression * string mcode (* ] *)
+  | DesignatorRange of
+      string mcode (* [ *) * expression * string mcode (* ... *) *
+      expression * string mcode (* ] *)
+
 and initialiser = base_initialiser wrap
 
 (* --------------------------------------------------------------------- *)
@@ -408,6 +416,7 @@ and base_rule_elem =
   | TopExp        of expression (* for macros body, exp at top level,
                                   not subexp *)
   | Ty            of fullType (* only at SP top level, matches a subterm *)
+  | TopInit       of initialiser (* only at top level *)
   | Include       of string mcode (*#include*) * inc_file mcode (*file *)
   | DefineHeader  of string mcode (* #define *) * ident (* name *) *
                     define_parameters (*params*)
@@ -427,7 +436,7 @@ and metaStmtInfo =
 and rule_elem = base_rule_elem wrap
 
 and base_statement =
-    Seq           of rule_elem (* { *) * statement dots *
+    Seq           of rule_elem (* { *) *
                     statement dots * rule_elem (* } *)
   | IfThen        of rule_elem (* header *) * statement * end_info (* endif *)
   | IfThenElse    of rule_elem (* header *) * statement *
@@ -444,7 +453,7 @@ and base_statement =
                     (statement dots,statement) whencode list * multi *
                     dots_whencode list * dots_whencode list
   | FunDecl       of rule_elem (* header *) * rule_elem (* { *) *
-                    statement dots * statement dots * rule_elem (* } *)
+                    statement dots * rule_elem (* } *)
   | Define        of rule_elem (* header *) * statement dots
   | Dots          of string mcode (* ... *) *
                     (statement dots,statement) whencode list *
@@ -462,6 +471,8 @@ and ('a,'b) whencode =
     WhenNot of 'a
   | WhenAlways of 'b
   | WhenModifier of when_modifier
+  | WhenNotTrue of rule_elem (* useful for fvs *)
+  | WhenNotFalse of rule_elem
 
 and when_modifier =
   (* The following removes the shortest path constraint.  It can be used
@@ -506,13 +517,21 @@ and top_level = base_top_level wrap
 and rulename =
     CocciRulename of string option * dependency *
        string list * string list * exists * bool
+  | GeneratedRulename of string option * dependency *
+       string list * string list * exists * bool
   | ScriptRulename of string * dependency
+  | InitialScriptRulename of string
+  | FinalScriptRulename of string
+
+and ruletype = Normal | Generated
 
 and rule =
-    CocciRule of string (* name *) * 
+    CocciRule of string (* name *) *
        (dependency * string list (* dropped isos *) * exists) * top_level list
-       * bool list
+       * bool list * ruletype
   | ScriptRule of string * dependency * (string * meta_name) list * string
+  | InitialScriptRule of string (*language*) * string (*code*)
+  | FinalScriptRule of string (*language*) * string (*code*)
 
 and dependency =
     Dep of string (* rule applies for the current binding *)
@@ -548,6 +567,7 @@ and anything =
   | CaseLineTag         of case_line
   | ConstVolTag         of const_vol
   | Token               of string * info option
+  | Pragma              of string list
   | Code                of top_level
   | ExprDotsTag         of expression dots
   | ParamDotsTag        of parameterTypeDef dots
@@ -575,6 +595,7 @@ let unwrap_mcode (x,_,_,_)  = x
 let get_mcodekind (_,_,x,_) = x
 let get_line x             = x.node_line
 let get_mcode_line (_,l,_,_) = l.line
+let get_mcode_col (_,l,_,_)  = l.column
 let get_fvs x              = x.free_vars
 let set_fvs fvs x          = {x with free_vars = fvs}
 let get_mfvs x             = x.minus_free_vars
@@ -600,15 +621,18 @@ let get_wcfvs (whencode : ('a wrap, 'b wrap) whencode list) =
        (function
           WhenNot(a) -> get_fvs a
         | WhenAlways(a) -> get_fvs a
-        | WhenModifier(_) -> [])
+        | WhenModifier(_) -> []
+        | WhenNotTrue(e) -> get_fvs e
+        | WhenNotFalse(e) -> get_fvs e)
        whencode)
 
 (* --------------------------------------------------------------------- *)
 
 let get_meta_name = function
     MetaIdDecl(ar,nm) -> nm
-  | MetaFreshIdDecl(ar,nm) -> nm
+  | MetaFreshIdDecl(nm,seed) -> nm
   | MetaTypeDecl(ar,nm) -> nm
+  | MetaInitDecl(ar,nm) -> nm
   | MetaListlenDecl(nm) -> nm
   | MetaParamDecl(ar,nm) -> nm
   | MetaParamListDecl(ar,nm,nm1) -> nm
@@ -628,7 +652,43 @@ let get_meta_name = function
 
 (* --------------------------------------------------------------------- *)
 
-let no_info = { line = 0; column = 0; strbef = []; straft = [] }
+and tag2c = function
+    FullTypeTag _ -> "FullTypeTag"
+  | BaseTypeTag _ -> "BaseTypeTag"
+  | StructUnionTag _ -> "StructUnionTag"
+  | SignTag _ -> "SignTag"
+  | IdentTag _ -> "IdentTag"
+  | ExpressionTag _ -> "ExpressionTag"
+  | ConstantTag _ -> "ConstantTag"
+  | UnaryOpTag _ -> "UnaryOpTag"
+  | AssignOpTag _ -> "AssignOpTag"
+  | FixOpTag _ -> "FixOpTag"
+  | BinaryOpTag _ -> "BinaryOpTag"
+  | ArithOpTag _ -> "ArithOpTag"
+  | LogicalOpTag _ -> "LogicalOpTag"
+  | DeclarationTag _ -> "DeclarationTag"
+  | InitTag _ -> "InitTag"
+  | StorageTag _ -> "StorageTag"
+  | IncFileTag _ -> "IncFileTag"
+  | Rule_elemTag _ -> "Rule_elemTag"
+  | StatementTag _ -> "StatementTag"
+  | CaseLineTag _ -> "CaseLineTag"
+  | ConstVolTag _ -> "ConstVolTag"
+  | Token _ -> "Token"
+  | Pragma _ -> "Pragma"
+  | Code _ -> "Code"
+  | ExprDotsTag _ -> "ExprDotsTag"
+  | ParamDotsTag _ -> "ParamDotsTag"
+  | StmtDotsTag _ -> "StmtDotsTag"
+  | DeclDotsTag _ -> "DeclDotsTag"
+  | TypeCTag _ -> "TypeCTag"
+  | ParamTag _ -> "ParamTag"
+  | SgrepStartTag _ -> "SgrepStartTag"
+  | SgrepEndTag _ -> "SgrepEndTag"
+
+(* --------------------------------------------------------------------- *)
+
+let no_info = { line = 0; column = -1; strbef = []; straft = [] }
 
 let make_term x =
   {node = x;