parsing_cocci/type_cocci.ml

   1 (*
   2  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   3  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   4  * This file is part of Coccinelle.
   5  *
   6  * Coccinelle is free software: you can redistribute it and/or modify
   7  * it under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation, according to version 2 of the License.
   9  *
  10  * Coccinelle is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  17  *
  18  * The authors reserve the right to distribute this or future versions of
  19  * Coccinelle under other licenses.
  20  *)
  21
  22
  23 (* for metavariables in general, but here because needed for metatypes *)
  24 type inherited = bool (* true if inherited *)
  25 type keep_binding = Unitary (* need no info *)
  26   | Nonunitary (* need an env entry *) | Saved (* need a witness *)
  27
  28 type typeC =
  29     ConstVol        of const_vol * typeC
  30   | BaseType        of baseType
  31   | SignedT         of sign * typeC option
  32   | Pointer         of typeC
  33   | FunctionPointer of typeC (* only return type *)
  34   | Array           of typeC (* drop size info *)
  35   | EnumName        of bool (* true if a metaId *) * string
  36   | StructUnionName of structUnion * bool (* true if a metaId *) * string
  37   | TypeName        of string
  38   | MetaType        of (string * string) * keep_binding * inherited
  39   | Unknown (* for metavariables of type expression *^* *)
  40
  41 and tagged_string = string
  42
  43 and baseType = VoidType | CharType | ShortType | IntType | DoubleType
  44 | FloatType | LongType | LongLongType | BoolType
  45
  46 and structUnion = Struct | Union
  47
  48 and sign = Signed | Unsigned
  49
  50 and const_vol = Const | Volatile
  51
  52 (* --------------------------------------------------------------------- *)
  53 (* Printer *)
  54 open Format
  55
  56 let rec type2c = function
  57     ConstVol(cv,ty) -> (const_vol cv) ^ (type2c ty)
  58   | BaseType(ty) -> baseType ty
  59   | SignedT(sgn,None) -> sign sgn
  60   | SignedT(sgn,Some ty) -> (sign sgn) ^ (type2c ty)
  61   | Pointer(ty) -> (type2c ty) ^ "*"
  62   | FunctionPointer(ty) -> (type2c ty) ^ "(*)(...)"
  63   | Array(ty) -> (type2c ty) ^ "[] "
  64   | EnumName(mv,name) -> "enum " ^ name ^ " "
  65   | StructUnionName(kind,mv,name) -> (structUnion kind) ^ name ^ " "
  66   | TypeName(name) -> name ^ " "
  67   | MetaType((rule,name),keep,inherited) -> name ^ " "
  68       (*
  69       let print_unitary = function
  70           Unitary -> print_string "unitary"
  71         | Nonunitary -> print_string "nonunitary"
  72         | Saved -> print_string "saved" in
  73       print_string "/* ";
  74       print_string "keep:"; print_unitary keep;
  75       print_string " inherited:"; print_bool inherited;
  76       print_string " */"
  77       *)
  78   | Unknown -> "unknown "
  79
  80 and baseType = function
  81     VoidType -> "void "
  82   | CharType -> "char "
  83   | ShortType -> "short "
  84   | IntType -> "int "
  85   | DoubleType -> "double "
  86   | FloatType -> "float "
  87   | LongType -> "long "
  88   | LongLongType -> "long long "
  89   | BoolType -> "bool "
  90
  91 and structUnion = function
  92     Struct -> "struct "
  93   | Union -> "union "
  94
  95 and sign = function
  96     Signed -> "signed "
  97   | Unsigned -> "unsigned "
  98
  99 and const_vol = function
 100     Const -> "const "
 101   | Volatile -> "volatile "
 102
 103 let typeC t = print_string (type2c t)
 104
 105 (* t1 should be less informative than t1, eg t1 = Pointer(Unknown) and t2 =
 106 Pointer(int) *)
 107 (* only used in iso *)
 108 (* needs to do something for MetaType *)
 109 let compatible t1 = function
 110     None -> t1 = Unknown
 111   | Some t2 ->
 112       let rec loop = function
 113           (Unknown,_) -> true
 114         | (ConstVol(cv1,ty1),ConstVol(cv2,ty2)) when cv1 = cv2 ->
 115             loop(ty1,ty2)
 116         | (Pointer(ty1),Pointer(ty2)) -> loop(ty1,ty2)
 117         | (FunctionPointer(ty1),_) -> false (* not enough info *)
 118         | (_,FunctionPointer(ty2)) -> false (* not enough info *)
 119         | (Array(ty1),Array(ty2)) -> loop(ty1,ty2)
 120         | (_,_) -> t1=t2 in
 121       loop (t1,t2)