1module Language.C.Analysis.TypeUtils (
2    -- * Constructors
3    integral,
4    floating,
5    simplePtr,
6    uint16_tType,
7    uint32_tType,
8    uint64_tType,
9    size_tType,
10    ptrDiffType,
11    boolType,
12    voidType,
13    voidPtr,
14    constVoidPtr,
15    charPtr,
16    constCharPtr,
17    stringType,
18    valistType,
19    -- * Classifiers
20    isIntegralType,
21    isFloatingType,
22    isPointerType,
23    isScalarType,
24    isFunctionType,
25    -- Extractors
26    typeQuals,
27    typeQualsUpd,
28    typeAttrs,
29    typeAttrsUpd,
30    baseType,
31    derefTypeDef,
32    deepDerefTypeDef,
33    canonicalType,
34    -- * Type comparisons
35    sameType,
36    -- * Other utilities
37    getIntType,
38    getFloatType
39) where
40
41import Language.C.Analysis.SemRep
42import Language.C.Data.Node (CNode(..))
43import Language.C.Syntax.AST (CExpression (..), CConstant (..))
44import Language.C.Syntax.Constants
45
46-- | Constructor for a simple integral type.
47integral :: IntType -> Type
48integral ty = DirectType (TyIntegral ty) noTypeQuals noAttributes
49
50-- | Constructor for a simple floating-point type.
51floating :: FloatType -> Type
52floating ty = DirectType (TyFloating ty) noTypeQuals noAttributes
53
54-- | A simple pointer with no qualifiers
55simplePtr :: Type -> Type
56simplePtr t = PtrType t noTypeQuals []
57
58-- | A pointer with the @const@ qualifier.
59constPtr :: Type -> Type
60constPtr t = PtrType t (noTypeQuals { constant = True }) []
61
62-- | The underlying type for @uint16_t@. For now, this is just @unsigned short@.
63uint16_tType :: Type
64uint16_tType = integral TyUShort
65
66-- | The underlying type for @uint32_t@. For now, this is just @unsigned int@.
67uint32_tType :: Type
68uint32_tType = integral TyUInt
69
70-- | The underlying type for @uint64_t@. For now, this is just @unsigned long long@.
71uint64_tType :: Type
72uint64_tType = integral TyULLong
73
74-- | The type returned by sizeof (size_t). For now, this is just @int@.
75size_tType :: Type
76size_tType = integral TyInt
77
78-- | The type of pointer differences (ptrdiff_t). For now, this is just @int@.
79ptrDiffType :: Type
80ptrDiffType = integral TyInt
81
82-- | The type of comparisons\/guards. This is always just @int@.
83boolType :: Type
84boolType = integral TyInt
85
86-- | Simple @void@ type.
87voidType :: Type
88voidType = DirectType TyVoid noTypeQuals noAttributes
89
90-- | An unqualified @void@ pointer.
91voidPtr :: Type
92voidPtr = simplePtr voidType
93
94-- | A @const@-qualified @void@ pointer.
95constVoidPtr :: Type
96constVoidPtr = constPtr voidType
97
98-- | An unqualified @char@ pointer.
99charPtr :: Type
100charPtr = simplePtr (integral TyChar)
101
102-- | A @const@-qualified @char@ pointer.
103constCharPtr :: Type
104constCharPtr = constPtr (integral TyChar)
105
106-- | The type of a constant string.
107stringType :: Type
108stringType  = ArrayType
109              (DirectType (TyIntegral TyChar)
110                          (noTypeQuals { constant = True })
111                          noAttributes)
112              (UnknownArraySize False)
113              noTypeQuals
114              []
115
116-- | The builtin type of variable-length argument lists.
117valistType :: Type
118valistType  = DirectType (TyBuiltin TyVaList) noTypeQuals noAttributes
119
120-- | Check whether a type is an integral type. This includes @enum@
121--   types. This function does not attempt to resolve @typedef@ types.
122isIntegralType :: Type -> Bool
123isIntegralType (DirectType (TyIntegral _) _ _) = True
124isIntegralType (DirectType (TyEnum _) _ _)     = True
125isIntegralType _                               = False
126
127-- | Check whether a type is a floating-point numeric type. This
128--   function does not attempt to resolve @typedef@ types.
129isFloatingType :: Type -> Bool
130isFloatingType (DirectType (TyFloating _) _ _) = True
131isFloatingType _                               = False
132
133-- | Check whether a type is an pointer type. This includes array
134--   types. This function does not attempt to resolve @typedef@ types.
135isPointerType :: Type -> Bool
136isPointerType (PtrType _ _ _)     = True
137isPointerType (ArrayType _ _ _ _) = True
138isPointerType _                   = False
139
140-- | Check whether a type is a scalar type. Scalar types include
141--   arithmetic types and pointer types.
142isScalarType :: Type -> Bool
143isScalarType t = isIntegralType t || isPointerType t || isFloatingType t
144
145-- | return @True@ if the given type is a function type
146--
147--   Result is undefined in the presence of undefined typeDefs
148isFunctionType :: Type -> Bool
149isFunctionType ty =
150    case ty of  TypeDefType (TypeDefRef _ actual_ty _) _ _ -> isFunctionType actual_ty
151                FunctionType _ _ -> True
152                _ -> False
153
154-- | Return the qualifiers of a type.
155typeQuals :: Type -> TypeQuals
156typeQuals (DirectType _ q _) = q
157typeQuals (PtrType _ q _) = q
158typeQuals (ArrayType _ _ q _) = q
159typeQuals (FunctionType _ _) = noTypeQuals
160typeQuals (TypeDefType (TypeDefRef _ t _) q _) = mergeTypeQuals q (typeQuals t)
161
162--  |Update type qualifiers
163--   For function types, it is an error to change any type qualifiers
164--   For typedef types, the result is stored in the typedef attribute field
165typeQualsUpd :: (TypeQuals -> TypeQuals) -> Type -> Type
166typeQualsUpd f ty =
167    case ty of DirectType ty_name ty_quals ty_attrs -> DirectType ty_name (f ty_quals) ty_attrs
168               PtrType ty_inner ty_quals ty_attrs         -> PtrType ty_inner (f ty_quals) ty_attrs
169               ArrayType ty_inner sz ty_quals ty_attrs    -> ArrayType ty_inner sz (f ty_quals) ty_attrs
170               FunctionType ty_inner ty_attrs             -> FunctionType ty_inner ty_attrs
171               TypeDefType ty_ref ty_quals ty_attrs -> TypeDefType ty_ref (f ty_quals) ty_attrs
172
173-- | Return the attributes of a type.
174typeAttrs :: Type -> Attributes
175typeAttrs (DirectType _ _ a) = a
176typeAttrs (PtrType _ _ a) = a
177typeAttrs (ArrayType _ _ _ a) = a
178typeAttrs (FunctionType _ a) = a
179typeAttrs (TypeDefType (TypeDefRef _ t _) _ a) = mergeAttributes a (typeAttrs t)
180
181--  |Update type attributes
182typeAttrsUpd :: (Attributes -> Attributes) -> Type -> Type
183typeAttrsUpd f ty =
184    case ty of DirectType ty_name ty_quals ty_attrs -> DirectType ty_name ty_quals (f ty_attrs)
185               PtrType ty_inner ty_quals ty_attrs         -> PtrType ty_inner ty_quals (f ty_attrs)
186               ArrayType ty_inner sz ty_quals ty_attrs    -> ArrayType ty_inner sz ty_quals (f ty_attrs)
187               FunctionType ty_inner ty_attrs             -> FunctionType ty_inner (f ty_attrs)
188               TypeDefType ty_ref ty_quals ty_attrs -> TypeDefType ty_ref ty_quals (f ty_attrs)
189
190-- | Return the base type of a pointer or array type. It is an error
191--   to call this function with a type that is not in one of those two
192--   categories.
193baseType :: Type -> Type
194baseType (PtrType t _ _)     = t
195baseType (ArrayType t _ _ _) = t
196baseType _                   = error "base of non-pointer type"
197
198-- | resolve typedefs, if possible
199derefTypeDef :: Type -> Type
200derefTypeDef (TypeDefType (TypeDefRef _ t _) q a) =
201  (typeAttrsUpd (mergeAttributes a) . typeQualsUpd (mergeTypeQuals q))
202  (derefTypeDef t)
203derefTypeDef ty = ty
204
205-- | Attempt to remove all references to @typedef@ types from a given type.
206--   Note that this does not dereference the types of structure or union
207--   fields, so there are still cases where further dereferencing is
208--   needed.
209deepDerefTypeDef :: Type -> Type
210deepDerefTypeDef (PtrType t quals attrs) =
211  PtrType (deepDerefTypeDef t) quals attrs
212deepDerefTypeDef (ArrayType t size quals attrs) =
213  ArrayType (deepDerefTypeDef t) size quals attrs
214deepDerefTypeDef (FunctionType (FunType rt params varargs) attrs) =
215  FunctionType (FunType (deepDerefTypeDef rt) params varargs) attrs
216deepDerefTypeDef (FunctionType (FunTypeIncomplete rt) attrs) =
217  FunctionType (FunTypeIncomplete (deepDerefTypeDef rt)) attrs
218deepDerefTypeDef (TypeDefType (TypeDefRef _ t _) q a) =
219  (typeAttrsUpd (mergeAttributes a) . typeQualsUpd (mergeTypeQuals q))
220  (deepDerefTypeDef t)
221deepDerefTypeDef t = t
222
223-- | True iff Type is a variable length array or a derived type thereof.
224-- Variably modified types have function or block scope, so only some
225-- constructions are possible.
226isVariablyModifiedType :: Type -> Bool
227isVariablyModifiedType t =
228  case derefTypeDef t of
229    TypeDefType {} -> error "impossible: derefTypeDef t returned a TypeDefType"
230    DirectType {} -> False
231    PtrType ptr_ty _ _ -> isVariablyModifiedType ptr_ty
232    ArrayType _ sz _ _ -> isVariableArraySize sz
233    FunctionType {} -> False
234  where
235    isVariableArraySize :: ArraySize -> Bool
236    isVariableArraySize (UnknownArraySize isStarred) = isStarred
237    isVariableArraySize (ArraySize isStatic e) = isStatic || isConstantSize e
238
239    isConstantSize :: Expr -> Bool
240    isConstantSize (CConst (CIntConst {})) = True
241    isConstantSize _ = False
242
243-- | Two types denote the same type if they are identical, ignoring type
244-- definitions, and neither is a variably modified type.
245sameType :: Type -> Type -> Bool
246sameType t1 t2 =
247  not (isVariablyModifiedType t1 || isVariablyModifiedType t2) && sameType'
248  where
249    sameType' =
250      case (derefTypeDef t1, derefTypeDef t2) of
251        (TypeDefType {}, _) -> error "impossible: derefTypeDef t1 returned a TypeDefType"
252        (_, TypeDefType {}) -> error "impossible: derefTypeDef t2 returned a TypeDefType"
253        (DirectType tn1 q1 _a1, DirectType tn2 q2 _a2) ->
254          sameTypeName tn1 tn2 && sameQuals q1 q2 {- FIXME: same attributes? -}
255        (PtrType pt1 q1 _a1, PtrType pt2 q2 _a2) ->
256          sameType pt1 pt2 && sameQuals q1 q2
257        (ArrayType at1 sz1 q1 _a1, ArrayType at2 sz2 q2 _a2) ->
258          sameType at1 at2 && sameArraySize sz1 sz2 && sameQuals q1 q2
259        (FunctionType ft1 _a1, FunctionType ft2 _a2) ->
260          sameFunType ft1 ft2
261        _ -> False
262
263sameTypeName :: TypeName -> TypeName -> Bool
264sameTypeName t1 t2 =
265  case (t1, t2) of
266    (TyVoid, TyVoid) -> True
267    (TyIntegral i1, TyIntegral i2) -> i1 == i2
268    (TyFloating f1, TyFloating f2) -> f1 == f2
269    (TyComplex f1, TyComplex f2) -> f1 == f2
270    (TyComp ctr1, TyComp ctr2) -> sameCompTypeRef ctr1 ctr2
271    (TyEnum etr1, TyEnum etr2) -> sameEnumTypeRef etr1 etr2
272    (TyBuiltin b1, TyBuiltin b2) -> sameBuiltinType b1 b2
273    _ -> False
274
275sameBuiltinType :: BuiltinType -> BuiltinType -> Bool
276sameBuiltinType TyVaList TyVaList = True
277sameBuiltinType TyAny TyAny = False {- what does TyAny mean? -}
278sameBuiltinType _ _ = False
279
280sameCompTypeRef :: CompTypeRef -> CompTypeRef -> Bool
281sameCompTypeRef (CompTypeRef sue1 kind1 _) (CompTypeRef sue2 kind2 _) =
282  sue1 == sue2 && kind1 == kind2
283
284sameEnumTypeRef :: EnumTypeRef -> EnumTypeRef -> Bool
285sameEnumTypeRef (EnumTypeRef sue1 _) (EnumTypeRef sue2 _) = sue1 == sue2
286
287sameFunType :: FunType -> FunType -> Bool
288sameFunType (FunType rt1 params1 isVar1) (FunType rt2 params2 isVar2) =
289  sameType rt1 rt2 && sameParamDecls params1 params2 && isVar1 == isVar2
290  where
291    sameParamDecls :: [ParamDecl] -> [ParamDecl] -> Bool
292    sameParamDecls param_list1 param_list2 =
293      length param_list1 == length param_list2
294      && and (zipWith sameParamDecl param_list1 param_list2)
295    -- ignores param identifiers, just compares types
296    sameParamDecl :: ParamDecl -> ParamDecl -> Bool
297    sameParamDecl p1 p2 = sameType (declType p1) (declType p2)
298sameFunType (FunTypeIncomplete rt1) (FunTypeIncomplete rt2) =
299  sameType rt1 rt2
300sameFunType _ _ = False
301
302-- | Returns 'True' iff both array sizes denote the same size.  Assumes that
303-- neither array type was a variably modified type.
304sameArraySize :: ArraySize -> ArraySize -> Bool
305sameArraySize (UnknownArraySize isStar1) (UnknownArraySize isStar2) = isStar1 == isStar2
306sameArraySize (ArraySize s1 e1) (ArraySize s2 e2) = s1 == s2 && sizeEqual e1 e2
307  where
308    -- FIXME: Do something better, and combine with sizeEqual in Language.C.Analysis.TypeCheck
309    sizeEqual :: Expr -> Expr -> Bool
310    sizeEqual (CConst (CIntConst i1 _)) (CConst (CIntConst i2 _)) = i1 == i2
311    sizeEqual oe1 oe2 = nodeInfo oe1 == nodeInfo oe2
312sameArraySize _ _ = False
313
314sameQuals :: TypeQuals -> TypeQuals -> Bool
315sameQuals (TypeQuals {constant = c1, volatile = v1, restrict = r1})
316          (TypeQuals {constant = c2, volatile = v2, restrict = r2}) =
317  c1 == c2 && v1 == v2 && r1 == r2
318
319canonicalType :: Type -> Type
320canonicalType t =
321  case deepDerefTypeDef t of
322    FunctionType ft attrs -> simplePtr (FunctionType ft attrs)
323    t'                    -> t'
324
325-- XXX: move to be with other flag functions
326testFlags :: Enum f => [f] -> Flags f -> Bool
327testFlags flags fi = all (`testFlag` fi) flags
328
329-- XXX: deal with FlagImag. No representation for it in Complex.
330-- XXX: deal with invalid combinations of flags?
331getIntType :: Flags CIntFlag -> IntType
332getIntType flags | testFlags [FlagLongLong, FlagUnsigned] flags = TyULLong
333                 | testFlag  FlagLongLong flags                 = TyLLong
334                 | testFlags [FlagLong, FlagUnsigned] flags     = TyULong
335                 | testFlag  FlagLong flags                     = TyLong
336                 | testFlag  FlagUnsigned flags                 = TyUInt
337                 | otherwise                                    = TyInt
338
339getFloatType :: String -> FloatType
340getFloatType fs | last fs `elem` ['f', 'F'] = TyFloat
341                | last fs `elem` ['l', 'L'] = TyLDouble
342                | otherwise                 = TyDouble
343
344