1 (* for metavariables in general, but here because needed for metatypes *)
2 type inherited
= bool (* true if inherited *)
3 type keep_binding
= Unitary
(* need no info *)
4 | Nonunitary
(* need an env entry *) | Saved
(* need a witness *)
7 ConstVol
of const_vol
* typeC
9 | SignedT
of sign
* typeC
option
11 | FunctionPointer
of typeC
(* only return type *)
12 | Array
of typeC
(* drop size info *)
13 | EnumName
of bool (* true if a metaId *) * string
14 | StructUnionName
of structUnion
* bool (* true if a metaId *) * string
16 | MetaType
of (string * string) * keep_binding
* inherited
17 | Unknown
(* for metavariables of type expression *^* *)
19 and tagged_string
= string
21 and baseType
= VoidType
| CharType
| ShortType
| IntType
| DoubleType
22 | FloatType
| LongType
| LongLongType
| BoolType
24 and structUnion
= Struct
| Union
26 and sign
= Signed
| Unsigned
28 and const_vol
= Const
| Volatile
30 (* --------------------------------------------------------------------- *)
34 let rec type2c = function
35 ConstVol
(cv
,ty
) -> (const_vol cv
) ^
(type2c ty
)
36 | BaseType
(ty
) -> baseType ty
37 | SignedT
(sgn
,None
) -> sign sgn
38 | SignedT
(sgn
,Some ty
) -> (sign sgn
) ^
(type2c ty
)
39 | Pointer
(ty
) -> (type2c ty
) ^
"*"
40 | FunctionPointer
(ty
) -> (type2c ty
) ^
"(*)(...)"
41 | Array
(ty
) -> (type2c ty
) ^
"[] "
42 | EnumName
(mv
,name
) -> "enum " ^ name ^
" "
43 | StructUnionName
(kind
,mv
,name
) -> (structUnion kind
) ^ name ^
" "
44 | TypeName
(name
) -> name ^
" "
45 | MetaType
((rule
,name
),keep
,inherited
) -> name ^
" "
47 let print_unitary = function
48 Unitary -> print_string "unitary"
49 | Nonunitary -> print_string "nonunitary"
50 | Saved -> print_string "saved" in
52 print_string "keep:"; print_unitary keep;
53 print_string " inherited:"; print_bool inherited;
56 | Unknown
-> "unknown "
58 and baseType
= function
61 | ShortType
-> "short "
63 | DoubleType
-> "double "
64 | FloatType
-> "float "
66 | LongLongType
-> "long long "
69 and structUnion
= function
75 | Unsigned
-> "unsigned "
77 and const_vol
= function
79 | Volatile
-> "volatile "
81 let typeC t
= print_string
(type2c t
)
83 (* t1 should be less informative than t1, eg t1 = Pointer(Unknown) and t2 =
85 (* only used in iso *)
86 (* needs to do something for MetaType *)
87 let compatible t1
= function
90 let rec loop = function
92 | (ConstVol
(cv1
,ty1
),ConstVol
(cv2
,ty2
)) when cv1
= cv2
->
94 | (Pointer
(ty1
),Pointer
(ty2
)) -> loop(ty1
,ty2
)
95 | (FunctionPointer
(ty1
),_
) -> false (* not enough info *)
96 | (_
,FunctionPointer
(ty2
)) -> false (* not enough info *)
97 | (Array
(ty1
),Array
(ty2
)) -> loop(ty1
,ty2
)