module Language.C.Analysis.TypeUtils (
    -- * Constructors
    integral,
    floating,
    simplePtr,
    uint16_tType,
    uint32_tType,
    uint64_tType,
    size_tType,
    ptrDiffType,
    boolType,
    voidType,
    voidPtr,
    constVoidPtr,
    charPtr,
    constCharPtr,
    stringType,
    valistType,
    -- * Classifiers
    isIntegralType,
    isFloatingType,
    isPointerType,
    isScalarType,
    isFunctionType,
    -- Extractors
    typeQuals,
    typeQualsUpd,
    typeAttrs,
    typeAttrsUpd,
    baseType,
    derefTypeDef,
    deepDerefTypeDef,
    canonicalType,
    -- * Type comparisons
    sameType,
    -- * Other utilities
    getIntType,
    getFloatType
) where

import Language.C.Analysis.SemRep
import Language.C.Data.Node (CNode(..))
import Language.C.Syntax.AST (CExpression (..), CConstant (..))
import Language.C.Syntax.Constants

-- | Constructor for a simple integral type.
integral :: IntType -> Type
integral :: IntType -> Type
integral IntType
ty = TypeName -> TypeQuals -> Attributes -> Type
DirectType (IntType -> TypeName
TyIntegral IntType
ty) TypeQuals
noTypeQuals Attributes
noAttributes

-- | Constructor for a simple floating-point type.
floating :: FloatType -> Type
floating :: FloatType -> Type
floating FloatType
ty = TypeName -> TypeQuals -> Attributes -> Type
DirectType (FloatType -> TypeName
TyFloating FloatType
ty) TypeQuals
noTypeQuals Attributes
noAttributes

-- | A simple pointer with no qualifiers
simplePtr :: Type -> Type
simplePtr :: Type -> Type
simplePtr Type
t = Type -> TypeQuals -> Attributes -> Type
PtrType Type
t TypeQuals
noTypeQuals []

-- | A pointer with the @const@ qualifier.
constPtr :: Type -> Type
constPtr :: Type -> Type
constPtr Type
t = Type -> TypeQuals -> Attributes -> Type
PtrType Type
t (TypeQuals
noTypeQuals { constant :: Bool
constant = Bool
True }) []

-- | The underlying type for @uint16_t@. For now, this is just @unsigned short@.
uint16_tType :: Type
uint16_tType :: Type
uint16_tType = IntType -> Type
integral IntType
TyUShort

-- | The underlying type for @uint32_t@. For now, this is just @unsigned int@.
uint32_tType :: Type
uint32_tType :: Type
uint32_tType = IntType -> Type
integral IntType
TyUInt

-- | The underlying type for @uint64_t@. For now, this is just @unsigned long long@.
uint64_tType :: Type
uint64_tType :: Type
uint64_tType = IntType -> Type
integral IntType
TyULLong

-- | The type returned by sizeof (size_t). For now, this is just @int@.
size_tType :: Type
size_tType :: Type
size_tType = IntType -> Type
integral IntType
TyInt

-- | The type of pointer differences (ptrdiff_t). For now, this is just @int@.
ptrDiffType :: Type
ptrDiffType :: Type
ptrDiffType = IntType -> Type
integral IntType
TyInt

-- | The type of comparisons\/guards. This is always just @int@.
boolType :: Type
boolType :: Type
boolType = IntType -> Type
integral IntType
TyInt

-- | Simple @void@ type.
voidType :: Type
voidType :: Type
voidType = TypeName -> TypeQuals -> Attributes -> Type
DirectType TypeName
TyVoid TypeQuals
noTypeQuals Attributes
noAttributes

-- | An unqualified @void@ pointer.
voidPtr :: Type
voidPtr :: Type
voidPtr = Type -> Type
simplePtr Type
voidType

-- | A @const@-qualified @void@ pointer.
constVoidPtr :: Type
constVoidPtr :: Type
constVoidPtr = Type -> Type
constPtr Type
voidType

-- | An unqualified @char@ pointer.
charPtr :: Type
charPtr :: Type
charPtr = Type -> Type
simplePtr (IntType -> Type
integral IntType
TyChar)

-- | A @const@-qualified @char@ pointer.
constCharPtr :: Type
constCharPtr :: Type
constCharPtr = Type -> Type
constPtr (IntType -> Type
integral IntType
TyChar)

-- | The type of a constant string.
stringType :: Type
stringType :: Type
stringType  = Type -> ArraySize -> TypeQuals -> Attributes -> Type
ArrayType
              (TypeName -> TypeQuals -> Attributes -> Type
DirectType (IntType -> TypeName
TyIntegral IntType
TyChar)
                          (TypeQuals
noTypeQuals { constant :: Bool
constant = Bool
True })
                          Attributes
noAttributes)
              (Bool -> ArraySize
UnknownArraySize Bool
False)
              TypeQuals
noTypeQuals
              []

-- | The builtin type of variable-length argument lists.
valistType :: Type
valistType :: Type
valistType  = TypeName -> TypeQuals -> Attributes -> Type
DirectType (BuiltinType -> TypeName
TyBuiltin BuiltinType
TyVaList) TypeQuals
noTypeQuals Attributes
noAttributes

-- | Check whether a type is an integral type. This includes @enum@
--   types. This function does not attempt to resolve @typedef@ types.
isIntegralType :: Type -> Bool
isIntegralType :: Type -> Bool
isIntegralType (DirectType (TyIntegral IntType
_) TypeQuals
_ Attributes
_) = Bool
True
isIntegralType (DirectType (TyEnum EnumTypeRef
_) TypeQuals
_ Attributes
_)     = Bool
True
isIntegralType Type
_                               = Bool
False

-- | Check whether a type is a floating-point numeric type. This
--   function does not attempt to resolve @typedef@ types.
isFloatingType :: Type -> Bool
isFloatingType :: Type -> Bool
isFloatingType (DirectType (TyFloating FloatType
_) TypeQuals
_ Attributes
_) = Bool
True
isFloatingType Type
_                               = Bool
False

-- | Check whether a type is an pointer type. This includes array
--   types. This function does not attempt to resolve @typedef@ types.
isPointerType :: Type -> Bool
isPointerType :: Type -> Bool
isPointerType (PtrType Type
_ TypeQuals
_ Attributes
_)     = Bool
True
isPointerType (ArrayType Type
_ ArraySize
_ TypeQuals
_ Attributes
_) = Bool
True
isPointerType Type
_                   = Bool
False

-- | Check whether a type is a scalar type. Scalar types include
--   arithmetic types and pointer types.
isScalarType :: Type -> Bool
isScalarType :: Type -> Bool
isScalarType Type
t = Type -> Bool
isIntegralType Type
t Bool -> Bool -> Bool
|| Type -> Bool
isPointerType Type
t Bool -> Bool -> Bool
|| Type -> Bool
isFloatingType Type
t

-- | return @True@ if the given type is a function type
--
--   Result is undefined in the presence of undefined typeDefs
isFunctionType :: Type -> Bool
isFunctionType :: Type -> Bool
isFunctionType Type
ty =
    case Type
ty of  TypeDefType (TypeDefRef Ident
_ Type
actual_ty NodeInfo
_) TypeQuals
_ Attributes
_ -> Type -> Bool
isFunctionType Type
actual_ty
                FunctionType FunType
_ Attributes
_ -> Bool
True
                Type
_ -> Bool
False

-- | Return the qualifiers of a type.
typeQuals :: Type -> TypeQuals
typeQuals :: Type -> TypeQuals
typeQuals (DirectType TypeName
_ TypeQuals
q Attributes
_) = TypeQuals
q
typeQuals (PtrType Type
_ TypeQuals
q Attributes
_) = TypeQuals
q
typeQuals (ArrayType Type
_ ArraySize
_ TypeQuals
q Attributes
_) = TypeQuals
q
typeQuals (FunctionType FunType
_ Attributes
_) = TypeQuals
noTypeQuals
typeQuals (TypeDefType (TypeDefRef Ident
_ Type
t NodeInfo
_) TypeQuals
q Attributes
_) = TypeQuals -> TypeQuals -> TypeQuals
mergeTypeQuals TypeQuals
q (Type -> TypeQuals
typeQuals Type
t)

--  |Update type qualifiers
--   For function types, it is an error to change any type qualifiers
--   For typedef types, the result is stored in the typedef attribute field
typeQualsUpd :: (TypeQuals -> TypeQuals) -> Type -> Type
typeQualsUpd :: (TypeQuals -> TypeQuals) -> Type -> Type
typeQualsUpd TypeQuals -> TypeQuals
f Type
ty =
    case Type
ty of DirectType TypeName
ty_name TypeQuals
ty_quals Attributes
ty_attrs -> TypeName -> TypeQuals -> Attributes -> Type
DirectType TypeName
ty_name (TypeQuals -> TypeQuals
f TypeQuals
ty_quals) Attributes
ty_attrs
               PtrType Type
ty_inner TypeQuals
ty_quals Attributes
ty_attrs         -> Type -> TypeQuals -> Attributes -> Type
PtrType Type
ty_inner (TypeQuals -> TypeQuals
f TypeQuals
ty_quals) Attributes
ty_attrs
               ArrayType Type
ty_inner ArraySize
sz TypeQuals
ty_quals Attributes
ty_attrs    -> Type -> ArraySize -> TypeQuals -> Attributes -> Type
ArrayType Type
ty_inner ArraySize
sz (TypeQuals -> TypeQuals
f TypeQuals
ty_quals) Attributes
ty_attrs
               FunctionType FunType
ty_inner Attributes
ty_attrs             -> FunType -> Attributes -> Type
FunctionType FunType
ty_inner Attributes
ty_attrs
               TypeDefType TypeDefRef
ty_ref TypeQuals
ty_quals Attributes
ty_attrs -> TypeDefRef -> TypeQuals -> Attributes -> Type
TypeDefType TypeDefRef
ty_ref (TypeQuals -> TypeQuals
f TypeQuals
ty_quals) Attributes
ty_attrs

-- | Return the attributes of a type.
typeAttrs :: Type -> Attributes
typeAttrs :: Type -> Attributes
typeAttrs (DirectType TypeName
_ TypeQuals
_ Attributes
a) = Attributes
a
typeAttrs (PtrType Type
_ TypeQuals
_ Attributes
a) = Attributes
a
typeAttrs (ArrayType Type
_ ArraySize
_ TypeQuals
_ Attributes
a) = Attributes
a
typeAttrs (FunctionType FunType
_ Attributes
a) = Attributes
a
typeAttrs (TypeDefType (TypeDefRef Ident
_ Type
t NodeInfo
_) TypeQuals
_ Attributes
a) = Attributes -> Attributes -> Attributes
mergeAttributes Attributes
a (Type -> Attributes
typeAttrs Type
t)

--  |Update type attributes
typeAttrsUpd :: (Attributes -> Attributes) -> Type -> Type
typeAttrsUpd :: (Attributes -> Attributes) -> Type -> Type
typeAttrsUpd Attributes -> Attributes
f Type
ty =
    case Type
ty of DirectType TypeName
ty_name TypeQuals
ty_quals Attributes
ty_attrs -> TypeName -> TypeQuals -> Attributes -> Type
DirectType TypeName
ty_name TypeQuals
ty_quals (Attributes -> Attributes
f Attributes
ty_attrs)
               PtrType Type
ty_inner TypeQuals
ty_quals Attributes
ty_attrs         -> Type -> TypeQuals -> Attributes -> Type
PtrType Type
ty_inner TypeQuals
ty_quals (Attributes -> Attributes
f Attributes
ty_attrs)
               ArrayType Type
ty_inner ArraySize
sz TypeQuals
ty_quals Attributes
ty_attrs    -> Type -> ArraySize -> TypeQuals -> Attributes -> Type
ArrayType Type
ty_inner ArraySize
sz TypeQuals
ty_quals (Attributes -> Attributes
f Attributes
ty_attrs)
               FunctionType FunType
ty_inner Attributes
ty_attrs             -> FunType -> Attributes -> Type
FunctionType FunType
ty_inner (Attributes -> Attributes
f Attributes
ty_attrs)
               TypeDefType TypeDefRef
ty_ref TypeQuals
ty_quals Attributes
ty_attrs -> TypeDefRef -> TypeQuals -> Attributes -> Type
TypeDefType TypeDefRef
ty_ref TypeQuals
ty_quals (Attributes -> Attributes
f Attributes
ty_attrs)

-- | Return the base type of a pointer or array type. It is an error
--   to call this function with a type that is not in one of those two
--   categories.
baseType :: Type -> Type
baseType :: Type -> Type
baseType (PtrType Type
t TypeQuals
_ Attributes
_)     = Type
t
baseType (ArrayType Type
t ArraySize
_ TypeQuals
_ Attributes
_) = Type
t
baseType Type
_                   = [Char] -> Type
forall a. HasCallStack => [Char] -> a
error [Char]
"base of non-pointer type"

-- | resolve typedefs, if possible
derefTypeDef :: Type -> Type
derefTypeDef :: Type -> Type
derefTypeDef (TypeDefType (TypeDefRef Ident
_ Type
t NodeInfo
_) TypeQuals
q Attributes
a) =
  ((Attributes -> Attributes) -> Type -> Type
typeAttrsUpd (Attributes -> Attributes -> Attributes
mergeAttributes Attributes
a) (Type -> Type) -> (Type -> Type) -> Type -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeQuals -> TypeQuals) -> Type -> Type
typeQualsUpd (TypeQuals -> TypeQuals -> TypeQuals
mergeTypeQuals TypeQuals
q))
  (Type -> Type
derefTypeDef Type
t)
derefTypeDef Type
ty = Type
ty

-- | Attempt to remove all references to @typedef@ types from a given type.
--   Note that this does not dereference the types of structure or union
--   fields, so there are still cases where further dereferencing is
--   needed.
deepDerefTypeDef :: Type -> Type
deepDerefTypeDef :: Type -> Type
deepDerefTypeDef (PtrType Type
t TypeQuals
quals Attributes
attrs) =
  Type -> TypeQuals -> Attributes -> Type
PtrType (Type -> Type
deepDerefTypeDef Type
t) TypeQuals
quals Attributes
attrs
deepDerefTypeDef (ArrayType Type
t ArraySize
size TypeQuals
quals Attributes
attrs) =
  Type -> ArraySize -> TypeQuals -> Attributes -> Type
ArrayType (Type -> Type
deepDerefTypeDef Type
t) ArraySize
size TypeQuals
quals Attributes
attrs
deepDerefTypeDef (FunctionType (FunType Type
rt [ParamDecl]
params Bool
varargs) Attributes
attrs) =
  FunType -> Attributes -> Type
FunctionType (Type -> [ParamDecl] -> Bool -> FunType
FunType (Type -> Type
deepDerefTypeDef Type
rt) [ParamDecl]
params Bool
varargs) Attributes
attrs
deepDerefTypeDef (FunctionType (FunTypeIncomplete Type
rt) Attributes
attrs) =
  FunType -> Attributes -> Type
FunctionType (Type -> FunType
FunTypeIncomplete (Type -> Type
deepDerefTypeDef Type
rt)) Attributes
attrs
deepDerefTypeDef (TypeDefType (TypeDefRef Ident
_ Type
t NodeInfo
_) TypeQuals
q Attributes
a) =
  ((Attributes -> Attributes) -> Type -> Type
typeAttrsUpd (Attributes -> Attributes -> Attributes
mergeAttributes Attributes
a) (Type -> Type) -> (Type -> Type) -> Type -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeQuals -> TypeQuals) -> Type -> Type
typeQualsUpd (TypeQuals -> TypeQuals -> TypeQuals
mergeTypeQuals TypeQuals
q))
  (Type -> Type
deepDerefTypeDef Type
t)
deepDerefTypeDef Type
t = Type
t

-- | True iff Type is a variable length array or a derived type thereof.
-- Variably modified types have function or block scope, so only some
-- constructions are possible.
isVariablyModifiedType :: Type -> Bool
isVariablyModifiedType :: Type -> Bool
isVariablyModifiedType Type
t =
  case Type -> Type
derefTypeDef Type
t of
    TypeDefType {} -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible: derefTypeDef t returned a TypeDefType"
    DirectType {} -> Bool
False
    PtrType Type
ptr_ty TypeQuals
_ Attributes
_ -> Type -> Bool
isVariablyModifiedType Type
ptr_ty
    ArrayType Type
_ ArraySize
sz TypeQuals
_ Attributes
_ -> ArraySize -> Bool
isVariableArraySize ArraySize
sz
    FunctionType {} -> Bool
False
  where
    isVariableArraySize :: ArraySize -> Bool
    isVariableArraySize :: ArraySize -> Bool
isVariableArraySize (UnknownArraySize Bool
isStarred) = Bool
isStarred
    isVariableArraySize (ArraySize Bool
isStatic Expr
e) = Bool
isStatic Bool -> Bool -> Bool
|| Expr -> Bool
isConstantSize Expr
e

    isConstantSize :: Expr -> Bool
    isConstantSize :: Expr -> Bool
isConstantSize (CConst (CIntConst {})) = Bool
True
    isConstantSize Expr
_ = Bool
False

-- | Two types denote the same type if they are identical, ignoring type
-- definitions, and neither is a variably modified type.
sameType :: Type -> Type -> Bool
sameType :: Type -> Type -> Bool
sameType Type
t1 Type
t2 =
  Bool -> Bool
not (Type -> Bool
isVariablyModifiedType Type
t1 Bool -> Bool -> Bool
|| Type -> Bool
isVariablyModifiedType Type
t2) Bool -> Bool -> Bool
&& Bool
sameType'
  where
    sameType' :: Bool
sameType' =
      case (Type -> Type
derefTypeDef Type
t1, Type -> Type
derefTypeDef Type
t2) of
        (TypeDefType {}, Type
_) -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible: derefTypeDef t1 returned a TypeDefType"
        (Type
_, TypeDefType {}) -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible: derefTypeDef t2 returned a TypeDefType"
        (DirectType TypeName
tn1 TypeQuals
q1 Attributes
_a1, DirectType TypeName
tn2 TypeQuals
q2 Attributes
_a2) ->
          TypeName -> TypeName -> Bool
sameTypeName TypeName
tn1 TypeName
tn2 Bool -> Bool -> Bool
&& TypeQuals -> TypeQuals -> Bool
sameQuals TypeQuals
q1 TypeQuals
q2 {- FIXME: same attributes? -}
        (PtrType Type
pt1 TypeQuals
q1 Attributes
_a1, PtrType Type
pt2 TypeQuals
q2 Attributes
_a2) ->
          Type -> Type -> Bool
sameType Type
pt1 Type
pt2 Bool -> Bool -> Bool
&& TypeQuals -> TypeQuals -> Bool
sameQuals TypeQuals
q1 TypeQuals
q2
        (ArrayType Type
at1 ArraySize
sz1 TypeQuals
q1 Attributes
_a1, ArrayType Type
at2 ArraySize
sz2 TypeQuals
q2 Attributes
_a2) ->
          Type -> Type -> Bool
sameType Type
at1 Type
at2 Bool -> Bool -> Bool
&& ArraySize -> ArraySize -> Bool
sameArraySize ArraySize
sz1 ArraySize
sz2 Bool -> Bool -> Bool
&& TypeQuals -> TypeQuals -> Bool
sameQuals TypeQuals
q1 TypeQuals
q2
        (FunctionType FunType
ft1 Attributes
_a1, FunctionType FunType
ft2 Attributes
_a2) ->
          FunType -> FunType -> Bool
sameFunType FunType
ft1 FunType
ft2
        (Type, Type)
_ -> Bool
False

sameTypeName :: TypeName -> TypeName -> Bool
sameTypeName :: TypeName -> TypeName -> Bool
sameTypeName TypeName
t1 TypeName
t2 =
  case (TypeName
t1, TypeName
t2) of
    (TypeName
TyVoid, TypeName
TyVoid) -> Bool
True
    (TyIntegral IntType
i1, TyIntegral IntType
i2) -> IntType
i1 IntType -> IntType -> Bool
forall a. Eq a => a -> a -> Bool
== IntType
i2
    (TyFloating FloatType
f1, TyFloating FloatType
f2) -> FloatType
f1 FloatType -> FloatType -> Bool
forall a. Eq a => a -> a -> Bool
== FloatType
f2
    (TyComplex FloatType
f1, TyComplex FloatType
f2) -> FloatType
f1 FloatType -> FloatType -> Bool
forall a. Eq a => a -> a -> Bool
== FloatType
f2
    (TyComp CompTypeRef
ctr1, TyComp CompTypeRef
ctr2) -> CompTypeRef -> CompTypeRef -> Bool
sameCompTypeRef CompTypeRef
ctr1 CompTypeRef
ctr2
    (TyEnum EnumTypeRef
etr1, TyEnum EnumTypeRef
etr2) -> EnumTypeRef -> EnumTypeRef -> Bool
sameEnumTypeRef EnumTypeRef
etr1 EnumTypeRef
etr2
    (TyBuiltin BuiltinType
b1, TyBuiltin BuiltinType
b2) -> BuiltinType -> BuiltinType -> Bool
sameBuiltinType BuiltinType
b1 BuiltinType
b2
    (TypeName, TypeName)
_ -> Bool
False

sameBuiltinType :: BuiltinType -> BuiltinType -> Bool
sameBuiltinType :: BuiltinType -> BuiltinType -> Bool
sameBuiltinType BuiltinType
TyVaList BuiltinType
TyVaList = Bool
True
sameBuiltinType BuiltinType
TyAny BuiltinType
TyAny = Bool
False {- what does TyAny mean? -}
sameBuiltinType BuiltinType
_ BuiltinType
_ = Bool
False

sameCompTypeRef :: CompTypeRef -> CompTypeRef -> Bool
sameCompTypeRef :: CompTypeRef -> CompTypeRef -> Bool
sameCompTypeRef (CompTypeRef SUERef
sue1 CompTyKind
kind1 NodeInfo
_) (CompTypeRef SUERef
sue2 CompTyKind
kind2 NodeInfo
_) =
  SUERef
sue1 SUERef -> SUERef -> Bool
forall a. Eq a => a -> a -> Bool
== SUERef
sue2 Bool -> Bool -> Bool
&& CompTyKind
kind1 CompTyKind -> CompTyKind -> Bool
forall a. Eq a => a -> a -> Bool
== CompTyKind
kind2

sameEnumTypeRef :: EnumTypeRef -> EnumTypeRef -> Bool
sameEnumTypeRef :: EnumTypeRef -> EnumTypeRef -> Bool
sameEnumTypeRef (EnumTypeRef SUERef
sue1 NodeInfo
_) (EnumTypeRef SUERef
sue2 NodeInfo
_) = SUERef
sue1 SUERef -> SUERef -> Bool
forall a. Eq a => a -> a -> Bool
== SUERef
sue2

sameFunType :: FunType -> FunType -> Bool
sameFunType :: FunType -> FunType -> Bool
sameFunType (FunType Type
rt1 [ParamDecl]
params1 Bool
isVar1) (FunType Type
rt2 [ParamDecl]
params2 Bool
isVar2) =
  Type -> Type -> Bool
sameType Type
rt1 Type
rt2 Bool -> Bool -> Bool
&& [ParamDecl] -> [ParamDecl] -> Bool
sameParamDecls [ParamDecl]
params1 [ParamDecl]
params2 Bool -> Bool -> Bool
&& Bool
isVar1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
isVar2
  where
    sameParamDecls :: [ParamDecl] -> [ParamDecl] -> Bool
    sameParamDecls :: [ParamDecl] -> [ParamDecl] -> Bool
sameParamDecls [ParamDecl]
param_list1 [ParamDecl]
param_list2 =
      [ParamDecl] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ParamDecl]
param_list1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [ParamDecl] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ParamDecl]
param_list2
      Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((ParamDecl -> ParamDecl -> Bool)
-> [ParamDecl] -> [ParamDecl] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ParamDecl -> ParamDecl -> Bool
sameParamDecl [ParamDecl]
param_list1 [ParamDecl]
param_list2)
    -- ignores param identifiers, just compares types
    sameParamDecl :: ParamDecl -> ParamDecl -> Bool
    sameParamDecl :: ParamDecl -> ParamDecl -> Bool
sameParamDecl ParamDecl
p1 ParamDecl
p2 = Type -> Type -> Bool
sameType (ParamDecl -> Type
forall n. Declaration n => n -> Type
declType ParamDecl
p1) (ParamDecl -> Type
forall n. Declaration n => n -> Type
declType ParamDecl
p2)
sameFunType (FunTypeIncomplete Type
rt1) (FunTypeIncomplete Type
rt2) =
  Type -> Type -> Bool
sameType Type
rt1 Type
rt2
sameFunType FunType
_ FunType
_ = Bool
False

-- | Returns 'True' iff both array sizes denote the same size.  Assumes that
-- neither array type was a variably modified type.
sameArraySize :: ArraySize -> ArraySize -> Bool
sameArraySize :: ArraySize -> ArraySize -> Bool
sameArraySize (UnknownArraySize Bool
isStar1) (UnknownArraySize Bool
isStar2) = Bool
isStar1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
isStar2
sameArraySize (ArraySize Bool
s1 Expr
e1) (ArraySize Bool
s2 Expr
e2) = Bool
s1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
s2 Bool -> Bool -> Bool
&& Expr -> Expr -> Bool
sizeEqual Expr
e1 Expr
e2
  where
    -- FIXME: Do something better, and combine with sizeEqual in Language.C.Analysis.TypeCheck
    sizeEqual :: Expr -> Expr -> Bool
    sizeEqual :: Expr -> Expr -> Bool
sizeEqual (CConst (CIntConst CInteger
i1 NodeInfo
_)) (CConst (CIntConst CInteger
i2 NodeInfo
_)) = CInteger
i1 CInteger -> CInteger -> Bool
forall a. Eq a => a -> a -> Bool
== CInteger
i2
    sizeEqual Expr
oe1 Expr
oe2 = Expr -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo Expr
oe1 NodeInfo -> NodeInfo -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo Expr
oe2
sameArraySize ArraySize
_ ArraySize
_ = Bool
False

sameQuals :: TypeQuals -> TypeQuals -> Bool
sameQuals :: TypeQuals -> TypeQuals -> Bool
sameQuals (TypeQuals {constant :: TypeQuals -> Bool
constant = Bool
c1, volatile :: TypeQuals -> Bool
volatile = Bool
v1, restrict :: TypeQuals -> Bool
restrict = Bool
r1})
          (TypeQuals {constant :: TypeQuals -> Bool
constant = Bool
c2, volatile :: TypeQuals -> Bool
volatile = Bool
v2, restrict :: TypeQuals -> Bool
restrict = Bool
r2}) =
  Bool
c1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
c2 Bool -> Bool -> Bool
&& Bool
v1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
v2 Bool -> Bool -> Bool
&& Bool
r1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
r2

canonicalType :: Type -> Type
canonicalType :: Type -> Type
canonicalType Type
t =
  case Type -> Type
deepDerefTypeDef Type
t of
    FunctionType FunType
ft Attributes
attrs -> Type -> Type
simplePtr (FunType -> Attributes -> Type
FunctionType FunType
ft Attributes
attrs)
    Type
t'                    -> Type
t'

-- XXX: move to be with other flag functions
testFlags :: Enum f => [f] -> Flags f -> Bool
testFlags :: forall f. Enum f => [f] -> Flags f -> Bool
testFlags [f]
flags Flags f
fi = (f -> Bool) -> [f] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (f -> Flags f -> Bool
forall f. Enum f => f -> Flags f -> Bool
`testFlag` Flags f
fi) [f]
flags

-- XXX: deal with FlagImag. No representation for it in Complex.
-- XXX: deal with invalid combinations of flags?
getIntType :: Flags CIntFlag -> IntType
getIntType :: Flags CIntFlag -> IntType
getIntType Flags CIntFlag
flags | [CIntFlag] -> Flags CIntFlag -> Bool
forall f. Enum f => [f] -> Flags f -> Bool
testFlags [CIntFlag
FlagLongLong, CIntFlag
FlagUnsigned] Flags CIntFlag
flags = IntType
TyULLong
                 | CIntFlag -> Flags CIntFlag -> Bool
forall f. Enum f => f -> Flags f -> Bool
testFlag  CIntFlag
FlagLongLong Flags CIntFlag
flags                 = IntType
TyLLong
                 | [CIntFlag] -> Flags CIntFlag -> Bool
forall f. Enum f => [f] -> Flags f -> Bool
testFlags [CIntFlag
FlagLong, CIntFlag
FlagUnsigned] Flags CIntFlag
flags     = IntType
TyULong
                 | CIntFlag -> Flags CIntFlag -> Bool
forall f. Enum f => f -> Flags f -> Bool
testFlag  CIntFlag
FlagLong Flags CIntFlag
flags                     = IntType
TyLong
                 | CIntFlag -> Flags CIntFlag -> Bool
forall f. Enum f => f -> Flags f -> Bool
testFlag  CIntFlag
FlagUnsigned Flags CIntFlag
flags                 = IntType
TyUInt
                 | Bool
otherwise                                    = IntType
TyInt

getFloatType :: String -> FloatType
getFloatType :: [Char] -> FloatType
getFloatType [Char]
fs | [Char] -> Char
forall a. [a] -> a
last [Char]
fs Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'f', Char
'F'] = FloatType
TyFloat
                | [Char] -> Char
forall a. [a] -> a
last [Char]
fs Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'l', Char
'L'] = FloatType
TyLDouble
                | Bool
otherwise                 = FloatType
TyDouble