Commit | Line | Data |
---|---|---|
34e49164 C |
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 *) | |
5 | ||
faf9a90c | 6 | type typeC = |
34e49164 | 7 | ConstVol of const_vol * typeC |
faf9a90c C |
8 | | BaseType of baseType |
9 | | SignedT of sign * typeC option | |
34e49164 C |
10 | | Pointer of typeC |
11 | | FunctionPointer of typeC (* only return type *) | |
12 | | Array of typeC (* drop size info *) | |
faf9a90c | 13 | | EnumName of bool (* true if a metaId *) * string |
34e49164 C |
14 | | StructUnionName of structUnion * bool (* true if a metaId *) * string |
15 | | TypeName of string | |
16 | | MetaType of (string * string) * keep_binding * inherited | |
17 | | Unknown (* for metavariables of type expression *^* *) | |
18 | ||
19 | and tagged_string = string | |
faf9a90c | 20 | |
34e49164 | 21 | and baseType = VoidType | CharType | ShortType | IntType | DoubleType |
faf9a90c | 22 | | FloatType | LongType | LongLongType | BoolType |
34e49164 C |
23 | |
24 | and structUnion = Struct | Union | |
25 | ||
26 | and sign = Signed | Unsigned | |
27 | ||
28 | and const_vol = Const | Volatile | |
29 | ||
30 | (* --------------------------------------------------------------------- *) | |
31 | (* Printer *) | |
faf9a90c C |
32 | open Format |
33 | ||
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 ^ " " | |
34e49164 C |
46 | (* |
47 | let print_unitary = function | |
48 | Unitary -> print_string "unitary" | |
49 | | Nonunitary -> print_string "nonunitary" | |
50 | | Saved -> print_string "saved" in | |
51 | print_string "/* "; | |
52 | print_string "keep:"; print_unitary keep; | |
53 | print_string " inherited:"; print_bool inherited; | |
54 | print_string " */" | |
55 | *) | |
faf9a90c | 56 | | Unknown -> "unknown " |
34e49164 C |
57 | |
58 | and baseType = function | |
faf9a90c C |
59 | VoidType -> "void " |
60 | | CharType -> "char " | |
61 | | ShortType -> "short " | |
62 | | IntType -> "int " | |
63 | | DoubleType -> "double " | |
64 | | FloatType -> "float " | |
65 | | LongType -> "long " | |
66 | | LongLongType -> "long long " | |
67 | | BoolType -> "bool " | |
34e49164 C |
68 | |
69 | and structUnion = function | |
faf9a90c C |
70 | Struct -> "struct " |
71 | | Union -> "union " | |
34e49164 C |
72 | |
73 | and sign = function | |
faf9a90c C |
74 | Signed -> "signed " |
75 | | Unsigned -> "unsigned " | |
34e49164 C |
76 | |
77 | and const_vol = function | |
faf9a90c C |
78 | Const -> "const " |
79 | | Volatile -> "volatile " | |
80 | ||
81 | let typeC t = print_string (type2c t) | |
34e49164 C |
82 | |
83 | (* t1 should be less informative than t1, eg t1 = Pointer(Unknown) and t2 = | |
84 | Pointer(int) *) | |
85 | (* only used in iso *) | |
86 | (* needs to do something for MetaType *) | |
87 | let compatible t1 = function | |
88 | None -> t1 = Unknown | |
89 | | Some t2 -> | |
90 | let rec loop = function | |
91 | (Unknown,_) -> true | |
92 | | (ConstVol(cv1,ty1),ConstVol(cv2,ty2)) when cv1 = cv2 -> | |
93 | loop(ty1,ty2) | |
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) | |
98 | | (_,_) -> t1=t2 in | |
99 | loop (t1,t2) |