4e61e10454a2a1a6605ec4a51faae16838a1ca91
2 * Copyright 2012, INRIA
3 * Julia Lawall, Gilles Muller
4 * Copyright 2010-2011, INRIA, University of Copenhagen
5 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
6 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
7 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
8 * This file is part of Coccinelle.
10 * Coccinelle is free software: you can redistribute it and/or modify
11 * it under the terms of the GNU General Public License as published by
12 * the Free Software Foundation, according to version 2 of the License.
14 * Coccinelle is distributed in the hope that it will be useful,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 * GNU General Public License for more details.
19 * You should have received a copy of the GNU General Public License
20 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
22 * The authors reserve the right to distribute this or future versions of
23 * Coccinelle under other licenses.
28 (* for metavariables in general, but here because needed for metatypes *)
29 type inherited
= bool (* true if inherited *)
30 type keep_binding
= Unitary
(* need no info *)
31 | Nonunitary
(* need an env entry *) | Saved
(* need a witness *)
33 type meta_name
= string * string (*Ast_cocci.meta_name*)
36 ConstVol
of const_vol
* typeC
37 | BaseType
of baseType
38 | SignedT
of sign
* typeC
option
40 | FunctionPointer
of typeC
(* only return type *)
41 | Array
of typeC
(* drop size info *)
43 | StructUnionName
of structUnion
* name
45 | MetaType
of meta_name
* keep_binding
* inherited
46 | Unknown
(* for metavariables of type expression *^* *)
51 | MV
of meta_name
* keep_binding
* inherited
53 and tagged_string
= string
55 and baseType
= VoidType
| CharType
| ShortType
| ShortIntType
| IntType
56 | DoubleType
| LongDoubleType
| FloatType
57 | LongType
| LongIntType
| LongLongType
| LongLongIntType
58 | SizeType
| SSizeType
| PtrDiffType
| BoolType
60 and structUnion
= Struct
| Union
62 and sign
= Signed
| Unsigned
64 and const_vol
= Const
| Volatile
66 (* --------------------------------------------------------------------- *)
70 let rec type2c = function
71 ConstVol
(cv
,ty
) -> (const_vol cv
) ^
(type2c ty
)
72 | BaseType
(ty
) -> baseType ty
73 | SignedT
(sgn
,None
) -> sign sgn
74 | SignedT
(sgn
,Some ty
) -> (sign sgn
) ^
(type2c ty
)
75 | Pointer
(ty
) -> (type2c ty
) ^
"*"
76 | FunctionPointer
(ty
) -> (type2c ty
) ^
"(*)(...)"
77 | Array
(ty
) -> (type2c ty
) ^
"[] "
78 | EnumName
(name
) -> "enum " ^
(print_name name
)
79 | StructUnionName
(kind
,name
) -> (structUnion kind
) ^
(print_name name
)
80 | TypeName
(name
) -> name ^
" "
81 | MetaType
((rule
,name
),keep
,inherited
) -> name ^
" "
83 let print_unitary = function
84 Unitary -> print_string "unitary"
85 | Nonunitary -> print_string "nonunitary"
86 | Saved -> print_string "saved" in
88 print_string "keep:"; print_unitary keep;
89 print_string " inherited:"; print_bool inherited;
92 | Unknown
-> "unknown "
94 and print_name
= function
96 | MV
((_
,name
),_
,_
) -> name ^
" "
97 | Name name
-> name ^
" "
99 and baseType
= function
101 | CharType
-> "char "
102 | ShortType
-> "short "
103 | ShortIntType
-> "short int "
105 | DoubleType
-> "double "
106 | LongDoubleType
-> "long double "
107 | FloatType
-> "float "
108 | LongType
-> "long "
109 | LongIntType
-> "long int "
110 | LongLongType
-> "long long "
111 | LongLongIntType
-> "long long int "
112 | BoolType
-> "bool "
113 | SizeType
-> "size_t "
114 | SSizeType
-> "ssize_t "
115 | PtrDiffType
-> "ptrdiff_t "
118 and structUnion
= function
124 | Unsigned
-> "unsigned "
126 and const_vol
= function
128 | Volatile
-> "volatile "
130 let typeC t
= print_string
(type2c t
)
132 (* t1 should be less informative than t1, eg t1 = Pointer(Unknown) and t2 =
134 (* only used in iso *)
135 (* needs to do something for MetaType *)
136 let compatible t1
= function
139 let rec loop = function
141 | (ConstVol
(cv1
,ty1
),ConstVol
(cv2
,ty2
)) when cv1
= cv2
->
143 | (Pointer
(ty1
),Pointer
(ty2
)) -> loop(ty1
,ty2
)
144 | (FunctionPointer
(ty1
),_
) -> false (* not enough info *)
145 | (_
,FunctionPointer
(ty2
)) -> false (* not enough info *)
146 | (Array
(ty1
),Array
(ty2
)) -> loop(ty1
,ty2
)