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