Release coccinelle-0.2.5-rc2
[bpt/coccinelle.git] / parsing_cocci / ast0_cocci.ml
index 2f25376..f38cb00 100644 (file)
@@ -1,4 +1,29 @@
+(*
+ * Copyright 2010, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
+ * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
+
+
 module Ast = Ast_cocci
+module TC = Type_cocci
 
 (* --------------------------------------------------------------------- *)
 (* Modified code *)
@@ -44,7 +69,7 @@ and 'a wrap =
       info : info;
       index : int ref;
       mcodekind : mcodekind ref;
-      exp_ty : Type_cocci.typeC option ref; (* only for expressions *)
+      exp_ty : TC.typeC option ref; (* only for expressions *)
       bef_aft : dots_bef_aft; (* only for statements *)
       true_if_arg : bool; (* true if "arg_exp", only for exprs *)
       true_if_test : bool; (* true if "test position", only for exprs *)
@@ -118,7 +143,7 @@ and base_expression =
   | TypeExp        of typeC (* type name used as an expression, only in args *)
   | MetaErr        of Ast.meta_name mcode * constraints * pure
   | MetaExpr       of Ast.meta_name mcode * constraints *
-                     Type_cocci.typeC list option * Ast.form * pure
+                     TC.typeC list option * Ast.form * pure
   | MetaExprList   of Ast.meta_name mcode (* only in arg lists *) *
                      listlen * pure
   | EComma         of string mcode (* only in arg lists *)
@@ -161,7 +186,9 @@ and base_typeC =
                        string mcode (* ) *)
   | Array           of typeC * string mcode (* [ *) *
                       expression option * string mcode (* ] *)
-  | EnumName        of string mcode (*enum*) * ident (* name *)
+  | EnumName        of string mcode (*enum*) * ident option (* name *)
+  | EnumDef  of typeC (* either StructUnionName or metavar *) *
+       string mcode (* { *) * expression dots * string mcode (* } *)
   | StructUnionName of Ast.structUnion mcode * ident option (* name *)
   | StructUnionDef  of typeC (* either StructUnionName or metavar *) *
        string mcode (* { *) * declaration dots * string mcode (* } *)
@@ -207,7 +234,9 @@ and declaration = base_declaration wrap
 and base_initialiser =
     MetaInit of Ast.meta_name mcode * pure
   | InitExpr of expression
-  | InitList of string mcode (*{*) * initialiser_list * string mcode (*}*)
+  | InitList of string mcode (*{*) * initialiser_list * string mcode (*}*) *
+       (* true if ordered, as for array, false if unordered, as for struct *)
+       bool
   | InitGccExt of
       designator list (* name *) * string mcode (*=*) *
        initialiser (* gccext: *)
@@ -329,6 +358,7 @@ and base_statement =
        string mcode (* { *) * statement dots *
        string mcode (* } *)
   | Include of string mcode (* #include *) * Ast.inc_file mcode (* file *)
+  | Undef of string mcode (* #define *) * ident (* name *)
   | Define of string mcode (* #define *) * ident (* name *) *
        define_parameters (*params*) * statement dots
   | OptStm   of statement
@@ -451,6 +481,7 @@ let default_befaft _ =
   MIXED(ref (Ast.NOTHING,default_token_info,default_token_info))
 let context_befaft _ =
   CONTEXT(ref (Ast.NOTHING,default_token_info,default_token_info))
+let minus_befaft _ = MINUS(ref ([],default_token_info))
 
 let wrap x =
   { node = x;
@@ -528,79 +559,87 @@ let undots d =
 
 let rec ast0_type_to_type ty =
   match unwrap ty with
-    ConstVol(cv,ty) -> Type_cocci.ConstVol(const_vol cv,ast0_type_to_type ty)
+    ConstVol(cv,ty) -> TC.ConstVol(const_vol cv,ast0_type_to_type ty)
   | BaseType(bty,strings) ->
-      Type_cocci.BaseType(baseType bty)
+      TC.BaseType(baseType bty)
   | Signed(sgn,None) ->
-      Type_cocci.SignedT(sign sgn,None)
+      TC.SignedT(sign sgn,None)
   | Signed(sgn,Some ty) ->
       let bty = ast0_type_to_type ty in
-      Type_cocci.SignedT(sign sgn,Some bty)
-  | Pointer(ty,_) -> Type_cocci.Pointer(ast0_type_to_type ty)
+      TC.SignedT(sign sgn,Some bty)
+  | Pointer(ty,_) -> TC.Pointer(ast0_type_to_type ty)
   | FunctionPointer(ty,_,_,_,_,params,_) ->
-      Type_cocci.FunctionPointer(ast0_type_to_type ty)
+      TC.FunctionPointer(ast0_type_to_type ty)
   | FunctionType _ -> failwith "not supported"
-  | Array(ety,_,_,_) -> Type_cocci.Array(ast0_type_to_type ety)
-  | EnumName(su,tag) ->
+  | Array(ety,_,_,_) -> TC.Array(ast0_type_to_type ety)
+  | EnumName(su,Some tag) ->
       (match unwrap tag with
        Id(tag) ->
-         Type_cocci.EnumName(false,unwrap_mcode tag)
+         TC.EnumName(TC.Name(unwrap_mcode tag))
       | MetaId(tag,_,_) ->
          (Printf.printf
             "warning: enum with a metavariable name detected.\n";
           Printf.printf
             "For type checking assuming the name of the metavariable is the name of the type\n";
-          let (rule,tag) = unwrap_mcode tag in
-          Type_cocci.EnumName(true,rule^tag))
+          TC.EnumName(TC.MV(unwrap_mcode tag,TC.Unitary,false)))
       | _ -> failwith "unexpected enum type name")
+  | EnumName(su,None) -> failwith "nameless enum - what to do???"
+  | EnumDef(ty,_,_,_) -> ast0_type_to_type ty
   | StructUnionName(su,Some tag) ->
       (match unwrap tag with
        Id(tag) ->
-         Type_cocci.StructUnionName(structUnion su,false,unwrap_mcode tag)
-      | MetaId(tag,_,_) ->
+         TC.StructUnionName(structUnion su,TC.Name(unwrap_mcode tag))
+      | MetaId(tag,Ast.IdNoConstraint,_) ->
          (Common.pr2
             "warning: struct/union with a metavariable name detected.\n";
           Common.pr2
             "For type checking assuming the name of the metavariable is the name of the type\n";
-          let (rule,tag) = unwrap_mcode tag in
-          Type_cocci.StructUnionName(structUnion su,true,rule^tag))
+          TC.StructUnionName(structUnion su,
+                             TC.MV(unwrap_mcode tag,TC.Unitary,false)))
+      | MetaId(tag,_,_) ->
+         (* would have to duplicate the type in type_cocci.ml?
+            perhaps polymorphism would help? *)
+         failwith "constraints not supported on struct type name"
       | _ -> failwith "unexpected struct/union type name")
   | StructUnionName(su,None) -> failwith "nameless structure - what to do???"
   | StructUnionDef(ty,_,_,_) -> ast0_type_to_type ty
-  | TypeName(name) -> Type_cocci.TypeName(unwrap_mcode name)
+  | TypeName(name) -> TC.TypeName(unwrap_mcode name)
   | MetaType(name,_) ->
-      Type_cocci.MetaType(unwrap_mcode name,Type_cocci.Unitary,false)
+      TC.MetaType(unwrap_mcode name,TC.Unitary,false)
   | DisjType(_,types,_,_) ->
       Common.pr2_once
        "disjtype not supported in smpl type inference, assuming unknown";
-      Type_cocci.Unknown
+      TC.Unknown
   | OptType(ty) | UniqueType(ty) ->
       ast0_type_to_type ty
 
 and baseType = function
-    Ast.VoidType -> Type_cocci.VoidType
-  | Ast.CharType -> Type_cocci.CharType
-  | Ast.ShortType -> Type_cocci.ShortType
-  | Ast.IntType -> Type_cocci.IntType
-  | Ast.DoubleType -> Type_cocci.DoubleType
-  | Ast.FloatType -> Type_cocci.FloatType
-  | Ast.LongType -> Type_cocci.LongType
-  | Ast.LongLongType -> Type_cocci.LongLongType
+    Ast.VoidType -> TC.VoidType
+  | Ast.CharType -> TC.CharType
+  | Ast.ShortType -> TC.ShortType
+  | Ast.IntType -> TC.IntType
+  | Ast.DoubleType -> TC.DoubleType
+  | Ast.FloatType -> TC.FloatType
+  | Ast.LongType -> TC.LongType
+  | Ast.LongLongType -> TC.LongLongType
+  | Ast.SizeType -> TC.SizeType
+  | Ast.SSizeType -> TC.SSizeType
+  | Ast.PtrDiffType -> TC.PtrDiffType
 
 and structUnion t =
   match unwrap_mcode t with
-    Ast.Struct -> Type_cocci.Struct
-  | Ast.Union -> Type_cocci.Union
+    Ast.Struct -> TC.Struct
+  | Ast.Union -> TC.Union
 
 and sign t =
   match unwrap_mcode t with
-    Ast.Signed -> Type_cocci.Signed
-  | Ast.Unsigned -> Type_cocci.Unsigned
+    Ast.Signed -> TC.Signed
+  | Ast.Unsigned -> TC.Unsigned
 
 and const_vol t =
   match unwrap_mcode t with
-    Ast.Const -> Type_cocci.Const
-  | Ast.Volatile -> Type_cocci.Volatile
+    Ast.Const -> TC.Const
+  | Ast.Volatile -> TC.Volatile
 
 (* --------------------------------------------------------------------- *)
 (* this function is a rather minimal attempt.  the problem is that information
@@ -608,77 +647,76 @@ has been lost.  but since it is only used for metavariable types in the isos,
 perhaps it doesn't matter *)
 and make_mcode x = (x,NONE,default_info(),context_befaft(),ref NoMetaPos,-1)
 let make_mcode_info x info = (x,NONE,info,context_befaft(),ref NoMetaPos,-1)
+and make_minus_mcode x =
+  (x,NONE,default_info(),minus_befaft(),ref NoMetaPos,-1)
 
 exception TyConv
 
 let rec reverse_type ty =
   match ty with
-    Type_cocci.ConstVol(cv,ty) ->
+    TC.ConstVol(cv,ty) ->
       ConstVol(reverse_const_vol cv,context_wrap(reverse_type ty))
-  | Type_cocci.BaseType(bty) ->
+  | TC.BaseType(bty) ->
       BaseType(reverse_baseType bty,[(* not used *)])
-  | Type_cocci.SignedT(sgn,None) -> Signed(reverse_sign sgn,None)
-  | Type_cocci.SignedT(sgn,Some bty) ->
+  | TC.SignedT(sgn,None) -> Signed(reverse_sign sgn,None)
+  | TC.SignedT(sgn,Some bty) ->
       Signed(reverse_sign sgn,Some (context_wrap(reverse_type ty)))
-  | Type_cocci.Pointer(ty) ->
+  | TC.Pointer(ty) ->
       Pointer(context_wrap(reverse_type ty),make_mcode "*")
-  | Type_cocci.EnumName(mv,tag) ->
-      if mv
-      then
-       (* not right... *)
-       let rule = "" in
-       EnumName
-         (make_mcode "enum",
-          context_wrap(MetaId(make_mcode (rule,tag),Ast.IdNoConstraint,
-                              Impure)))
-      else
-       EnumName(make_mcode "enum",context_wrap(Id(make_mcode tag)))
-  | Type_cocci.StructUnionName(su,mv,tag) ->
-      if mv
-      then
-       (* not right... *)
-       let rule = "" in
-       StructUnionName
-         (reverse_structUnion su,
-          Some(context_wrap(MetaId(make_mcode (rule,tag),Ast.IdNoConstraint,
-                                   Impure))))
-      else
-       StructUnionName
-         (reverse_structUnion su,
-          Some (context_wrap(Id(make_mcode tag))))
-  | Type_cocci.TypeName(name) -> TypeName(make_mcode name)
-  | Type_cocci.MetaType(name,_,_) ->
+  | TC.EnumName(TC.MV(name,_,_)) ->
+      EnumName
+       (make_mcode "enum",
+        Some (context_wrap(MetaId(make_mcode name,Ast.IdNoConstraint,
+                                  Impure))))
+  | TC.EnumName(TC.Name tag) ->
+      EnumName(make_mcode "enum",Some(context_wrap(Id(make_mcode tag))))
+  | TC.StructUnionName(su,TC.MV(name,_,_)) ->
+      (* not right?... *)
+      StructUnionName
+       (reverse_structUnion su,
+        Some(context_wrap(MetaId(make_mcode name,Ast.IdNoConstraint,
+                                 Impure(*not really right*)))))
+  |  TC.StructUnionName(su,TC.Name tag) ->
+      StructUnionName
+       (reverse_structUnion su,
+        Some (context_wrap(Id(make_mcode tag))))
+  | TC.TypeName(name) -> TypeName(make_mcode name)
+  | TC.MetaType(name,_,_) ->
       MetaType(make_mcode name,Impure(*not really right*))
   | _ -> raise TyConv
 
 and reverse_baseType = function
-    Type_cocci.VoidType -> Ast.VoidType
-  | Type_cocci.CharType -> Ast.CharType
-  | Type_cocci.BoolType -> Ast.IntType
-  | Type_cocci.ShortType -> Ast.ShortType
-  | Type_cocci.IntType -> Ast.IntType
-  | Type_cocci.DoubleType -> Ast.DoubleType
-  | Type_cocci.FloatType -> Ast.FloatType
-  | Type_cocci.LongType -> Ast.LongType
-  | Type_cocci.LongLongType -> Ast.LongLongType
+    TC.VoidType -> Ast.VoidType
+  | TC.CharType -> Ast.CharType
+  | TC.BoolType -> Ast.IntType
+  | TC.ShortType -> Ast.ShortType
+  | TC.IntType -> Ast.IntType
+  | TC.DoubleType -> Ast.DoubleType
+  | TC.FloatType -> Ast.FloatType
+  | TC.LongType -> Ast.LongType
+  | TC.LongLongType -> Ast.LongLongType
+  | TC.SizeType -> Ast.SizeType
+  | TC.SSizeType -> Ast.SSizeType
+  | TC.PtrDiffType -> Ast.PtrDiffType
+
 
 and reverse_structUnion t =
   make_mcode
     (match t with
-      Type_cocci.Struct -> Ast.Struct
-    | Type_cocci.Union -> Ast.Union)
+      TC.Struct -> Ast.Struct
+    | TC.Union -> Ast.Union)
 
 and reverse_sign t =
   make_mcode
     (match t with
-      Type_cocci.Signed -> Ast.Signed
-    | Type_cocci.Unsigned -> Ast.Unsigned)
+      TC.Signed -> Ast.Signed
+    | TC.Unsigned -> Ast.Unsigned)
 
 and reverse_const_vol t =
   make_mcode
     (match t with
-      Type_cocci.Const -> Ast.Const
-    | Type_cocci.Volatile -> Ast.Volatile)
+      TC.Const -> Ast.Const
+    | TC.Volatile -> Ast.Volatile)
 
 (* --------------------------------------------------------------------- *)