    {-# LANGUAGE FlexibleInstances, CPP #-}
    module Language.C.Analysis.TypeCheck where

    import Control.Monad
    import Data.Maybe
    import Language.C.Data.Ident
    import Language.C.Data.Node
    import Language.C.Data.Position
    import Language.C.Pretty
    import Language.C.Syntax.AST
    import Language.C.Syntax.Constants
    import Language.C.Syntax.Ops
    import Language.C.Analysis.DefTable
    import Language.C.Analysis.SemRep
    import Language.C.Analysis.TravMonad
    import Language.C.Analysis.TypeConversions
    import Language.C.Analysis.TypeUtils
    import Language.C.Analysis.Debug ()
    import Text.PrettyPrint.HughesPJ

    -- We used to re-implement and export the standard Either instance for
    -- Monad, which is bad, because as of GHC 7 it is in Control.Monad.Instances
    -- in base >4.2. For backwards compatibility with ghc-6.X, we use CPP here.
    #if __GLASGOW_HASKELL__ < 700
    instance Monad (Either String) where
        return        = Right
        Left  l >>= _ = Left l
        Right r >>= k = k r
        fail msg      = Left msg
    #endif

    pType :: Type -> String
    pType :: Type -> String
    pType = Doc -> String
    render (Doc -> String) -> (Type -> Doc) -> Type -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Doc
    forall p. Pretty p => p -> Doc
    pretty

    typeErrorOnLeft :: (MonadCError m) => NodeInfo -> Either String a -> m a
    typeErrorOnLeft :: forall (m :: * -> *) a.
    MonadCError m =>
    NodeInfo -> Either String a -> m a
    typeErrorOnLeft NodeInfo
    ni (Left String
    err) = NodeInfo -> String -> m a
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    typeError NodeInfo
    ni String
    err
    typeErrorOnLeft NodeInfo
    _  (Right a
    v)  = a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    v

    -- XXX: this should use a custom error type, but typeMismatch isn't always right
    typeError :: MonadCError m => NodeInfo -> String -> m a
    typeError :: forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    typeError = NodeInfo -> String -> m a
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError

    notFound :: Ident -> Either String a
    notFound :: forall a. Ident -> Either String a
    notFound Ident
    i = String -> Either String a
    forall a b. a -> Either a b
    Left (String -> Either String a) -> String -> Either String a
    forall a b. (a -> b) -> a -> b
    $ String
    "not found: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Ident -> String
    identToString Ident
    i

    checkScalar' :: MonadCError m => NodeInfo -> Type -> m ()
    checkScalar' :: forall (m :: * -> *). MonadCError m => NodeInfo -> Type -> m ()
    checkScalar' NodeInfo
    ni = NodeInfo -> Either String () -> m ()
    forall (m :: * -> *) a.
    MonadCError m =>
    NodeInfo -> Either String a -> m a
    typeErrorOnLeft NodeInfo
    ni (Either String () -> m ())
    -> (Type -> Either String ()) -> Type -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Either String ()
    checkScalar

    checkIntegral' :: MonadCError m => NodeInfo -> Type -> m ()
    checkIntegral' :: forall (m :: * -> *). MonadCError m => NodeInfo -> Type -> m ()
    checkIntegral' NodeInfo
    ni = NodeInfo -> Either String () -> m ()
    forall (m :: * -> *) a.
    MonadCError m =>
    NodeInfo -> Either String a -> m a
    typeErrorOnLeft NodeInfo
    ni (Either String () -> m ())
    -> (Type -> Either String ()) -> Type -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Either String ()
    checkIntegral

    assignCompatible' :: MonadCError m =>
                         NodeInfo -> CAssignOp -> Type -> Type -> m ()
    assignCompatible' :: forall (m :: * -> *).
    MonadCError m =>
    NodeInfo -> CAssignOp -> Type -> Type -> m ()
    assignCompatible' NodeInfo
    ni CAssignOp
    op Type
    t1 Type
    t2 = NodeInfo -> Either String () -> m ()
    forall (m :: * -> *) a.
    MonadCError m =>
    NodeInfo -> Either String a -> m a
    typeErrorOnLeft NodeInfo
    ni (CAssignOp -> Type -> Type -> Either String ()
    assignCompatible CAssignOp
    op Type
    t1 Type
    t2)

    binopType' :: MonadCError m =>
                  NodeInfo -> CBinaryOp -> Type -> Type -> m Type
    binopType' :: forall (m :: * -> *).
    MonadCError m =>
    NodeInfo -> CBinaryOp -> Type -> Type -> m Type
    binopType' NodeInfo
    ni CBinaryOp
    op Type
    t1 Type
    t2 = NodeInfo -> Either String Type -> m Type
    forall (m :: * -> *) a.
    MonadCError m =>
    NodeInfo -> Either String a -> m a
    typeErrorOnLeft NodeInfo
    ni (CBinaryOp -> Type -> Type -> Either String Type
    binopType CBinaryOp
    op Type
    t1 Type
    t2)

    conditionalType' :: MonadCError m => NodeInfo -> Type -> Type -> m Type
    conditionalType' :: forall (m :: * -> *).
    MonadCError m =>
    NodeInfo -> Type -> Type -> m Type
    conditionalType' NodeInfo
    ni Type
    t1 Type
    t2 = NodeInfo -> Either String Type -> m Type
    forall (m :: * -> *) a.
    MonadCError m =>
    NodeInfo -> Either String a -> m a
    typeErrorOnLeft NodeInfo
    ni (Either String Type -> m Type) -> Either String Type -> m Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> Either String Type
    conditionalType Type
    t1 Type
    t2

    checkScalar :: Type -> Either String ()
    checkScalar :: Type -> Either String ()
    checkScalar Type
    t =
      case Type -> Type
    canonicalType Type
    t of
        DirectType TypeName
    _ TypeQuals
    _ Attributes
    _  -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()
        PtrType Type
    _ TypeQuals
    _ Attributes
    _     -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()
        ArrayType Type
    _ ArraySize
    _ TypeQuals
    _ Attributes
    _ -> () -> Either String ()
    forall a b. b -> Either a b
    Right () -- because it's just a pointer
        Type
    t' -> String -> Either String ()
    forall a b. a -> Either a b
    Left (String -> Either String ()) -> String -> Either String ()
    forall a b. (a -> b) -> a -> b
    $
              String
    "expected scalar type, got: "
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"

    checkIntegral :: Type -> Either String ()
    checkIntegral :: Type -> Either String ()
    checkIntegral Type
    t | Type -> Bool
    isIntegralType (Type -> Type
    canonicalType Type
    t) = () -> Either String ()
    forall a b. b -> Either a b
    Right ()
                    | Bool
    otherwise = String -> Either String ()
    forall a b. a -> Either a b
    Left (String -> Either String ()) -> String -> Either String ()
    forall a b. (a -> b) -> a -> b
    $
                                  String
    "expected integral type, got: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                  Type -> String
    pType Type
    t String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                  Type -> String
    pType (Type -> Type
    canonicalType Type
    t) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"

    -- | Determine the type of a constant.
    constType :: (MonadCError m, MonadName m) => CConst -> m Type
    constType :: forall (m :: * -> *).
    (MonadCError m, MonadName m) =>
    CConst -> m Type
    constType (CIntConst (CInteger Integer
    _ CIntRepr
    _ Flags CIntFlag
    flags) NodeInfo
    _) =
      Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> m Type) -> Type -> m Type
    forall a b. (a -> b) -> a -> b
    $ TypeName -> TypeQuals -> Attributes -> Type
    DirectType (IntType -> TypeName
    TyIntegral (Flags CIntFlag -> IntType
    getIntType Flags CIntFlag
    flags)) TypeQuals
    noTypeQuals Attributes
    noAttributes
    constType (CCharConst (CChar Char
    _ Bool
    True) NodeInfo
    _) =
      Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> m Type) -> Type -> m Type
    forall a b. (a -> b) -> a -> b
    $ TypeName -> TypeQuals -> Attributes -> Type
    DirectType (IntType -> TypeName
    TyIntegral IntType
    TyInt) TypeQuals
    noTypeQuals Attributes
    noAttributes
    constType (CCharConst (CChar Char
    _ Bool
    False) NodeInfo
    _) =
      Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> m Type) -> Type -> m Type
    forall a b. (a -> b) -> a -> b
    $ TypeName -> TypeQuals -> Attributes -> Type
    DirectType (IntType -> TypeName
    TyIntegral IntType
    TyChar) TypeQuals
    noTypeQuals Attributes
    noAttributes
    constType (CCharConst (CChars String
    _ Bool
    _) NodeInfo
    _)  =
      Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> m Type) -> Type -> m Type
    forall a b. (a -> b) -> a -> b
    $ TypeName -> TypeQuals -> Attributes -> Type
    DirectType (IntType -> TypeName
    TyIntegral IntType
    TyInt) TypeQuals
    noTypeQuals Attributes
    noAttributes -- XXX
    constType (CFloatConst (CFloat String
    fs) NodeInfo
    _) =
      Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> m Type) -> Type -> m Type
    forall a b. (a -> b) -> a -> b
    $ TypeName -> TypeQuals -> Attributes -> Type
    DirectType (FloatType -> TypeName
    TyFloating (String -> FloatType
    getFloatType String
    fs)) TypeQuals
    noTypeQuals Attributes
    noAttributes
    -- XXX: should strings have any type qualifiers or attributes?
    constType (CStrConst (CString String
    chars Bool
    wide) NodeInfo
    ni) =
      do n <- m Name
    forall (m :: * -> *). MonadName m => m Name
    genName
         let charType | Bool
    wide      = IntType
    TyInt -- XXX: this isn't universal
                      | Bool
    otherwise = IntType
    TyChar
             ni' = Position -> Name -> NodeInfo
    mkNodeInfo (NodeInfo -> Position
    forall a. Pos a => a -> Position
    posOf NodeInfo
    ni) Name
    n
             arraySize = Bool -> CExpr -> ArraySize
    ArraySize
                         Bool
    True -- XXX: is it static?
                         (CConst -> CExpr
    forall a. CConstant a -> CExpression a
    CConst
                          (CInteger -> NodeInfo -> CConst
    forall a. CInteger -> a -> CConstant a
    CIntConst
                           (Integer -> CInteger
    cInteger (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    chars))) NodeInfo
    ni'))
         return $ ArrayType (DirectType (TyIntegral charType) noTypeQuals noAttributes)
                            arraySize noTypeQuals []

    -- | Determine whether two types are compatible.
    compatible :: Type -> Type -> Either String ()
    compatible :: Type -> Type -> Either String ()
    compatible Type
    t1 Type
    t2 = Either String Type -> Either String ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void(Either String Type -> Either String ())
    -> Either String Type -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ Type -> Type -> Either String Type
    compositeType Type
    t1 Type
    t2

    -- | Determine the composite type of two compatible types.
    compositeType :: Type -> Type -> Either String Type
    compositeType :: Type -> Type -> Either String Type
    compositeType Type
    t1 (DirectType (TyBuiltin BuiltinType
    TyAny) TypeQuals
    _ Attributes
    _) = Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t1
    compositeType (DirectType (TyBuiltin BuiltinType
    TyAny) TypeQuals
    _ Attributes
    _) Type
    t2 = Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t2
    compositeType t1 :: Type
    t1@(DirectType TypeName
    tn1 TypeQuals
    q1 Attributes
    a1) t2 :: Type
    t2@(DirectType TypeName
    tn2 TypeQuals
    q2 Attributes
    a2) =
      do tn <- case (TypeName
    tn1, TypeName
    tn2) of
                 (TypeName
    TyVoid, TypeName
    TyVoid) -> TypeName -> Either String TypeName
    forall a b. b -> Either a b
    Right TypeName
    TyVoid
                 (TyIntegral IntType
    _, TyEnum EnumTypeRef
    _) -> TypeName -> Either String TypeName
    forall a b. b -> Either a b
    Right TypeName
    tn1
                 (TyEnum EnumTypeRef
    _, TyIntegral IntType
    _) -> TypeName -> Either String TypeName
    forall a b. b -> Either a b
    Right TypeName
    tn2
                 (TyIntegral IntType
    i1, TyIntegral IntType
    i2) ->
                   TypeName -> Either String TypeName
    forall a b. b -> Either a b
    Right (TypeName -> Either String TypeName)
    -> TypeName -> Either String TypeName
    forall a b. (a -> b) -> a -> b
    $ IntType -> TypeName
    TyIntegral (IntType -> IntType -> IntType
    intConversion IntType
    i1 IntType
    i2)
                 (TyFloating FloatType
    f1, TyFloating FloatType
    f2) ->
                   TypeName -> Either String TypeName
    forall a b. b -> Either a b
    Right (TypeName -> Either String TypeName)
    -> TypeName -> Either String TypeName
    forall a b. (a -> b) -> a -> b
    $ FloatType -> TypeName
    TyFloating (FloatType -> FloatType -> FloatType
    floatConversion FloatType
    f1 FloatType
    f2)
                 (TyComplex FloatType
    f1, TyComplex FloatType
    f2) ->
                   TypeName -> Either String TypeName
    forall a b. b -> Either a b
    Right (TypeName -> Either String TypeName)
    -> TypeName -> Either String TypeName
    forall a b. (a -> b) -> a -> b
    $ FloatType -> TypeName
    TyComplex (FloatType -> FloatType -> FloatType
    floatConversion FloatType
    f1 FloatType
    f2)
                 (TyComp CompTypeRef
    c1, TyComp CompTypeRef
    c2) ->
                   do Bool -> Either String () -> Either String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CompTypeRef -> SUERef
    forall a. HasSUERef a => a -> SUERef
    sueRef CompTypeRef
    c1 SUERef -> SUERef -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CompTypeRef -> SUERef
    forall a. HasSUERef a => a -> SUERef
    sueRef CompTypeRef
    c2) (Either String () -> Either String ())
    -> Either String () -> Either String ()
    forall a b. (a -> b) -> a -> b
    $
                           String -> Either String ()
    forall a b. a -> Either a b
    Left (String -> Either String ()) -> String -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ String
    "incompatible composite types: "
                                  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t2
                      TypeName -> Either String TypeName
    forall a b. b -> Either a b
    Right TypeName
    tn1
                 (TyEnum EnumTypeRef
    e1, TyEnum EnumTypeRef
    e2) ->
                   do Bool -> Either String () -> Either String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (EnumTypeRef -> SUERef
    forall a. HasSUERef a => a -> SUERef
    sueRef EnumTypeRef
    e1 SUERef -> SUERef -> Bool
    forall a. Eq a => a -> a -> Bool
    /= EnumTypeRef -> SUERef
    forall a. HasSUERef a => a -> SUERef
    sueRef EnumTypeRef
    e2) (Either String () -> Either String ())
    -> Either String () -> Either String ()
    forall a b. (a -> b) -> a -> b
    $
                           String -> Either String ()
    forall a b. a -> Either a b
    Left (String -> Either String ()) -> String -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ String
    "incompatible enumeration types: "
                                  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t2
                      TypeName -> Either String TypeName
    forall a b. b -> Either a b
    Right (TypeName -> Either String TypeName)
    -> TypeName -> Either String TypeName
    forall a b. (a -> b) -> a -> b
    $ EnumTypeRef -> TypeName
    TyEnum EnumTypeRef
    e1
                 (TyBuiltin BuiltinType
    TyVaList, TyBuiltin BuiltinType
    TyVaList) ->
                   TypeName -> Either String TypeName
    forall a b. b -> Either a b
    Right (TypeName -> Either String TypeName)
    -> TypeName -> Either String TypeName
    forall a b. (a -> b) -> a -> b
    $ BuiltinType -> TypeName
    TyBuiltin BuiltinType
    TyVaList
                 (TypeName
    _, TypeName
    _) -> String -> Either String TypeName
    forall a b. a -> Either a b
    Left (String -> Either String TypeName)
    -> String -> Either String TypeName
    forall a b. (a -> b) -> a -> b
    $ String
    "incompatible direct types: "
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t2
         Right $ DirectType tn (mergeTypeQuals q1 q2) (mergeAttributes a1 a2)
    compositeType (PtrType Type
    t1 TypeQuals
    q1 Attributes
    a1) (PtrType (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) TypeQuals
    q2 Attributes
    _) =
      Type -> Either String Type
    forall a b. b -> Either a b
    Right (Type -> Either String Type) -> Type -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ Type -> TypeQuals -> Attributes -> Type
    PtrType Type
    t1 (TypeQuals -> TypeQuals -> TypeQuals
    mergeTypeQuals TypeQuals
    q1 TypeQuals
    q2) Attributes
    a1
    compositeType (PtrType (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) TypeQuals
    q1 Attributes
    _) (PtrType Type
    t2 TypeQuals
    q2 Attributes
    a2) =
      Type -> Either String Type
    forall a b. b -> Either a b
    Right (Type -> Either String Type) -> Type -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ Type -> TypeQuals -> Attributes -> Type
    PtrType Type
    t2 (TypeQuals -> TypeQuals -> TypeQuals
    mergeTypeQuals TypeQuals
    q1 TypeQuals
    q2) Attributes
    a2
    compositeType (PtrType Type
    t1 TypeQuals
    q1 Attributes
    a1) Type
    t2 | Type -> Bool
    isIntegralType Type
    t2 =
      Type -> Either String Type
    forall a b. b -> Either a b
    Right (Type -> Either String Type) -> Type -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ Type -> TypeQuals -> Attributes -> Type
    PtrType Type
    t1 (TypeQuals -> TypeQuals -> TypeQuals
    mergeTypeQuals TypeQuals
    q1 (Type -> TypeQuals
    typeQuals Type
    t2)) Attributes
    a1
    compositeType Type
    t1 (PtrType Type
    t2 TypeQuals
    q2 Attributes
    a2) | Type -> Bool
    isIntegralType Type
    t1 =
      Type -> Either String Type
    forall a b. b -> Either a b
    Right (Type -> Either String Type) -> Type -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ Type -> TypeQuals -> Attributes -> Type
    PtrType Type
    t2 (TypeQuals -> TypeQuals -> TypeQuals
    mergeTypeQuals (Type -> TypeQuals
    typeQuals Type
    t1) TypeQuals
    q2) Attributes
    a2
    compositeType (ArrayType Type
    t1 ArraySize
    _sz1 TypeQuals
    q1 Attributes
    a1) Type
    t2 | Type -> Bool
    isIntegralType Type
    t2 =
      Type -> Either String Type
    forall a b. b -> Either a b
    Right (Type -> Either String Type) -> Type -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ Type -> TypeQuals -> Attributes -> Type
    PtrType Type
    t1 TypeQuals
    q1 Attributes
    a1
    compositeType Type
    t1 (ArrayType Type
    t2 ArraySize
    _sz2 TypeQuals
    q2 Attributes
    a2) | Type -> Bool
    isIntegralType Type
    t1 =
      Type -> Either String Type
    forall a b. b -> Either a b
    Right (Type -> Either String Type) -> Type -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ Type -> TypeQuals -> Attributes -> Type
    PtrType Type
    t2 TypeQuals
    q2 Attributes
    a2
    compositeType (ArrayType Type
    t1 ArraySize
    s1 TypeQuals
    q1 Attributes
    a1) (ArrayType Type
    t2 ArraySize
    s2 TypeQuals
    q2 Attributes
    a2) =
      do t <- Type -> Type -> Either String Type
    compositeType Type
    t1 Type
    t2
         s <- compositeSize s1 s2
         let quals = TypeQuals -> TypeQuals -> TypeQuals
    mergeTypeQuals TypeQuals
    q1 TypeQuals
    q2
             attrs = Attributes -> Attributes -> Attributes
    mergeAttrs Attributes
    a1 Attributes
    a2
         Right (ArrayType t s quals attrs)
    compositeType Type
    t1 Type
    t2 | Type -> Bool
    isPointerType Type
    t1 Bool -> Bool -> Bool
    && Type -> Bool
    isPointerType Type
    t2 =
      do t <- Type -> Type -> Either String Type
    compositeType (Type -> Type
    baseType Type
    t1) (Type -> Type
    baseType Type
    t2)
         let quals = TypeQuals -> TypeQuals -> TypeQuals
    mergeTypeQuals (Type -> TypeQuals
    typeQuals Type
    t1) (Type -> TypeQuals
    typeQuals Type
    t2)
             attrs = Attributes -> Attributes -> Attributes
    mergeAttrs (Type -> Attributes
    typeAttrs Type
    t1) (Type -> Attributes
    typeAttrs Type
    t2)
         Right (PtrType t quals attrs)
    compositeType (TypeDefType TypeDefRef
    tdr1 TypeQuals
    _q1 Attributes
    _a1) (TypeDefType TypeDefRef
    tdr2 TypeQuals
    _q2 Attributes
    _a2) =
      case (TypeDefRef
    tdr1, TypeDefRef
    tdr2) of
        (TypeDefRef Ident
    _ Type
    t1 NodeInfo
    _, TypeDefRef Ident
    _ Type
    t2 NodeInfo
    _) ->
          Type -> Type -> Either String Type
    compositeType Type
    t1 Type
    t2
    compositeType (FunctionType FunType
    ft1 Attributes
    attrs1) (FunctionType FunType
    ft2 Attributes
    attrs2) =
      case (FunType
    ft1, FunType
    ft2) of
        (FunType Type
    rt1 [ParamDecl]
    args1 Bool
    varargs1, FunType Type
    rt2 [ParamDecl]
    args2 Bool
    varargs2) ->
          do {- when (length args1 /= length args2) $
                  Left "different numbers of arguments in function types" -}
             args <- (ParamDecl -> ParamDecl -> Either String ParamDecl)
    -> [ParamDecl] -> [ParamDecl] -> Either String [ParamDecl]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM ParamDecl -> ParamDecl -> Either String ParamDecl
    compositeParamDecl [ParamDecl]
    args1 [ParamDecl]
    args2
             when (varargs1 /= varargs2) $
                  Left "incompatible varargs declarations"
             doFunType rt1 rt2 args varargs1
        (FunType Type
    rt1 [ParamDecl]
    args1 Bool
    varargs1, FunTypeIncomplete Type
    rt2) ->
          Type -> Type -> [ParamDecl] -> Bool -> Either String Type
    doFunType Type
    rt1 Type
    rt2 [ParamDecl]
    args1 Bool
    varargs1
        (FunTypeIncomplete Type
    rt1, FunType Type
    rt2 [ParamDecl]
    args2 Bool
    varargs2) ->
          Type -> Type -> [ParamDecl] -> Bool -> Either String Type
    doFunType Type
    rt1 Type
    rt2 [ParamDecl]
    args2 Bool
    varargs2
        (FunTypeIncomplete Type
    rt1, FunTypeIncomplete Type
    rt2) ->
          do rt <- Type -> Type -> Either String Type
    compositeType Type
    rt1 Type
    rt2
             Right (FunctionType (FunTypeIncomplete rt) (mergeAttrs attrs1 attrs2))
      where doFunType :: Type -> Type -> [ParamDecl] -> Bool -> Either String Type
    doFunType Type
    rt1 Type
    rt2 [ParamDecl]
    args Bool
    varargs =
              do rt <- Type -> Type -> Either String Type
    compositeType Type
    rt1 Type
    rt2
                 Right (FunctionType
                         (FunType rt args varargs)
                         (mergeAttrs attrs1 attrs2))
    compositeType Type
    t1 Type
    t2 = String -> Either String Type
    forall a b. a -> Either a b
    Left (String -> Either String Type) -> String -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ String
    "incompatible types: "
                             String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t2

    -- XXX: this may not be correct
    compositeSize :: ArraySize -> ArraySize -> Either String ArraySize
    compositeSize :: ArraySize -> ArraySize -> Either String ArraySize
    compositeSize (UnknownArraySize Bool
    _) ArraySize
    s2 = ArraySize -> Either String ArraySize
    forall a b. b -> Either a b
    Right ArraySize
    s2
    compositeSize ArraySize
    s1 (UnknownArraySize Bool
    _) = ArraySize -> Either String ArraySize
    forall a b. b -> Either a b
    Right ArraySize
    s1
    compositeSize (ArraySize Bool
    s1 CExpr
    e1) (ArraySize Bool
    s2 CExpr
    e2)
      | Bool
    s1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    s2 Bool -> Bool -> Bool
    && CExpr -> CExpr -> Bool
    sizeEqual CExpr
    e1 CExpr
    e2 = ArraySize -> Either String ArraySize
    forall a b. b -> Either a b
    Right (ArraySize -> Either String ArraySize)
    -> ArraySize -> Either String ArraySize
    forall a b. (a -> b) -> a -> b
    $ Bool -> CExpr -> ArraySize
    ArraySize Bool
    s1 CExpr
    e1
      | Bool
    otherwise = ArraySize -> Either String ArraySize
    forall a b. b -> Either a b
    Right (ArraySize -> Either String ArraySize)
    -> ArraySize -> Either String ArraySize
    forall a b. (a -> b) -> a -> b
    $ Bool -> CExpr -> ArraySize
    ArraySize Bool
    s1 CExpr
    e1
    {-
        fail $ "incompatible array sizes: "
               ++ (render . pretty) e1 ++ ", " ++ (render . pretty) e2
    -}

    sizeEqual :: CExpr -> CExpr -> Bool
    sizeEqual :: CExpr -> CExpr -> 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 CExpr
    e1 CExpr
    e2 = CExpr -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CExpr
    e1 NodeInfo -> NodeInfo -> Bool
    forall a. Eq a => a -> a -> Bool
    == CExpr -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CExpr
    e2

    mergeAttrs :: Attributes -> Attributes -> Attributes
    mergeAttrs :: Attributes -> Attributes -> Attributes
    mergeAttrs = Attributes -> Attributes -> Attributes
    forall a. [a] -> [a] -> [a]
    (++) -- XXX: ultimately this should be smarter

    compositeParamDecl :: ParamDecl -> ParamDecl -> Either String ParamDecl
    compositeParamDecl :: ParamDecl -> ParamDecl -> Either String ParamDecl
    compositeParamDecl (ParamDecl VarDecl
    vd1 NodeInfo
    ni1) (ParamDecl VarDecl
    vd2 NodeInfo
    _) =
      (VarDecl -> NodeInfo -> ParamDecl)
    -> VarDecl -> VarDecl -> NodeInfo -> Either String ParamDecl
    compositeParamDecl' VarDecl -> NodeInfo -> ParamDecl
    ParamDecl VarDecl
    vd1 VarDecl
    vd2 NodeInfo
    ni1
    compositeParamDecl (AbstractParamDecl VarDecl
    vd1 NodeInfo
    _) (ParamDecl VarDecl
    vd2 NodeInfo
    ni2) =
      (VarDecl -> NodeInfo -> ParamDecl)
    -> VarDecl -> VarDecl -> NodeInfo -> Either String ParamDecl
    compositeParamDecl' VarDecl -> NodeInfo -> ParamDecl
    ParamDecl VarDecl
    vd1 VarDecl
    vd2 NodeInfo
    ni2
    compositeParamDecl (ParamDecl VarDecl
    vd1 NodeInfo
    ni1) (AbstractParamDecl VarDecl
    vd2 NodeInfo
    _) =
      (VarDecl -> NodeInfo -> ParamDecl)
    -> VarDecl -> VarDecl -> NodeInfo -> Either String ParamDecl
    compositeParamDecl' VarDecl -> NodeInfo -> ParamDecl
    ParamDecl VarDecl
    vd1 VarDecl
    vd2 NodeInfo
    ni1
    compositeParamDecl (AbstractParamDecl VarDecl
    vd1 NodeInfo
    ni1) (AbstractParamDecl VarDecl
    vd2 NodeInfo
    _) =
      (VarDecl -> NodeInfo -> ParamDecl)
    -> VarDecl -> VarDecl -> NodeInfo -> Either String ParamDecl
    compositeParamDecl' VarDecl -> NodeInfo -> ParamDecl
    AbstractParamDecl VarDecl
    vd1 VarDecl
    vd2 NodeInfo
    ni1

    compositeParamDecl' :: (VarDecl -> NodeInfo -> ParamDecl)
                        -> VarDecl
                        -> VarDecl
                        -> NodeInfo
                        -> Either String ParamDecl
    compositeParamDecl' :: (VarDecl -> NodeInfo -> ParamDecl)
    -> VarDecl -> VarDecl -> NodeInfo -> Either String ParamDecl
    compositeParamDecl' VarDecl -> NodeInfo -> ParamDecl
    f (VarDecl VarName
    n1 DeclAttrs
    attrs1 Type
    t1) (VarDecl VarName
    n2 DeclAttrs
    attrs2 Type
    t2) NodeInfo
    dni =
      do vd <- VarDecl -> VarDecl -> Either String VarDecl
    compositeVarDecl (VarName -> DeclAttrs -> Type -> VarDecl
    VarDecl VarName
    n1 DeclAttrs
    attrs1 Type
    t1') (VarName -> DeclAttrs -> Type -> VarDecl
    VarDecl VarName
    n2 DeclAttrs
    attrs2 Type
    t2')
         Right $ f vd dni
      where t1' :: Type
    t1' = Type -> Type
    canonicalType Type
    t1
            t2' :: Type
    t2' = Type -> Type
    canonicalType Type
    t2

    compositeVarDecl :: VarDecl -> VarDecl -> Either String VarDecl
    compositeVarDecl :: VarDecl -> VarDecl -> Either String VarDecl
    compositeVarDecl (VarDecl VarName
    n1 DeclAttrs
    attrs1 Type
    t1) (VarDecl VarName
    _ DeclAttrs
    attrs2 Type
    t2) =
      do t <- Type -> Type -> Either String Type
    compositeType Type
    t1 Type
    t2
         Right (VarDecl n1 (compositeDeclAttrs attrs1 attrs2) t)

    -- XXX: bad treatement of inline and storage
    compositeDeclAttrs :: DeclAttrs -> DeclAttrs -> DeclAttrs
    compositeDeclAttrs :: DeclAttrs -> DeclAttrs -> DeclAttrs
    compositeDeclAttrs (DeclAttrs FunctionAttrs
    inl Storage
    stor Attributes
    attrs1) (DeclAttrs FunctionAttrs
    _ Storage
    _ Attributes
    attrs2) =
      FunctionAttrs -> Storage -> Attributes -> DeclAttrs
    DeclAttrs FunctionAttrs
    inl Storage
    stor (Attributes -> Attributes -> Attributes
    mergeAttrs Attributes
    attrs1 Attributes
    attrs2)

    castCompatible :: Type -> Type -> Either String ()
    castCompatible :: Type -> Type -> Either String ()
    castCompatible Type
    t1 Type
    t2 =
      case (Type -> Type
    canonicalType Type
    t1, Type -> Type
    canonicalType Type
    t2) of
        (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _, Type
    _) -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()
        (Type
    _, Type
    _) -> Type -> Either String ()
    checkScalar Type
    t1 Either String () -> Either String () -> Either String ()
    forall a b. Either String a -> Either String b -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Either String ()
    checkScalar Type
    t2

    -- | Determine whether two types are compatible in an assignment expression.
    assignCompatible :: CAssignOp -> Type -> Type -> Either String ()
    assignCompatible :: CAssignOp -> Type -> Type -> Either String ()
    assignCompatible CAssignOp
    CAssignOp Type
    t1 Type
    t2 =
      case (Type -> Type
    canonicalType Type
    t1, Type -> Type
    canonicalType Type
    t2) of
        (DirectType (TyBuiltin BuiltinType
    TyAny) TypeQuals
    _ Attributes
    _, Type
    _) -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()
        (Type
    _, DirectType (TyBuiltin BuiltinType
    TyAny) TypeQuals
    _ Attributes
    _) -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()
        -- XXX: check qualifiers
        (PtrType (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) TypeQuals
    _ Attributes
    _, Type
    t2') | Type -> Bool
    isPointerType Type
    t2' -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()
        -- XXX: check qualifiers
        (Type
    t1', PtrType (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) TypeQuals
    _ Attributes
    _) | Type -> Bool
    isPointerType Type
    t1' -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()
        (PtrType Type
    _ TypeQuals
    _ Attributes
    _, Type
    t2') | Type -> Bool
    isIntegralType Type
    t2' -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()
        (Type
    t1', Type
    t2') | Type -> Bool
    isPointerType Type
    t1' Bool -> Bool -> Bool
    && Type -> Bool
    isPointerType Type
    t2' ->
                     Type -> Type -> Either String ()
    compatible (Type -> Type
    baseType Type
    t1') (Type -> Type
    baseType Type
    t2')
                    --unless (typeQuals t2 <= typeQuals t1) $
                    --       Left $
                    --       "incompatible qualifiers in pointer assignment: "
                    --       ++ pType t1 ++ ", " ++ pType t2
        (DirectType (TyComp CompTypeRef
    c1) TypeQuals
    _ Attributes
    _, DirectType (TyComp CompTypeRef
    c2) TypeQuals
    _ Attributes
    _)
          | CompTypeRef -> SUERef
    forall a. HasSUERef a => a -> SUERef
    sueRef CompTypeRef
    c1 SUERef -> SUERef -> Bool
    forall a. Eq a => a -> a -> Bool
    == CompTypeRef -> SUERef
    forall a. HasSUERef a => a -> SUERef
    sueRef CompTypeRef
    c2 -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()
          | Bool
    otherwise -> String -> Either String ()
    forall a b. a -> Either a b
    Left (String -> Either String ()) -> String -> Either String ()
    forall a b. (a -> b) -> a -> b
    $
                         String
    "incompatible compound types in assignment: "
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t2
        (DirectType (TyBuiltin BuiltinType
    TyVaList) TypeQuals
    _ Attributes
    _, DirectType (TyBuiltin BuiltinType
    TyVaList) TypeQuals
    _ Attributes
    _) ->
          () -> Either String ()
    forall a b. b -> Either a b
    Right ()
        (DirectType TypeName
    tn1 TypeQuals
    _ Attributes
    _, DirectType TypeName
    tn2 TypeQuals
    _ Attributes
    _)
          | Maybe TypeName -> Bool
    forall a. Maybe a -> Bool
    isJust (TypeName -> TypeName -> Maybe TypeName
    arithmeticConversion TypeName
    tn1 TypeName
    tn2) -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()
          | Bool
    otherwise -> String -> Either String ()
    forall a b. a -> Either a b
    Left (String -> Either String ()) -> String -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ String
    "incompatible direct types in assignment: "
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t2
        (Type
    t1', Type
    t2') -> Type -> Type -> Either String ()
    compatible Type
    t1' Type
    t2'
    assignCompatible CAssignOp
    op Type
    t1 Type
    t2 = Either String Type -> Either String ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void(Either String Type -> Either String ())
    -> Either String Type -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ CBinaryOp -> Type -> Type -> Either String Type
    binopType (CAssignOp -> CBinaryOp
    assignBinop CAssignOp
    op) Type
    t1 Type
    t2

    -- | Determine the type of a binary operation.
    binopType :: CBinaryOp -> Type -> Type -> Either String Type
    binopType :: CBinaryOp -> Type -> Type -> Either String Type
    binopType CBinaryOp
    op Type
    t1 Type
    t2 =
      case (CBinaryOp
    op, Type -> Type
    canonicalType Type
    t1, Type -> Type
    canonicalType Type
    t2) of
        (CBinaryOp
    _, Type
    t1', Type
    t2')
          | CBinaryOp -> Bool
    isLogicOp CBinaryOp
    op ->
            Type -> Either String ()
    checkScalar Type
    t1' Either String () -> Either String () -> Either String ()
    forall a b. Either String a -> Either String b -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Either String ()
    checkScalar Type
    t2' Either String () -> Either String Type -> Either String Type
    forall a b. Either String a -> Either String b -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    boolType
          | CBinaryOp -> Bool
    isCmpOp CBinaryOp
    op ->
            case (Type
    t1', Type
    t2') of
              (DirectType TypeName
    tn1 TypeQuals
    _ Attributes
    _, DirectType TypeName
    tn2 TypeQuals
    _ Attributes
    _) ->
                    case TypeName -> TypeName -> Maybe TypeName
    arithmeticConversion TypeName
    tn1 TypeName
    tn2 of
                      Just TypeName
    _ -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    boolType
                      Maybe TypeName
    Nothing -> String -> Either String Type
    forall a b. a -> Either a b
    Left (String -> Either String Type) -> String -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ Doc -> String
    render (Doc -> String) -> Doc -> String
    forall a b. (a -> b) -> a -> b
    $
                                 String -> Doc
    text String
    "incompatible arithmetic types in comparison: "
                                 Doc -> Doc -> Doc
    <+> Type -> Doc
    forall p. Pretty p => p -> Doc
    pretty Type
    t1 Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    "and" Doc -> Doc -> Doc
    <+> Type -> Doc
    forall p. Pretty p => p -> Doc
    pretty Type
    t2
              (PtrType (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) TypeQuals
    _ Attributes
    _, Type
    _)
                | Type -> Bool
    isPointerType Type
    t2' -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    boolType
              (Type
    _, PtrType (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) TypeQuals
    _ Attributes
    _)
                | Type -> Bool
    isPointerType Type
    t1' -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    boolType
              (Type
    _, Type
    _)
                | Type -> Bool
    isPointerType Type
    t1' Bool -> Bool -> Bool
    && Type -> Bool
    isIntegralType Type
    t2' -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    boolType
                | Type -> Bool
    isIntegralType Type
    t1' Bool -> Bool -> Bool
    && Type -> Bool
    isPointerType Type
    t2' -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    boolType
                | Type -> Bool
    isPointerType Type
    t1' Bool -> Bool -> Bool
    && Type -> Bool
    isPointerType Type
    t2' ->
                  Type -> Type -> Either String ()
    compatible Type
    t1' Type
    t2' Either String () -> Either String Type -> Either String Type
    forall a b. Either String a -> Either String b -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    boolType
              (Type
    _, Type
    _) -> String -> Either String Type
    forall a b. a -> Either a b
    Left String
    "incompatible types in comparison"
        (CBinaryOp
    CSubOp, ArrayType Type
    t1' ArraySize
    _ TypeQuals
    _ Attributes
    _, ArrayType Type
    t2' ArraySize
    _ TypeQuals
    _ Attributes
    _) ->
          Type -> Type -> Either String ()
    compatible Type
    t1' Type
    t2' Either String () -> Either String Type -> Either String Type
    forall a b. Either String a -> Either String b -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    ptrDiffType
        (CBinaryOp
    CSubOp, ArrayType Type
    t1' ArraySize
    _ TypeQuals
    _ Attributes
    _, PtrType Type
    t2' TypeQuals
    _ Attributes
    _) ->
          Type -> Type -> Either String ()
    compatible Type
    t1' Type
    t2' Either String () -> Either String Type -> Either String Type
    forall a b. Either String a -> Either String b -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    ptrDiffType
        (CBinaryOp
    CSubOp, PtrType Type
    t1' TypeQuals
    _ Attributes
    _, ArrayType Type
    t2' ArraySize
    _ TypeQuals
    _ Attributes
    _) ->
          Type -> Type -> Either String ()
    compatible Type
    t1' Type
    t2' Either String () -> Either String Type -> Either String Type
    forall a b. Either String a -> Either String b -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    ptrDiffType
        (CBinaryOp
    CSubOp, PtrType Type
    t1' TypeQuals
    _ Attributes
    _, PtrType Type
    t2' TypeQuals
    _ Attributes
    _) ->
          Type -> Type -> Either String ()
    compatible Type
    t1' Type
    t2' Either String () -> Either String Type -> Either String Type
    forall a b. Either String a -> Either String b -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    ptrDiffType
        (CBinaryOp
    _, PtrType Type
    _ TypeQuals
    _ Attributes
    _, Type
    t2')
          | CBinaryOp -> Bool
    isPtrOp CBinaryOp
    op Bool -> Bool -> Bool
    && Type -> Bool
    isIntegralType Type
    t2' -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t1
          | Bool
    otherwise -> String -> Either String Type
    forall a b. a -> Either a b
    Left (String -> Either String Type) -> String -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ String
    "invalid pointer operation: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Doc -> String
    render (CBinaryOp -> Doc
    forall p. Pretty p => p -> Doc
    pretty CBinaryOp
    op)
        (CBinaryOp
    CAddOp, Type
    t1', PtrType Type
    _ TypeQuals
    _ Attributes
    _) | Type -> Bool
    isIntegralType Type
    t1' -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t2
        (CBinaryOp
    _, ArrayType Type
    _ ArraySize
    _ TypeQuals
    _ Attributes
    _, Type
    t2')
          | CBinaryOp -> Bool
    isPtrOp CBinaryOp
    op Bool -> Bool -> Bool
    && Type -> Bool
    isIntegralType Type
    t2' -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t1
          | Bool
    otherwise -> String -> Either String Type
    forall a b. a -> Either a b
    Left (String -> Either String Type) -> String -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ String
    "invalid pointer operation: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Doc -> String
    render (CBinaryOp -> Doc
    forall p. Pretty p => p -> Doc
    pretty CBinaryOp
    op)
        (CBinaryOp
    CAddOp, Type
    t1', ArrayType Type
    _ ArraySize
    _ TypeQuals
    _ Attributes
    _) | Type -> Bool
    isIntegralType Type
    t1' -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t2
        (CBinaryOp
    _, DirectType TypeName
    tn1 TypeQuals
    q1 Attributes
    a1, DirectType TypeName
    tn2 TypeQuals
    q2 Attributes
    a2) ->
            do Bool -> Either String () -> Either String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CBinaryOp -> Bool
    isBitOp CBinaryOp
    op) (Type -> Either String ()
    checkIntegral Type
    t1 Either String () -> Either String () -> Either String ()
    forall a b. Either String a -> Either String b -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> Either String ()
    checkIntegral Type
    t2)
               case TypeName -> TypeName -> Maybe TypeName
    arithmeticConversion TypeName
    tn1 TypeName
    tn2 of
                 Just TypeName
    tn -> Type -> Either String Type
    forall a b. b -> Either a b
    Right (Type -> Either String Type) -> Type -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ TypeName -> TypeQuals -> Attributes -> Type
    DirectType TypeName
    tn (TypeQuals -> TypeQuals -> TypeQuals
    mergeTypeQuals TypeQuals
    q1 TypeQuals
    q2) (Attributes -> Attributes -> Attributes
    mergeAttributes Attributes
    a1 Attributes
    a2)
                 Maybe TypeName
    Nothing -> String -> Either String Type
    forall a b. a -> Either a b
    Left (String -> Either String Type) -> String -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ Doc -> String
    render (Doc -> String) -> Doc -> String
    forall a b. (a -> b) -> a -> b
    $
                            String -> Doc
    text String
    "invalid binary operation:" Doc -> Doc -> Doc
    <+> Type -> Doc
    forall p. Pretty p => p -> Doc
    pretty Type
    t1 Doc -> Doc -> Doc
    <+> CBinaryOp -> Doc
    forall p. Pretty p => p -> Doc
    pretty CBinaryOp
    op Doc -> Doc -> Doc
    <+> Type -> Doc
    forall p. Pretty p => p -> Doc
    pretty Type
    t2
        (CBinaryOp
    _, Type
    _, Type
    _) -> String -> Either String Type
    forall a b. a -> Either a b
    Left (String -> Either String Type) -> String -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ Doc -> String
    render (Doc -> String) -> Doc -> String
    forall a b. (a -> b) -> a -> b
    $
                     String -> Doc
    text String
    "unhandled binary operation:" Doc -> Doc -> Doc
    <+> Type -> Doc
    forall p. Pretty p => p -> Doc
    pretty Type
    t1 Doc -> Doc -> Doc
    <+> CBinaryOp -> Doc
    forall p. Pretty p => p -> Doc
    pretty CBinaryOp
    op Doc -> Doc -> Doc
    <+> Type -> Doc
    forall p. Pretty p => p -> Doc
    pretty Type
    t2

    -- | Determine the type of a conditional expression.
    conditionalType :: Type -> Type -> Either String Type
    conditionalType :: Type -> Type -> Either String Type
    conditionalType Type
    t1 Type
    t2 =
      case (Type -> Type
    canonicalType Type
    t1, Type -> Type
    canonicalType Type
    t2) of
        (PtrType (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) TypeQuals
    _ Attributes
    _, Type
    t2') | Type -> Bool
    isPointerType Type
    t2' -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t2
        (Type
    t1', PtrType (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) TypeQuals
    _ Attributes
    _) | Type -> Bool
    isPointerType Type
    t1' -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t1
        (ArrayType Type
    t1' ArraySize
    _ TypeQuals
    q1 Attributes
    a1, ArrayType Type
    t2' ArraySize
    _ TypeQuals
    q2 Attributes
    a2) ->
          do t <- Type -> Type -> Either String Type
    compositeType Type
    t1' Type
    t2'
             Right $ ArrayType t (UnknownArraySize False)
                      (mergeTypeQuals q1 q2) (mergeAttrs a1 a2)
        (t1' :: Type
    t1'@(DirectType TypeName
    tn1 TypeQuals
    q1 Attributes
    a1), t2' :: Type
    t2'@(DirectType TypeName
    tn2 TypeQuals
    q2 Attributes
    a2)) ->
          case TypeName -> TypeName -> Maybe TypeName
    arithmeticConversion TypeName
    tn1 TypeName
    tn2 of
            Just TypeName
    tn -> Type -> Either String Type
    forall a b. b -> Either a b
    Right (Type -> Either String Type) -> Type -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ TypeName -> TypeQuals -> Attributes -> Type
    DirectType TypeName
    tn (TypeQuals -> TypeQuals -> TypeQuals
    mergeTypeQuals TypeQuals
    q1 TypeQuals
    q2) (Attributes -> Attributes -> Attributes
    mergeAttributes Attributes
    a1 Attributes
    a2)
            Maybe TypeName
    Nothing -> Type -> Type -> Either String Type
    compositeType Type
    t1' Type
    t2'
        (Type
    t1', Type
    t2') -> Type -> Type -> Either String Type
    compositeType Type
    t1' Type
    t2'

    derefType :: Type -> Either String Type
    derefType :: Type -> Either String Type
    derefType (PtrType Type
    t TypeQuals
    _ Attributes
    _) = Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t
    derefType (ArrayType Type
    t ArraySize
    _ TypeQuals
    _ Attributes
    _) = Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t
    derefType Type
    t =
      -- XXX: is it good to use canonicalType here?
      case Type -> Type
    canonicalType Type
    t of
        PtrType Type
    t' TypeQuals
    _ Attributes
    _ -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t'
        ArrayType Type
    t' ArraySize
    _ TypeQuals
    _ Attributes
    _ -> Type -> Either String Type
    forall a b. b -> Either a b
    Right Type
    t'
        Type
    _ -> String -> Either String Type
    forall a b. a -> Either a b
    Left (String -> Either String Type) -> String -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ String
    "dereferencing non-pointer: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t

    varAddrType :: IdentDecl -> Either String Type
    varAddrType :: IdentDecl -> Either String Type
    varAddrType IdentDecl
    d =
      do case IdentDecl -> Storage
    forall d. Declaration d => d -> Storage
    declStorage IdentDecl
    d of
           Auto Bool
    True -> String -> Either String ()
    forall a b. a -> Either a b
    Left String
    "address of register variable"
           Storage
    _         -> () -> Either String ()
    forall a b. b -> Either a b
    Right ()
         case Type
    t of
           ArrayType Type
    _ ArraySize
    _ TypeQuals
    q Attributes
    a -> Type -> Either String Type
    forall a b. b -> Either a b
    Right (Type -> Either String Type) -> Type -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ Type -> TypeQuals -> Attributes -> Type
    PtrType Type
    t TypeQuals
    q Attributes
    a
           Type
    _                 -> Type -> Either String Type
    forall a b. b -> Either a b
    Right (Type -> Either String Type) -> Type -> Either String Type
    forall a b. (a -> b) -> a -> b
    $ Type -> Type
    simplePtr Type
    t
      where t :: Type
    t = IdentDecl -> Type
    forall n. Declaration n => n -> Type
    declType IdentDecl
    d

    -- | Get the type of field @m@ of type @t@
    fieldType :: (MonadCError m, MonadSymtab m) => NodeInfo -> Ident -> Type -> m Type
    fieldType :: forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> Ident -> Type -> m Type
    fieldType NodeInfo
    ni Ident
    m Type
    t =
      case Type -> Type
    canonicalType Type
    t of
        DirectType (TyComp CompTypeRef
    ctr) TypeQuals
    _ Attributes
    _ ->
          do td <- NodeInfo -> SUERef -> m TagDef
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> SUERef -> m TagDef
    lookupSUE NodeInfo
    ni (CompTypeRef -> SUERef
    forall a. HasSUERef a => a -> SUERef
    sueRef CompTypeRef
    ctr)
             ms <- tagMembers ni td
             case lookup m ms of
               Just Type
    ft -> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    ft
               Maybe Type
    Nothing -> NodeInfo -> String -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    typeError NodeInfo
    ni (String -> m Type) -> String -> m Type
    forall a b. (a -> b) -> a -> b
    $ String
    "field not found: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Ident -> String
    identToString Ident
    m
        Type
    _t' -> NodeInfo -> String -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    ni (String -> m Type) -> String -> m Type
    forall a b. (a -> b) -> a -> b
    $
              String
    "field of non-composite type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Ident -> String
    identToString Ident
    m
              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    pType Type
    t

    -- | Get all members of a struct, union, or enum, with their
    --   types. Collapse fields of anonymous members.
    tagMembers :: (MonadCError m, MonadSymtab m) =>
                  NodeInfo -> TagDef -> m [(Ident, Type)]
    tagMembers :: forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> TagDef -> m [(Ident, Type)]
    tagMembers NodeInfo
    ni TagDef
    td =
      case TagDef
    td of
        CompDef (CompType SUERef
    _ CompTyKind
    _ [MemberDecl]
    ms Attributes
    _ NodeInfo
    _) -> [MemberDecl] -> m [(Ident, Type)]
    forall {m :: * -> *} {a}.
    (MonadCError m, MonadSymtab m, Declaration a) =>
    [a] -> m [(Ident, Type)]
    getMembers [MemberDecl]
    ms
        EnumDef (EnumType SUERef
    _ [Enumerator]
    es Attributes
    _ NodeInfo
    _) -> [Enumerator] -> m [(Ident, Type)]
    forall {m :: * -> *} {a}.
    (MonadCError m, MonadSymtab m, Declaration a) =>
    [a] -> m [(Ident, Type)]
    getMembers [Enumerator]
    es
      where getMembers :: [a] -> m [(Ident, Type)]
    getMembers [a]
    ds =
              do let ts :: [Type]
    ts = (a -> Type) -> [a] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Type
    forall n. Declaration n => n -> Type
    declType [a]
    ds
                     ns :: [VarName]
    ns = (a -> VarName) -> [a] -> [VarName]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> VarName
    forall n. Declaration n => n -> VarName
    declName [a]
    ds
                 [[(Ident, Type)]] -> [(Ident, Type)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(Ident, Type)]] -> [(Ident, Type)])
    -> m [[(Ident, Type)]] -> m [(Ident, Type)]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` ((VarName, Type) -> m [(Ident, Type)])
    -> [(VarName, Type)] -> m [[(Ident, Type)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (NodeInfo -> (VarName, Type) -> m [(Ident, Type)]
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> (VarName, Type) -> m [(Ident, Type)]
    expandAnonymous NodeInfo
    ni) ([VarName] -> [Type] -> [(VarName, Type)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [VarName]
    ns [Type]
    ts)

    -- | Expand an anonymous composite type into a list of member names
    --   and their associated types.
    expandAnonymous :: (MonadCError m, MonadSymtab m) =>
                       NodeInfo -> (VarName, Type)
                    -> m [(Ident, Type)]
    expandAnonymous :: forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> (VarName, Type) -> m [(Ident, Type)]
    expandAnonymous NodeInfo
    ni (VarName
    NoName, DirectType (TyComp CompTypeRef
    ctr) TypeQuals
    _ Attributes
    _) =
      NodeInfo -> SUERef -> m TagDef
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> SUERef -> m TagDef
    lookupSUE NodeInfo
    ni (CompTypeRef -> SUERef
    forall a. HasSUERef a => a -> SUERef
    sueRef CompTypeRef
    ctr) m TagDef -> (TagDef -> m [(Ident, Type)]) -> m [(Ident, Type)]
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= NodeInfo -> TagDef -> m [(Ident, Type)]
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> TagDef -> m [(Ident, Type)]
    tagMembers NodeInfo
    ni
    expandAnonymous NodeInfo
    _ (VarName
    NoName, Type
    _) = [(Ident, Type)] -> m [(Ident, Type)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    expandAnonymous NodeInfo
    _ (VarName Ident
    n Maybe AsmName
    _, Type
    t) = [(Ident, Type)] -> m [(Ident, Type)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(Ident
    n, Type
    t)]

    lookupSUE :: (MonadCError m, MonadSymtab m) =>
                 NodeInfo -> SUERef -> m TagDef
    lookupSUE :: forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> SUERef -> m TagDef
    lookupSUE NodeInfo
    ni SUERef
    sue =
      do dt <- m DefTable
    forall (m :: * -> *). MonadSymtab m => m DefTable
    getDefTable
         case lookupTag sue dt of
           Just (Right TagDef
    td) -> TagDef -> m TagDef
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TagDef
    td
           Maybe TagEntry
    _               ->
             NodeInfo -> String -> m TagDef
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    typeError NodeInfo
    ni (String -> m TagDef) -> String -> m TagDef
    forall a b. (a -> b) -> a -> b
    $ String
    "unknown composite type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Doc -> String
    render (Doc -> String) -> (SUERef -> Doc) -> SUERef -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SUERef -> Doc
    forall p. Pretty p => p -> Doc
    pretty) SUERef
    sue

    deepTypeAttrs :: (MonadCError m, MonadSymtab m) =>
                     Type -> m Attributes
    deepTypeAttrs :: forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Type -> m Attributes
    deepTypeAttrs (DirectType (TyComp (CompTypeRef SUERef
    sue CompTyKind
    _ NodeInfo
    ni)) TypeQuals
    _ Attributes
    attrs) =
      (Attributes
    attrs Attributes -> Attributes -> Attributes
    forall a. [a] -> [a] -> [a]
    ++) (Attributes -> Attributes) -> m Attributes -> m Attributes
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` NodeInfo -> SUERef -> m Attributes
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> SUERef -> m Attributes
    sueAttrs NodeInfo
    ni SUERef
    sue
    deepTypeAttrs (DirectType (TyEnum (EnumTypeRef SUERef
    sue NodeInfo
    ni)) TypeQuals
    _ Attributes
    attrs) =
      (Attributes
    attrs Attributes -> Attributes -> Attributes
    forall a. [a] -> [a] -> [a]
    ++) (Attributes -> Attributes) -> m Attributes -> m Attributes
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` NodeInfo -> SUERef -> m Attributes
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> SUERef -> m Attributes
    sueAttrs NodeInfo
    ni SUERef
    sue
    deepTypeAttrs (DirectType TypeName
    _ TypeQuals
    _ Attributes
    attrs) = Attributes -> m Attributes
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Attributes
    attrs
    deepTypeAttrs (PtrType Type
    t TypeQuals
    _ Attributes
    attrs) = (Attributes
    attrs Attributes -> Attributes -> Attributes
    forall a. [a] -> [a] -> [a]
    ++) (Attributes -> Attributes) -> m Attributes -> m Attributes
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Type -> m Attributes
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Type -> m Attributes
    deepTypeAttrs Type
    t
    deepTypeAttrs (ArrayType Type
    t ArraySize
    _ TypeQuals
    _ Attributes
    attrs) = (Attributes
    attrs Attributes -> Attributes -> Attributes
    forall a. [a] -> [a] -> [a]
    ++) (Attributes -> Attributes) -> m Attributes -> m Attributes
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Type -> m Attributes
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Type -> m Attributes
    deepTypeAttrs Type
    t
    deepTypeAttrs (FunctionType (FunType Type
    t [ParamDecl]
    _ Bool
    _) Attributes
    attrs) =
      (Attributes
    attrs Attributes -> Attributes -> Attributes
    forall a. [a] -> [a] -> [a]
    ++) (Attributes -> Attributes) -> m Attributes -> m Attributes
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Type -> m Attributes
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Type -> m Attributes
    deepTypeAttrs Type
    t
    deepTypeAttrs (FunctionType (FunTypeIncomplete Type
    t)  Attributes
    attrs) =
      (Attributes
    attrs Attributes -> Attributes -> Attributes
    forall a. [a] -> [a] -> [a]
    ++) (Attributes -> Attributes) -> m Attributes -> m Attributes
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Type -> m Attributes
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Type -> m Attributes
    deepTypeAttrs Type
    t
    deepTypeAttrs (TypeDefType (TypeDefRef Ident
    i Type
    _ NodeInfo
    ni) TypeQuals
    _ Attributes
    attrs) =
      (Attributes
    attrs Attributes -> Attributes -> Attributes
    forall a. [a] -> [a] -> [a]
    ++) (Attributes -> Attributes) -> m Attributes -> m Attributes
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` NodeInfo -> Ident -> m Attributes
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> Ident -> m Attributes
    typeDefAttrs NodeInfo
    ni Ident
    i

    typeDefAttrs :: (MonadCError m, MonadSymtab m) =>
                    NodeInfo -> Ident -> m Attributes
    typeDefAttrs :: forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> Ident -> m Attributes
    typeDefAttrs NodeInfo
    ni Ident
    i =
      do dt <- m DefTable
    forall (m :: * -> *). MonadSymtab m => m DefTable
    getDefTable
         case lookupIdent i dt of
           Maybe IdentEntry
    Nothing -> NodeInfo -> String -> m Attributes
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    ni (String -> m Attributes) -> String -> m Attributes
    forall a b. (a -> b) -> a -> b
    $ String
    "can't find typedef name: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Ident -> String
    identToString Ident
    i
           Just (Left (TypeDef Ident
    _ Type
    t Attributes
    attrs NodeInfo
    _)) -> (Attributes
    attrs Attributes -> Attributes -> Attributes
    forall a. [a] -> [a] -> [a]
    ++) (Attributes -> Attributes) -> m Attributes -> m Attributes
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Type -> m Attributes
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Type -> m Attributes
    deepTypeAttrs Type
    t
           Just (Right IdentDecl
    _) -> NodeInfo -> String -> m Attributes
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    ni (String -> m Attributes) -> String -> m Attributes
    forall a b. (a -> b) -> a -> b
    $ String
    "not a typedef name: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Ident -> String
    identToString Ident
    i

    sueAttrs :: (MonadCError m, MonadSymtab m) =>
                NodeInfo -> SUERef -> m Attributes
    sueAttrs :: forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> SUERef -> m Attributes
    sueAttrs NodeInfo
    ni SUERef
    sue =
      do dt <- m DefTable
    forall (m :: * -> *). MonadSymtab m => m DefTable
    getDefTable
         case lookupTag sue dt of
           Maybe TagEntry
    Nothing -> NodeInfo -> String -> m Attributes
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    ni (String -> m Attributes) -> String -> m Attributes
    forall a b. (a -> b) -> a -> b
    $ String
    "SUE not found: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Doc -> String
    render (SUERef -> Doc
    forall p. Pretty p => p -> Doc
    pretty SUERef
    sue)
           Just (Left TagFwdDecl
    _) -> Attributes -> m Attributes
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
           Just (Right (CompDef (CompType SUERef
    _ CompTyKind
    _ [MemberDecl]
    _ Attributes
    attrs NodeInfo
    _))) -> Attributes -> m Attributes
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Attributes
    attrs
           Just (Right (EnumDef (EnumType SUERef
    _ [Enumerator]
    _ Attributes
    attrs NodeInfo
    _))) -> Attributes -> m Attributes
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Attributes
    attrs