parsing_cocci/type_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  * Copyright 2010, INRIA, University of Copenhagen
  27  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
  28  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
  29  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  30  * This file is part of Coccinelle.
  31  *
  32  * Coccinelle is free software: you can redistribute it and/or modify
  33  * it under the terms of the GNU General Public License as published by
  34  * the Free Software Foundation, according to version 2 of the License.
  35  *
  36  * Coccinelle is distributed in the hope that it will be useful,
  37  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  38  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  39  * GNU General Public License for more details.
  40  *
  41  * You should have received a copy of the GNU General Public License
  42  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  43  *
  44  * The authors reserve the right to distribute this or future versions of
  45  * Coccinelle under other licenses.
  46  *)
  47
  48
  49 (* for metavariables in general, but here because needed for metatypes *)
  50 type inherited = bool (* true if inherited *)
  51 type keep_binding = Unitary (* need no info *)
  52   | Nonunitary (* need an env entry *) | Saved (* need a witness *)
  53
  54 type meta_name = string * string (*Ast_cocci.meta_name*)
  55
  56 type typeC =
  57     ConstVol        of const_vol * typeC
  58   | BaseType        of baseType
  59   | SignedT         of sign * typeC option
  60   | Pointer         of typeC
  61   | FunctionPointer of typeC (* only return type *)
  62   | Array           of typeC (* drop size info *)
  63   | EnumName        of name
  64   | StructUnionName of structUnion * name
  65   | TypeName        of string
  66   | MetaType        of meta_name * keep_binding * inherited
  67   | Unknown (* for metavariables of type expression *^* *)
  68
  69 and name =
  70     NoName
  71   | Name of string
  72   | MV of meta_name * keep_binding * inherited
  73
  74 and tagged_string = string
  75
  76 and baseType = VoidType | CharType | ShortType | IntType | DoubleType
  77 | FloatType | LongType | LongLongType | BoolType
  78 | SizeType | SSizeType | PtrDiffType
  79
  80 and structUnion = Struct | Union
  81
  82 and sign = Signed | Unsigned
  83
  84 and const_vol = Const | Volatile
  85
  86 (* --------------------------------------------------------------------- *)
  87 (* Printer *)
  88 open Format
  89
  90 let rec type2c = function
  91     ConstVol(cv,ty) -> (const_vol cv) ^ (type2c ty)
  92   | BaseType(ty) -> baseType ty
  93   | SignedT(sgn,None) -> sign sgn
  94   | SignedT(sgn,Some ty) -> (sign sgn) ^ (type2c ty)
  95   | Pointer(ty) -> (type2c ty) ^ "*"
  96   | FunctionPointer(ty) -> (type2c ty) ^ "(*)(...)"
  97   | Array(ty) -> (type2c ty) ^ "[] "
  98   | EnumName(name) -> "enum " ^ (print_name name)
  99   | StructUnionName(kind,name) -> (structUnion kind) ^ (print_name name)
 100   | TypeName(name) -> name ^ " "
 101   | MetaType((rule,name),keep,inherited) -> name ^ " "
 102       (*
 103       let print_unitary = function
 104           Unitary -> print_string "unitary"
 105         | Nonunitary -> print_string "nonunitary"
 106         | Saved -> print_string "saved" in
 107       print_string "/* ";
 108       print_string "keep:"; print_unitary keep;
 109       print_string " inherited:"; print_bool inherited;
 110       print_string " */"
 111       *)
 112   | Unknown -> "unknown "
 113
 114 and print_name = function
 115     NoName -> ""
 116   | MV ((_,name),_,_) -> name ^ " "
 117   | Name name -> name ^ " "
 118
 119 and baseType = function
 120     VoidType -> "void "
 121   | CharType -> "char "
 122   | ShortType -> "short "
 123   | IntType -> "int "
 124   | DoubleType -> "double "
 125   | FloatType -> "float "
 126   | LongType -> "long "
 127   | LongLongType -> "long long "
 128   | BoolType -> "bool "
 129   | SizeType -> "size_t "
 130   | SSizeType -> "ssize_t "
 131   | PtrDiffType -> "ptrdiff_t "
 132
 133
 134 and structUnion = function
 135     Struct -> "struct "
 136   | Union -> "union "
 137
 138 and sign = function
 139     Signed -> "signed "
 140   | Unsigned -> "unsigned "
 141
 142 and const_vol = function
 143     Const -> "const "
 144   | Volatile -> "volatile "
 145
 146 let typeC t = print_string (type2c t)
 147
 148 (* t1 should be less informative than t1, eg t1 = Pointer(Unknown) and t2 =
 149 Pointer(int) *)
 150 (* only used in iso *)
 151 (* needs to do something for MetaType *)
 152 let compatible t1 = function
 153     None -> t1 = Unknown
 154   | Some t2 ->
 155       let rec loop = function
 156           (Unknown,_) -> true
 157         | (ConstVol(cv1,ty1),ConstVol(cv2,ty2)) when cv1 = cv2 ->
 158             loop(ty1,ty2)
 159         | (Pointer(ty1),Pointer(ty2)) -> loop(ty1,ty2)
 160         | (FunctionPointer(ty1),_) -> false (* not enough info *)
 161         | (_,FunctionPointer(ty2)) -> false (* not enough info *)
 162         | (Array(ty1),Array(ty2)) -> loop(ty1,ty2)
 163         | (_,_) -> t1=t2 in
 164       loop (t1,t2)