2 * Copyright 2005-2010, 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.
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.
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.
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/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
24 * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
25 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
26 * This file is part of Coccinelle.
28 * Coccinelle is free software: you can redistribute it and/or modify
29 * it under the terms of the GNU General Public License as published by
30 * the Free Software Foundation, according to version 2 of the License.
32 * Coccinelle is distributed in the hope that it will be useful,
33 * but WITHOUT ANY WARRANTY; without even the implied warranty of
34 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
35 * GNU General Public License for more details.
37 * You should have received a copy of the GNU General Public License
38 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
40 * The authors reserve the right to distribute this or future versions of
41 * Coccinelle under other licenses.
45 (* for metavariables in general, but here because needed for metatypes *)
46 type inherited
= bool (* true if inherited *)
47 type keep_binding
= Unitary
(* need no info *)
48 | Nonunitary
(* need an env entry *) | Saved
(* need a witness *)
51 ConstVol
of const_vol
* typeC
52 | BaseType
of baseType
53 | SignedT
of sign
* typeC
option
55 | FunctionPointer
of typeC
(* only return type *)
56 | Array
of typeC
(* drop size info *)
57 | EnumName
of bool (* true if a metaId *) * string
58 | StructUnionName
of structUnion
* bool (* true if a metaId *) * string
60 | MetaType
of (string * string) * keep_binding
* inherited
61 | Unknown
(* for metavariables of type expression *^* *)
63 and tagged_string
= string
65 and baseType
= VoidType
| CharType
| ShortType
| IntType
| DoubleType
66 | FloatType
| LongType
| LongLongType
| BoolType
68 and structUnion
= Struct
| Union
70 and sign
= Signed
| Unsigned
72 and const_vol
= Const
| Volatile
74 (* --------------------------------------------------------------------- *)
78 let rec type2c = function
79 ConstVol
(cv
,ty
) -> (const_vol cv
) ^
(type2c ty
)
80 | BaseType
(ty
) -> baseType ty
81 | SignedT
(sgn
,None
) -> sign sgn
82 | SignedT
(sgn
,Some ty
) -> (sign sgn
) ^
(type2c ty
)
83 | Pointer
(ty
) -> (type2c ty
) ^
"*"
84 | FunctionPointer
(ty
) -> (type2c ty
) ^
"(*)(...)"
85 | Array
(ty
) -> (type2c ty
) ^
"[] "
86 | EnumName
(mv
,name
) -> "enum " ^ name ^
" "
87 | StructUnionName
(kind
,mv
,name
) -> (structUnion kind
) ^ name ^
" "
88 | TypeName
(name
) -> name ^
" "
89 | MetaType
((rule
,name
),keep
,inherited
) -> name ^
" "
91 let print_unitary = function
92 Unitary -> print_string "unitary"
93 | Nonunitary -> print_string "nonunitary"
94 | Saved -> print_string "saved" in
96 print_string "keep:"; print_unitary keep;
97 print_string " inherited:"; print_bool inherited;
100 | Unknown
-> "unknown "
102 and baseType
= function
104 | CharType
-> "char "
105 | ShortType
-> "short "
107 | DoubleType
-> "double "
108 | FloatType
-> "float "
109 | LongType
-> "long "
110 | LongLongType
-> "long long "
111 | BoolType
-> "bool "
113 and structUnion
= function
119 | Unsigned
-> "unsigned "
121 and const_vol
= function
123 | Volatile
-> "volatile "
125 let typeC t
= print_string
(type2c t
)
127 (* t1 should be less informative than t1, eg t1 = Pointer(Unknown) and t2 =
129 (* only used in iso *)
130 (* needs to do something for MetaType *)
131 let compatible t1
= function
134 let rec loop = function
136 | (ConstVol
(cv1
,ty1
),ConstVol
(cv2
,ty2
)) when cv1
= cv2
->
138 | (Pointer
(ty1
),Pointer
(ty2
)) -> loop(ty1
,ty2
)
139 | (FunctionPointer
(ty1
),_
) -> false (* not enough info *)
140 | (_
,FunctionPointer
(ty2
)) -> false (* not enough info *)
141 | (Array
(ty1
),Array
(ty2
)) -> loop(ty1
,ty2
)