    {-# LANGUAGE ScopedTypeVariables, PatternGuards #-}
    {-# OPTIONS_GHC -Wwarn=incomplete-patterns #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.C.Parser.Translation
    -- Copyright   :  (c) 2008 Benedikt Huber
    -- License     :  BSD-style
    -- Maintainer  :  benedikt.huber@gmail.com
    -- Stability   :  alpha
    -- Portability :  ghc
    --
    -- Analyse the parse tree
    --
    -- Traverses the AST, analyses declarations and invokes handlers.
    -----------------------------------------------------------------------------
    module Language.C.Analysis.AstAnalysis (
        -- * Top-level analysis
        analyseAST,
        analyseExt,analyseFunDef,analyseDecl,
        -- * Building blocks for additional analyses
        analyseFunctionBody,
        defineParams,
        -- * Type checking
        tExpr, ExprSide(..),
        tStmt, StmtCtx(..),
        tDesignator,
        defaultMD
    )
    where
    import Language.C.Analysis.SemError
    import Language.C.Analysis.SemRep
    import Language.C.Analysis.TravMonad
    import Language.C.Analysis.ConstEval
    import Language.C.Analysis.DefTable (globalDefs, defineLabel, inFileScope,
                                         lookupLabel, insertType, lookupType)
    import Language.C.Analysis.DeclAnalysis
    import Language.C.Analysis.TypeUtils
    import Language.C.Analysis.TypeCheck

    import Language.C.Data
    import Language.C.Pretty
    import Language.C.Syntax.AST
    import Language.C.Syntax.Constants
    import Language.C.Syntax.Ops
    import Language.C.Syntax.Utils
    import Text.PrettyPrint.HughesPJ

    import Prelude hiding (mapM, mapM_, reverse)
    import Control.Monad hiding (mapM, mapM_)
    import qualified Data.Map as Map
    import Data.Maybe
    import Data.Traversable (mapM)
    import Data.Foldable (mapM_)

    -- * analysis

    -- | Analyse the given AST
    --
    -- @analyseAST ast@ results in global declaration dictionaries.
    -- If you want to perform specific actions on declarations or definitions, you may provide
    -- callbacks in the @MonadTrav@ @m@.
    --
    -- Returns the set of global declarations and definitions which where successfully translated.
    -- It is the users responsibility to check whether any hard errors occurred (@runTrav@ does this for you).
    analyseAST :: (MonadTrav m) => CTranslUnit -> m GlobalDecls
    analyseAST :: forall (m :: * -> *). MonadTrav m => CTranslUnit -> m GlobalDecls
    analyseAST (CTranslUnit [CExternalDeclaration NodeInfo]
    decls NodeInfo
    _file_node) = do
        -- analyse all declarations, but recover from errors
        (CExternalDeclaration NodeInfo -> m ())
    -> [CExternalDeclaration NodeInfo] -> m ()
    forall {t :: * -> *} {m :: * -> *} {a} {a}.
    (Foldable t, MonadCError m) =>
    (a -> m a) -> t a -> m ()
    mapRecoverM_ CExternalDeclaration NodeInfo -> m ()
    forall (m :: * -> *).
    MonadTrav m =>
    CExternalDeclaration NodeInfo -> m ()
    analyseExt [CExternalDeclaration NodeInfo]
    decls
        -- check we are in global scope afterwards
        m DefTable
    forall (m :: * -> *). MonadSymtab m => m DefTable
    getDefTable m DefTable -> (DefTable -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \DefTable
    dt -> Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (DefTable -> Bool
    inFileScope DefTable
    dt) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
            [Char] -> m ()
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Internal Error: Not in filescope after analysis"
        -- get the global definition table (XXX: remove ?)
        (DefTable -> GlobalDecls) -> m DefTable -> m GlobalDecls
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM DefTable -> GlobalDecls
    globalDefs m DefTable
    forall (m :: * -> *). MonadSymtab m => m DefTable
    getDefTable
        where
        mapRecoverM_ :: (a -> m a) -> t a -> m ()
    mapRecoverM_ a -> m a
    f = (a -> m (Maybe a)) -> t a -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (m a -> m (Maybe a)
    forall (m :: * -> *) a. MonadCError m => m a -> m (Maybe a)
    handleTravError (m a -> m (Maybe a)) -> (a -> m a) -> a -> m (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> m a
    f)

    -- | Analyse an top-level declaration
    analyseExt :: (MonadTrav m) => CExtDecl -> m ()
    analyseExt :: forall (m :: * -> *).
    MonadTrav m =>
    CExternalDeclaration NodeInfo -> m ()
    analyseExt (CAsmExt CStringLiteral NodeInfo
    asm NodeInfo
    _)
        = CStringLiteral NodeInfo -> m ()
    forall (m :: * -> *).
    MonadTrav m =>
    CStringLiteral NodeInfo -> m ()
    handleAsmBlock CStringLiteral NodeInfo
    asm
    analyseExt (CFDefExt CFunctionDef NodeInfo
    fundef)
        = CFunctionDef NodeInfo -> m ()
    forall (m :: * -> *). MonadTrav m => CFunctionDef NodeInfo -> m ()
    analyseFunDef CFunctionDef NodeInfo
    fundef
    analyseExt (CDeclExt CDeclaration NodeInfo
    decl)
        = Bool -> CDeclaration NodeInfo -> m ()
    forall (m :: * -> *).
    MonadTrav m =>
    Bool -> CDeclaration NodeInfo -> m ()
    analyseDecl Bool
    False CDeclaration NodeInfo
    decl

    -- | Analyse a function definition
    analyseFunDef :: (MonadTrav m) => CFunDef -> m ()
    analyseFunDef :: forall (m :: * -> *). MonadTrav m => CFunctionDef NodeInfo -> m ()
    analyseFunDef (CFunDef [CDeclarationSpecifier NodeInfo]
    declspecs CDeclarator NodeInfo
    declr [CDeclaration NodeInfo]
    oldstyle_decls CStatement NodeInfo
    stmt NodeInfo
    node_info) = do
        -- analyse the declarator
        var_decl_info <- Bool
    -> [CDeclarationSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> [CDeclaration NodeInfo]
    -> Maybe CInit
    -> m VarDeclInfo
    forall (m :: * -> *).
    MonadTrav m =>
    Bool
    -> [CDeclarationSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> [CDeclaration NodeInfo]
    -> Maybe CInit
    -> m VarDeclInfo
    analyseVarDecl' Bool
    True [CDeclarationSpecifier NodeInfo]
    declspecs CDeclarator NodeInfo
    declr [CDeclaration NodeInfo]
    oldstyle_decls Maybe CInit
    forall a. Maybe a
    Nothing
        let (VarDeclInfo name fun_spec storage_spec attrs ty _declr_node) = var_decl_info
        when (isNoName name) $ astError node_info "NoName in analyseFunDef"
        let ident = VarName -> Ident
    identOfVarName VarName
    name
        -- improve incomplete type
        ty' <- improveFunDefType ty
        -- compute storage
        fun_storage <- computeFunDefStorage ident storage_spec
        let var_decl = VarName -> DeclAttrs -> Type -> VarDecl
    VarDecl VarName
    name (FunctionAttrs -> Storage -> Attributes -> DeclAttrs
    DeclAttrs FunctionAttrs
    fun_spec Storage
    fun_storage Attributes
    attrs) Type
    ty'
        -- callback for declaration
        handleVarDecl False (Decl var_decl node_info)
        -- process body
        stmt' <- analyseFunctionBody node_info var_decl stmt
        -- callback for definition
        handleFunDef ident (FunDef var_decl stmt' node_info)
        where
        improveFunDefType :: Type -> m Type
    improveFunDefType (FunctionType (FunTypeIncomplete Type
    return_ty) Attributes
    attrs) =
          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
    $ FunType -> Attributes -> Type
    FunctionType (Type -> [ParamDecl] -> Bool -> FunType
    FunType Type
    return_ty [] Bool
    False) Attributes
    attrs
        improveFunDefType Type
    ty = Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    ty

    voidM :: Monad m => m a -> m ()
    voidM :: forall (m :: * -> *) a. Monad m => m a -> m ()
    voidM m a
    m = m a
    m m a -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Analyse a declaration other than a function definition
    --
    --   Note: static assertions are not analysed
    analyseDecl :: (MonadTrav m) => Bool -> CDecl -> m ()
    analyseDecl :: forall (m :: * -> *).
    MonadTrav m =>
    Bool -> CDeclaration NodeInfo -> m ()
    analyseDecl Bool
    _is_local (CStaticAssert CExpression NodeInfo
    _expr CStringLiteral NodeInfo
    _strlit NodeInfo
    _annot) = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- TODO
    analyseDecl Bool
    is_local decl :: CDeclaration NodeInfo
    decl@(CDecl [CDeclarationSpecifier NodeInfo]
    declspecs [(Maybe (CDeclarator NodeInfo), Maybe CInit,
      Maybe (CExpression NodeInfo))]
    declrs NodeInfo
    node)
        | [(Maybe (CDeclarator NodeInfo), Maybe CInit,
      Maybe (CExpression NodeInfo))]
    -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Maybe (CDeclarator NodeInfo), Maybe CInit,
      Maybe (CExpression NodeInfo))]
    declrs =
            case Maybe [CDeclarationSpecifier NodeInfo]
    typedef_spec of Just [CDeclarationSpecifier NodeInfo]
    _  -> NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node [Char]
    "bad typedef declaration: missing declarator"
                                 Maybe [CDeclarationSpecifier NodeInfo]
    Nothing -> m Type -> m ()
    forall (m :: * -> *) a. Monad m => m a -> m ()
    voidM(m Type -> m ()) -> m Type -> m ()
    forall a b. (a -> b) -> a -> b
    $ CDeclaration NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    CDeclaration NodeInfo -> m Type
    analyseTypeDecl CDeclaration NodeInfo
    decl
        | (Just [CDeclarationSpecifier NodeInfo]
    declspecs') <- Maybe [CDeclarationSpecifier NodeInfo]
    typedef_spec = ((Bool,
      (Maybe (CDeclarator NodeInfo), Maybe CInit,
       Maybe (CExpression NodeInfo)))
     -> m ())
    -> [(Bool,
         (Maybe (CDeclarator NodeInfo), Maybe CInit,
          Maybe (CExpression NodeInfo)))]
    -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((Bool
     -> (Maybe (CDeclarator NodeInfo), Maybe CInit,
         Maybe (CExpression NodeInfo))
     -> m ())
    -> (Bool,
        (Maybe (CDeclarator NodeInfo), Maybe CInit,
         Maybe (CExpression NodeInfo)))
    -> m ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ([CDeclarationSpecifier NodeInfo]
    -> Bool
    -> (Maybe (CDeclarator NodeInfo), Maybe CInit,
        Maybe (CExpression NodeInfo))
    -> m ()
    forall {m :: * -> *} {a} {a}.
    MonadTrav m =>
    [CDeclarationSpecifier NodeInfo]
    -> Bool -> (Maybe (CDeclarator NodeInfo), Maybe a, Maybe a) -> m ()
    analyseTyDef [CDeclarationSpecifier NodeInfo]
    declspecs')) [(Bool,
      (Maybe (CDeclarator NodeInfo), Maybe CInit,
       Maybe (CExpression NodeInfo)))]
    declr_list
        | Bool
    otherwise   = do let ([CStorageSpecifier NodeInfo]
    storage_specs, [CAttribute NodeInfo]
    attrs, [CTypeQualifier NodeInfo]
    typequals, [CTypeSpecifier NodeInfo]
    typespecs, [CFunctionSpecifier NodeInfo]
    funspecs, [CAlignmentSpecifier NodeInfo]
    _alignspecs) =
                                 [CDeclarationSpecifier NodeInfo]
    -> ([CStorageSpecifier NodeInfo], [CAttribute NodeInfo],
        [CTypeQualifier NodeInfo], [CTypeSpecifier NodeInfo],
        [CFunctionSpecifier NodeInfo], [CAlignmentSpecifier NodeInfo])
    forall a.
    [CDeclarationSpecifier a]
    -> ([CStorageSpecifier a], [CAttribute a], [CTypeQualifier a],
        [CTypeSpecifier a], [CFunctionSpecifier a],
        [CAlignmentSpecifier a])
    partitionDeclSpecs [CDeclarationSpecifier NodeInfo]
    declspecs
                           canonTySpecs <- [CTypeSpecifier NodeInfo] -> m TypeSpecAnalysis
    forall (m :: * -> *).
    MonadTrav m =>
    [CTypeSpecifier NodeInfo] -> m TypeSpecAnalysis
    canonicalTypeSpec [CTypeSpecifier NodeInfo]
    typespecs
                           -- TODO: alignspecs not yet processed
                           let specs =
                                 ([CStorageSpecifier NodeInfo]
    storage_specs, [CAttribute NodeInfo]
    attrs, [CTypeQualifier NodeInfo]
    typequals, TypeSpecAnalysis
    canonTySpecs, [CFunctionSpecifier NodeInfo]
    funspecs)
                           mapM_ (uncurry (analyseVarDeclr specs)) declr_list
        where
        declr_list :: [(Bool,
      (Maybe (CDeclarator NodeInfo), Maybe CInit,
       Maybe (CExpression NodeInfo)))]
    declr_list = [Bool]
    -> [(Maybe (CDeclarator NodeInfo), Maybe CInit,
         Maybe (CExpression NodeInfo))]
    -> [(Bool,
         (Maybe (CDeclarator NodeInfo), Maybe CInit,
          Maybe (CExpression NodeInfo)))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Bool
    True Bool -> [Bool] -> [Bool]
    forall a. a -> [a] -> [a]
    : Bool -> [Bool]
    forall a. a -> [a]
    repeat Bool
    False) [(Maybe (CDeclarator NodeInfo), Maybe CInit,
      Maybe (CExpression NodeInfo))]
    declrs
        typedef_spec :: Maybe [CDeclarationSpecifier NodeInfo]
    typedef_spec = [CDeclarationSpecifier NodeInfo]
    -> Maybe [CDeclarationSpecifier NodeInfo]
    hasTypeDef [CDeclarationSpecifier NodeInfo]
    declspecs

        analyseTyDef :: [CDeclarationSpecifier NodeInfo]
    -> Bool -> (Maybe (CDeclarator NodeInfo), Maybe a, Maybe a) -> m ()
    analyseTyDef [CDeclarationSpecifier NodeInfo]
    declspecs' Bool
    handle_sue_def (Maybe (CDeclarator NodeInfo), Maybe a, Maybe a)
    declr =
            case (Maybe (CDeclarator NodeInfo), Maybe a, Maybe a)
    declr of
                (Just CDeclarator NodeInfo
    tydeclr, Maybe a
    Nothing , Maybe a
    Nothing) -> Bool
    -> [CDeclarationSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> NodeInfo
    -> m ()
    forall (m :: * -> *).
    MonadTrav m =>
    Bool
    -> [CDeclarationSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> NodeInfo
    -> m ()
    analyseTypeDef Bool
    handle_sue_def [CDeclarationSpecifier NodeInfo]
    declspecs' CDeclarator NodeInfo
    tydeclr NodeInfo
    node
                (Maybe (CDeclarator NodeInfo), Maybe a, Maybe a)
    _ -> NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node [Char]
    "bad typdef declaration: bitfieldsize or initializer present"

        analyseVarDeclr :: ([CStorageSpecifier NodeInfo], [CAttribute NodeInfo],
     [CTypeQualifier NodeInfo], TypeSpecAnalysis,
     [CFunctionSpecifier NodeInfo])
    -> Bool
    -> (Maybe (CDeclarator NodeInfo), Maybe CInit, Maybe a)
    -> m ()
    analyseVarDeclr ([CStorageSpecifier NodeInfo], [CAttribute NodeInfo],
     [CTypeQualifier NodeInfo], TypeSpecAnalysis,
     [CFunctionSpecifier NodeInfo])
    specs Bool
    handle_sue_def (Just CDeclarator NodeInfo
    declr, Maybe CInit
    init_opt, Maybe a
    Nothing) = do
            -- analyse the declarator
            let ([CStorageSpecifier NodeInfo]
    storage_specs, [CAttribute NodeInfo]
    attrs, [CTypeQualifier NodeInfo]
    typequals, TypeSpecAnalysis
    canonTySpecs, [CFunctionSpecifier NodeInfo]
    inline) = ([CStorageSpecifier NodeInfo], [CAttribute NodeInfo],
     [CTypeQualifier NodeInfo], TypeSpecAnalysis,
     [CFunctionSpecifier NodeInfo])
    specs
            vardeclInfo@(VarDeclInfo _ _ _ _ typ _) <-
              Bool
    -> [CStorageSpecifier NodeInfo]
    -> [CAttribute NodeInfo]
    -> [CTypeQualifier NodeInfo]
    -> TypeSpecAnalysis
    -> [CFunctionSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> [CDeclaration NodeInfo]
    -> Maybe CInit
    -> m VarDeclInfo
    forall (m :: * -> *).
    MonadTrav m =>
    Bool
    -> [CStorageSpecifier NodeInfo]
    -> [CAttribute NodeInfo]
    -> [CTypeQualifier NodeInfo]
    -> TypeSpecAnalysis
    -> [CFunctionSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> [CDeclaration NodeInfo]
    -> Maybe CInit
    -> m VarDeclInfo
    analyseVarDecl Bool
    handle_sue_def [CStorageSpecifier NodeInfo]
    storage_specs [CAttribute NodeInfo]
    attrs [CTypeQualifier NodeInfo]
    typequals TypeSpecAnalysis
    canonTySpecs [CFunctionSpecifier NodeInfo]
    inline
                             CDeclarator NodeInfo
    declr [] Maybe CInit
    forall a. Maybe a
    Nothing
            -- declare / define the object
            if isFunctionType typ
                then extFunProto vardeclInfo
                else (if is_local then localVarDecl else extVarDecl)
                     -- XXX: if Initializer becomes different from CInit, this
                     -- will have to change.
                     vardeclInfo init_opt
            _init_opt' <- mapMaybeM init_opt (tInit typ)
            return ()
        analyseVarDeclr ([CStorageSpecifier NodeInfo], [CAttribute NodeInfo],
     [CTypeQualifier NodeInfo], TypeSpecAnalysis,
     [CFunctionSpecifier NodeInfo])
    _ Bool
    _ (Maybe (CDeclarator NodeInfo)
    Nothing,Maybe CInit
    _,Maybe a
    _)         = NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node [Char]
    "abstract declarator in object declaration"
        analyseVarDeclr ([CStorageSpecifier NodeInfo], [CAttribute NodeInfo],
     [CTypeQualifier NodeInfo], TypeSpecAnalysis,
     [CFunctionSpecifier NodeInfo])
    _ Bool
    _ (Maybe (CDeclarator NodeInfo)
    _,Maybe CInit
    _,Just a
    _bitfieldSz) = NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node [Char]
    "bitfield size in object declaration"

    -- | Analyse a typedef
    analyseTypeDef :: (MonadTrav m) => Bool -> [CDeclSpec] -> CDeclr -> NodeInfo -> m ()
    analyseTypeDef :: forall (m :: * -> *).
    MonadTrav m =>
    Bool
    -> [CDeclarationSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> NodeInfo
    -> m ()
    analyseTypeDef Bool
    handle_sue_def [CDeclarationSpecifier NodeInfo]
    declspecs CDeclarator NodeInfo
    declr NodeInfo
    node_info = do
        -- analyse the declarator
        (VarDeclInfo name fun_attrs storage_spec attrs ty _node) <- Bool
    -> [CDeclarationSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> [CDeclaration NodeInfo]
    -> Maybe CInit
    -> m VarDeclInfo
    forall (m :: * -> *).
    MonadTrav m =>
    Bool
    -> [CDeclarationSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> [CDeclaration NodeInfo]
    -> Maybe CInit
    -> m VarDeclInfo
    analyseVarDecl' Bool
    handle_sue_def [CDeclarationSpecifier NodeInfo]
    declspecs CDeclarator NodeInfo
    declr [] Maybe CInit
    forall a. Maybe a
    Nothing
        checkValidTypeDef fun_attrs storage_spec attrs
        when (isNoName name) $ astError node_info "NoName in analyseTypeDef"
        let ident = VarName -> Ident
    identOfVarName VarName
    name
        handleTypeDef (TypeDef ident ty attrs node_info)
        where
        checkValidTypeDef :: FunctionAttrs -> StorageSpec -> p -> m ()
    checkValidTypeDef FunctionAttrs
    fun_attrs  StorageSpec
    _ p
    _ | FunctionAttrs
    fun_attrs FunctionAttrs -> FunctionAttrs -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FunctionAttrs
    noFunctionAttrs =
                                             NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "inline specifier for typeDef"
        checkValidTypeDef FunctionAttrs
    _ StorageSpec
    NoStorageSpec p
    _ = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        checkValidTypeDef FunctionAttrs
    _ StorageSpec
    bad_storage p
    _ = NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "storage specified for typeDef: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ StorageSpec -> [Char]
    forall a. Show a => a -> [Char]
    show StorageSpec
    bad_storage

    -- | compute storage of a function definition
    --
    -- a function definition has static storage with internal linkage if specified `static`,
    -- the previously declared linkage if any if 'extern' or no specifier are present. (See C99 6.2.2, clause 5)
    --
    -- This function won't raise an Trav error if the declaration is incompatible with the existing one,
    -- this case is handled in 'handleFunDef'.
    computeFunDefStorage :: (MonadTrav m) => Ident -> StorageSpec -> m Storage
    computeFunDefStorage :: forall (m :: * -> *).
    MonadTrav m =>
    Ident -> StorageSpec -> m Storage
    computeFunDefStorage Ident
    _ (StaticSpec Bool
    _)  = Storage -> m Storage
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(Storage -> m Storage) -> Storage -> m Storage
    forall a b. (a -> b) -> a -> b
    $ Linkage -> Storage
    FunLinkage Linkage
    InternalLinkage
    computeFunDefStorage Ident
    ident StorageSpec
    other_spec  = do
      obj_opt <- Ident -> m (Maybe IdentDecl)
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Ident -> m (Maybe IdentDecl)
    lookupObject Ident
    ident
      let defaultSpec = Linkage -> Storage
    FunLinkage Linkage
    ExternalLinkage
      case other_spec of
        StorageSpec
    NoStorageSpec  -> Storage -> m Storage
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(Storage -> m Storage) -> Storage -> m Storage
    forall a b. (a -> b) -> a -> b
    $ Storage -> (IdentDecl -> Storage) -> Maybe IdentDecl -> Storage
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Storage
    defaultSpec IdentDecl -> Storage
    forall d. Declaration d => d -> Storage
    declStorage Maybe IdentDecl
    obj_opt
        StorageSpec
    ClKernelSpec  -> Storage -> m Storage
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(Storage -> m Storage) -> Storage -> m Storage
    forall a b. (a -> b) -> a -> b
    $ Storage -> (IdentDecl -> Storage) -> Maybe IdentDecl -> Storage
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Storage
    defaultSpec IdentDecl -> Storage
    forall d. Declaration d => d -> Storage
    declStorage Maybe IdentDecl
    obj_opt
        (ExternSpec Bool
    False) -> Storage -> m Storage
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(Storage -> m Storage) -> Storage -> m Storage
    forall a b. (a -> b) -> a -> b
    $ Storage -> (IdentDecl -> Storage) -> Maybe IdentDecl -> Storage
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Storage
    defaultSpec IdentDecl -> Storage
    forall d. Declaration d => d -> Storage
    declStorage Maybe IdentDecl
    obj_opt
        StorageSpec
    bad_spec -> BadSpecifierError -> m Storage
    forall e a. Error e => e -> m a
    forall (m :: * -> *) e a. (MonadCError m, Error e) => e -> m a
    throwTravError (BadSpecifierError -> m Storage) -> BadSpecifierError -> m Storage
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> BadSpecifierError
    badSpecifierError (Ident -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo Ident
    ident)
                      ([Char] -> BadSpecifierError) -> [Char] -> BadSpecifierError
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "unexpected function storage specifier (only static or extern is allowed)" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ StorageSpec -> [Char]
    forall a. Show a => a -> [Char]
    show StorageSpec
    bad_spec

    -- (private) Get parameters of a function type
    getParams :: Type -> Maybe [ParamDecl]
    getParams :: Type -> Maybe [ParamDecl]
    getParams (FunctionType (FunType Type
    _ [ParamDecl]
    params Bool
    _) Attributes
    _) = [ParamDecl] -> Maybe [ParamDecl]
    forall a. a -> Maybe a
    Just [ParamDecl]
    params
    getParams Type
    _ = Maybe [ParamDecl]
    forall a. Maybe a
    Nothing

    -- | handle a function prototype
    extFunProto :: (MonadTrav m) => VarDeclInfo -> m ()
    extFunProto :: forall (m :: * -> *). MonadTrav m => VarDeclInfo -> m ()
    extFunProto (VarDeclInfo VarName
    var_name FunctionAttrs
    fun_spec StorageSpec
    storage_spec Attributes
    attrs Type
    ty NodeInfo
    node_info) =
        do  Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (VarName -> Bool
    isNoName VarName
    var_name) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "NoName in extFunProto"
            old_fun <- Ident -> m (Maybe IdentDecl)
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Ident -> m (Maybe IdentDecl)
    lookupObject (VarName -> Ident
    identOfVarName VarName
    var_name)
            checkValidSpecs
            let decl = VarName -> DeclAttrs -> Type -> VarDecl
    VarDecl VarName
    var_name (FunctionAttrs -> Storage -> Attributes -> DeclAttrs
    DeclAttrs FunctionAttrs
    fun_spec (Maybe IdentDecl -> Storage
    forall {d}. Declaration d => Maybe d -> Storage
    funDeclLinkage Maybe IdentDecl
    old_fun) Attributes
    attrs) Type
    ty
            handleVarDecl False (Decl decl node_info)
            -- XXX: structs should be handled in 'function prototype scope' too
            enterPrototypeScope
            maybe (return ()) (mapM_ handleParamDecl) (getParams ty)
            leavePrototypeScope
        where
        funDeclLinkage :: Maybe d -> Storage
    funDeclLinkage Maybe d
    old_fun =
            case StorageSpec
    storage_spec of
                StorageSpec
    NoStorageSpec    -> Linkage -> Storage
    FunLinkage Linkage
    ExternalLinkage -- prototype declaration / external linkage
                StaticSpec Bool
    False -> Linkage -> Storage
    FunLinkage Linkage
    InternalLinkage -- prototype declaration / internal linkage
                ExternSpec Bool
    False -> case Maybe d
    old_fun of
                                        Maybe d
    Nothing -> Linkage -> Storage
    FunLinkage Linkage
    ExternalLinkage
                                        Just d
    f  -> d -> Storage
    forall d. Declaration d => d -> Storage
    declStorage d
    f
                StorageSpec
    _ -> [Char] -> Storage
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Storage) -> [Char] -> Storage
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "funDeclLinkage: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ StorageSpec -> [Char]
    forall a. Show a => a -> [Char]
    show StorageSpec
    storage_spec
        checkValidSpecs :: m ()
    checkValidSpecs
            | StorageSpec -> Bool
    hasThreadLocalSpec StorageSpec
    storage_spec = NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "thread local storage specified for function"
            | StorageSpec
    RegSpec <- StorageSpec
    storage_spec         = NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "invalid `register' storage specified for function"
            | Bool
    otherwise                       = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | handle a object declaration \/ definition
    --
    -- We have to check the storage specifiers here, as they determine wheter we're dealing with decalartions
    -- or definitions
    -- see [http://www.sivity.net/projects/language.c/wiki/ExternalDefinitions]
    extVarDecl :: (MonadTrav m) => VarDeclInfo -> Maybe Initializer -> m ()
    extVarDecl :: forall (m :: * -> *).
    MonadTrav m =>
    VarDeclInfo -> Maybe CInit -> m ()
    extVarDecl (VarDeclInfo VarName
    var_name FunctionAttrs
    fun_spec StorageSpec
    storage_spec Attributes
    attrs Type
    typ NodeInfo
    node_info) Maybe CInit
    init_opt =
        do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (VarName -> Bool
    isNoName VarName
    var_name) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "NoName in extVarDecl"
           (storage,is_def) <- StorageSpec -> m (Storage, Bool)
    forall {m :: * -> *}.
    (MonadCError m, MonadSymtab m) =>
    StorageSpec -> m (Storage, Bool)
    globalStorage StorageSpec
    storage_spec
           let vardecl = VarName -> DeclAttrs -> Type -> VarDecl
    VarDecl VarName
    var_name (FunctionAttrs -> Storage -> Attributes -> DeclAttrs
    DeclAttrs FunctionAttrs
    fun_spec Storage
    storage Attributes
    attrs) Type
    typ
           if is_def
               then handleObjectDef False ident $ ObjDef vardecl init_opt node_info
               else handleVarDecl False $ Decl vardecl node_info
        where
           ident :: Ident
    ident = VarName -> Ident
    identOfVarName VarName
    var_name
           globalStorage :: StorageSpec -> m (Storage, Bool)
    globalStorage StorageSpec
    _ | FunctionAttrs
    fun_spec FunctionAttrs -> FunctionAttrs -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FunctionAttrs
    noFunctionAttrs =
                               NodeInfo -> [Char] -> m (Storage, Bool)
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "invalid function specifier for external variable"
           globalStorage StorageSpec
    AutoSpec      = NodeInfo -> [Char] -> m (Storage, Bool)
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "file-scope declaration specifies storage `auto'"
           globalStorage StorageSpec
    RegSpec       =
             do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe CInit -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe CInit
    init_opt) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "initializer given for global register variable"
                case VarName
    var_name of
                  VarName
    NoName -> NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "global register variable has no name"
                  VarName Ident
    _ Maybe (CStringLiteral NodeInfo)
    Nothing -> NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "no register specified for global register variable"
                  VarName
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                dt <- m DefTable
    forall (m :: * -> *). MonadSymtab m => m DefTable
    getDefTable
                when (hasFunDef dt) $ astError node_info "global register variable appears after a function definition"
                return (Static InternalLinkage False, False)
           -- tentative if there is no initializer, external
           globalStorage StorageSpec
    NoStorageSpec = (Storage, Bool) -> m (Storage, Bool)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Linkage -> Bool -> Storage
    Static Linkage
    ExternalLinkage Bool
    False, Bool
    True)
           globalStorage StorageSpec
    ThreadSpec    = (Storage, Bool) -> m (Storage, Bool)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Linkage -> Bool -> Storage
    Static Linkage
    ExternalLinkage Bool
    True, Bool
    True)
           -- tentative if there is no initializer, internal
           globalStorage (StaticSpec Bool
    thread_local) = (Storage, Bool) -> m (Storage, Bool)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Linkage -> Bool -> Storage
    Static Linkage
    InternalLinkage Bool
    thread_local, Bool
    True)
           globalStorage (ExternSpec Bool
    thread_local) =
               case Maybe CInit
    init_opt of
                   -- declaration with either external or old storage
                   Maybe CInit
    Nothing -> do old_decl <- Ident -> m (Maybe IdentDecl)
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Ident -> m (Maybe IdentDecl)
    lookupObject Ident
    ident
                                 return (maybe (Static ExternalLinkage thread_local) declStorage old_decl,False)
                   -- warning, external definition
                   Just CInit
    _  -> do BadSpecifierError -> m ()
    forall e (m :: * -> *). (Error e, MonadCError m) => e -> m ()
    warn (BadSpecifierError -> m ()) -> BadSpecifierError -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> BadSpecifierError
    badSpecifierError NodeInfo
    node_info [Char]
    "Both initializer and `extern` specifier given - treating as definition"
                                 (Storage, Bool) -> m (Storage, Bool)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Linkage -> Bool -> Storage
    Static Linkage
    ExternalLinkage Bool
    thread_local, Bool
    True)
           hasFunDef :: DefTable -> Bool
    hasFunDef DefTable
    dt = ((Ident, IdentDecl) -> Bool) -> [(Ident, IdentDecl)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (IdentDecl -> Bool
    isFuncDef (IdentDecl -> Bool)
    -> ((Ident, IdentDecl) -> IdentDecl) -> (Ident, IdentDecl) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Ident, IdentDecl) -> IdentDecl
    forall a b. (a, b) -> b
    snd) (Map Ident IdentDecl -> [(Ident, IdentDecl)]
    forall k a. Map k a -> [(k, a)]
    Map.toList (Map Ident IdentDecl -> [(Ident, IdentDecl)])
    -> Map Ident IdentDecl -> [(Ident, IdentDecl)]
    forall a b. (a -> b) -> a -> b
    $ GlobalDecls -> Map Ident IdentDecl
    gObjs (GlobalDecls -> Map Ident IdentDecl)
    -> GlobalDecls -> Map Ident IdentDecl
    forall a b. (a -> b) -> a -> b
    $ DefTable -> GlobalDecls
    globalDefs DefTable
    dt)
           isFuncDef :: IdentDecl -> Bool
    isFuncDef (FunctionDef FunDef
    fd) = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ (FunctionAttrs -> Bool
    isInline (FunctionAttrs -> Bool)
    -> (FunDef -> FunctionAttrs) -> FunDef -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FunDef -> FunctionAttrs
    forall d. Declaration d => d -> FunctionAttrs
    functionAttrs) FunDef
    fd
           isFuncDef IdentDecl
    _ = Bool
    False

    -- | handle a function-scope object declaration \/ definition
    -- see [http://www.sivity.net/projects/language.c/wiki/LocalDefinitions]
    localVarDecl :: (MonadTrav m) => VarDeclInfo -> Maybe Initializer -> m ()
    localVarDecl :: forall (m :: * -> *).
    MonadTrav m =>
    VarDeclInfo -> Maybe CInit -> m ()
    localVarDecl (VarDeclInfo VarName
    var_name FunctionAttrs
    fun_attrs StorageSpec
    storage_spec Attributes
    attrs Type
    typ NodeInfo
    node_info) Maybe CInit
    init_opt =
        do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (VarName -> Bool
    isNoName VarName
    var_name) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "NoName in localVarDecl"
           (storage,is_def) <- StorageSpec -> m (Storage, Bool)
    forall {m :: * -> *}.
    (MonadCError m, MonadSymtab m) =>
    StorageSpec -> m (Storage, Bool)
    localStorage StorageSpec
    storage_spec
           let vardecl = VarName -> DeclAttrs -> Type -> VarDecl
    VarDecl VarName
    var_name (FunctionAttrs -> Storage -> Attributes -> DeclAttrs
    DeclAttrs FunctionAttrs
    fun_attrs Storage
    storage Attributes
    attrs) Type
    typ
           if is_def
               then handleObjectDef True ident (ObjDef vardecl init_opt node_info)
               else handleVarDecl True (Decl vardecl node_info)
        where
        ident :: Ident
    ident = VarName -> Ident
    identOfVarName VarName
    var_name
        localStorage :: StorageSpec -> m (Storage, Bool)
    localStorage StorageSpec
    NoStorageSpec = (Storage, Bool) -> m (Storage, Bool)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Storage
    Auto Bool
    False,Bool
    True)
        localStorage StorageSpec
    ThreadSpec    = (Storage, Bool) -> m (Storage, Bool)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Storage
    Auto Bool
    True,Bool
    True)
        localStorage StorageSpec
    RegSpec = (Storage, Bool) -> m (Storage, Bool)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Storage
    Auto Bool
    True,Bool
    True)
        -- static no linkage
        localStorage (StaticSpec Bool
    thread_local) =
          (Storage, Bool) -> m (Storage, Bool)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Linkage -> Bool -> Storage
    Static Linkage
    NoLinkage Bool
    thread_local,Bool
    True)
        localStorage (ExternSpec Bool
    thread_local)
          | Maybe CInit -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe CInit
    init_opt = NodeInfo -> [Char] -> m (Storage, Bool)
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "extern keyword and initializer for local"
          | Bool
    otherwise =
              do old_decl <- Ident -> m (Maybe IdentDecl)
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Ident -> m (Maybe IdentDecl)
    lookupObject Ident
    ident
                 return (maybe (Static ExternalLinkage thread_local) declStorage old_decl,False)
        localStorage StorageSpec
    _ = NodeInfo -> [Char] -> m (Storage, Bool)
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    node_info [Char]
    "bad storage specifier for local"

    defineParams :: MonadTrav m => NodeInfo -> VarDecl -> m ()
    defineParams :: forall (m :: * -> *). MonadTrav m => NodeInfo -> VarDecl -> m ()
    defineParams NodeInfo
    ni VarDecl
    decl =
      case Type -> Maybe [ParamDecl]
    getParams (VarDecl -> Type
    forall n. Declaration n => n -> Type
    declType VarDecl
    decl) of
        Maybe [ParamDecl]
    Nothing -> NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni
                   [Char]
    "expecting complete function type in function definition"
        Just [ParamDecl]
    params -> (ParamDecl -> m ()) -> [ParamDecl] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ParamDecl -> m ()
    forall (m :: * -> *). MonadTrav m => ParamDecl -> m ()
    handleParamDecl [ParamDecl]
    params

    analyseFunctionBody :: (MonadTrav m) => NodeInfo -> VarDecl -> CStat -> m Stmt
    analyseFunctionBody :: forall (m :: * -> *).
    MonadTrav m =>
    NodeInfo
    -> VarDecl -> CStatement NodeInfo -> m (CStatement NodeInfo)
    analyseFunctionBody NodeInfo
    node_info VarDecl
    decl s :: CStatement NodeInfo
    s@(CCompound [Ident]
    localLabels [CCompoundBlockItem NodeInfo]
    items NodeInfo
    _) =
      do m ()
    forall (m :: * -> *). MonadSymtab m => m ()
    enterFunctionScope
         (Ident -> m (DeclarationStatus Ident)) -> [Ident] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((DefTable -> (DeclarationStatus Ident, DefTable))
    -> m (DeclarationStatus Ident)
    forall a. (DefTable -> (a, DefTable)) -> m a
    forall (m :: * -> *) a.
    MonadSymtab m =>
    (DefTable -> (a, DefTable)) -> m a
    withDefTable ((DefTable -> (DeclarationStatus Ident, DefTable))
     -> m (DeclarationStatus Ident))
    -> (Ident -> DefTable -> (DeclarationStatus Ident, DefTable))
    -> Ident
    -> m (DeclarationStatus Ident)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> DefTable -> (DeclarationStatus Ident, DefTable)
    defineLabel) ([Ident]
    localLabels [Ident] -> [Ident] -> [Ident]
    forall a. [a] -> [a] -> [a]
    ++ CStatement NodeInfo -> [Ident]
    getLabels CStatement NodeInfo
    s)
         NodeInfo -> VarDecl -> m ()
    forall (m :: * -> *). MonadTrav m => NodeInfo -> VarDecl -> m ()
    defineParams NodeInfo
    node_info VarDecl
    decl
         -- record parameters
         (CCompoundBlockItem NodeInfo -> m Type)
    -> [CCompoundBlockItem NodeInfo] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ([StmtCtx] -> CCompoundBlockItem NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CCompoundBlockItem NodeInfo -> m Type
    tBlockItem [VarDecl -> StmtCtx
    FunCtx VarDecl
    decl]) [CCompoundBlockItem NodeInfo]
    items
         m ()
    forall (m :: * -> *). MonadSymtab m => m ()
    leaveFunctionScope
         CStatement NodeInfo -> m (CStatement NodeInfo)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CStatement NodeInfo
    s -- XXX: bogus

    analyseFunctionBody NodeInfo
    _ VarDecl
    _ CStatement NodeInfo
    s = NodeInfo -> [Char] -> m (CStatement NodeInfo)
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError (CStatement NodeInfo -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CStatement NodeInfo
    s) [Char]
    "Function body is no compound statement"

    data StmtCtx = FunCtx VarDecl
                 | LoopCtx
                 | SwitchCtx

    -- | Given a context, determine the type declaration for the enclosing
    --   function, if possible, given a context.
    enclosingFunctionType :: [StmtCtx] -> Maybe Type
    enclosingFunctionType :: [StmtCtx] -> Maybe Type
    enclosingFunctionType [] = Maybe Type
    forall a. Maybe a
    Nothing
    enclosingFunctionType (FunCtx VarDecl
    vd : [StmtCtx]
    _) = Type -> Maybe Type
    forall a. a -> Maybe a
    Just (Type -> Maybe Type) -> Type -> Maybe Type
    forall a b. (a -> b) -> a -> b
    $ VarDecl -> Type
    forall n. Declaration n => n -> Type
    declType VarDecl
    vd
    enclosingFunctionType (StmtCtx
    _ : [StmtCtx]
    cs) = [StmtCtx] -> Maybe Type
    enclosingFunctionType [StmtCtx]
    cs

    inLoop :: [StmtCtx] -> Bool
    inLoop :: [StmtCtx] -> Bool
    inLoop [StmtCtx]
    c = (StmtCtx -> Bool) -> [StmtCtx] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any StmtCtx -> Bool
    isLoop [StmtCtx]
    c
      where isLoop :: StmtCtx -> Bool
    isLoop StmtCtx
    LoopCtx = Bool
    True
            isLoop StmtCtx
    _ = Bool
    False

    inSwitch :: [StmtCtx] -> Bool
    inSwitch :: [StmtCtx] -> Bool
    inSwitch [StmtCtx]
    c = (StmtCtx -> Bool) -> [StmtCtx] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any StmtCtx -> Bool
    isSwitch [StmtCtx]
    c
      where isSwitch :: StmtCtx -> Bool
    isSwitch StmtCtx
    SwitchCtx = Bool
    True
            isSwitch StmtCtx
    _ = Bool
    False

    data ExprSide = LValue | RValue
                    deriving (ExprSide -> ExprSide -> Bool
    (ExprSide -> ExprSide -> Bool)
    -> (ExprSide -> ExprSide -> Bool) -> Eq ExprSide
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ExprSide -> ExprSide -> Bool
    == :: ExprSide -> ExprSide -> Bool
    $c/= :: ExprSide -> ExprSide -> Bool
    /= :: ExprSide -> ExprSide -> Bool
    Eq, Int -> ExprSide -> [Char] -> [Char]
    [ExprSide] -> [Char] -> [Char]
    ExprSide -> [Char]
    (Int -> ExprSide -> [Char] -> [Char])
    -> (ExprSide -> [Char])
    -> ([ExprSide] -> [Char] -> [Char])
    -> Show ExprSide
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> ExprSide -> [Char] -> [Char]
    showsPrec :: Int -> ExprSide -> [Char] -> [Char]
    $cshow :: ExprSide -> [Char]
    show :: ExprSide -> [Char]
    $cshowList :: [ExprSide] -> [Char] -> [Char]
    showList :: [ExprSide] -> [Char] -> [Char]
    Show)

    -- | Typecheck a statement, given a statement context. The type of a
    --   statement is usually @void@, but expression statements and blocks
    --   can sometimes have other types.
    tStmt :: MonadTrav m => [StmtCtx] -> CStat -> m Type
    tStmt :: forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt [StmtCtx]
    c (CLabel Ident
    _ CStatement NodeInfo
    s [CAttribute NodeInfo]
    _ NodeInfo
    _)         = [StmtCtx] -> CStatement NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt [StmtCtx]
    c CStatement NodeInfo
    s
    tStmt [StmtCtx]
    c (CExpr Maybe (CExpression NodeInfo)
    e NodeInfo
    _)              =
      m Type
    -> (CExpression NodeInfo -> m Type)
    -> Maybe (CExpression NodeInfo)
    -> m Type
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    voidType) ([StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue) Maybe (CExpression NodeInfo)
    e
    tStmt [StmtCtx]
    c (CCompound [Ident]
    ls [CCompoundBlockItem NodeInfo]
    body NodeInfo
    _)    =
      do m ()
    forall (m :: * -> *). MonadSymtab m => m ()
    enterBlockScope
         (Ident -> m (DeclarationStatus Ident)) -> [Ident] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((DefTable -> (DeclarationStatus Ident, DefTable))
    -> m (DeclarationStatus Ident)
    forall a. (DefTable -> (a, DefTable)) -> m a
    forall (m :: * -> *) a.
    MonadSymtab m =>
    (DefTable -> (a, DefTable)) -> m a
    withDefTable ((DefTable -> (DeclarationStatus Ident, DefTable))
     -> m (DeclarationStatus Ident))
    -> (Ident -> DefTable -> (DeclarationStatus Ident, DefTable))
    -> Ident
    -> m (DeclarationStatus Ident)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> DefTable -> (DeclarationStatus Ident, DefTable)
    defineLabel) [Ident]
    ls
         t <- (Type -> CCompoundBlockItem NodeInfo -> m Type)
    -> Type -> [CCompoundBlockItem NodeInfo] -> m Type
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM ((CCompoundBlockItem NodeInfo -> m Type)
    -> Type -> CCompoundBlockItem NodeInfo -> m Type
    forall a b. a -> b -> a
    const ((CCompoundBlockItem NodeInfo -> m Type)
     -> Type -> CCompoundBlockItem NodeInfo -> m Type)
    -> (CCompoundBlockItem NodeInfo -> m Type)
    -> Type
    -> CCompoundBlockItem NodeInfo
    -> m Type
    forall a b. (a -> b) -> a -> b
    $ [StmtCtx] -> CCompoundBlockItem NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CCompoundBlockItem NodeInfo -> m Type
    tBlockItem [StmtCtx]
    c) Type
    voidType [CCompoundBlockItem NodeInfo]
    body
         leaveBlockScope
         return t
    tStmt [StmtCtx]
    c (CIf CExpression NodeInfo
    e CStatement NodeInfo
    sthen Maybe (CStatement NodeInfo)
    selse NodeInfo
    _)    =
      [StmtCtx] -> CExpression NodeInfo -> m ()
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CExpression NodeInfo -> m ()
    checkGuard [StmtCtx]
    c CExpression NodeInfo
    e m () -> m Type -> m Type
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [StmtCtx] -> CStatement NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt [StmtCtx]
    c CStatement NodeInfo
    sthen
                     m Type -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> m ()
    -> (CStatement NodeInfo -> m ())
    -> Maybe (CStatement NodeInfo)
    -> m ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) (m Type -> m ()
    forall (m :: * -> *) a. Monad m => m a -> m ()
    voidM (m Type -> m ())
    -> (CStatement NodeInfo -> m Type) -> CStatement NodeInfo -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [StmtCtx] -> CStatement NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt [StmtCtx]
    c) Maybe (CStatement NodeInfo)
    selse
                     m () -> m Type -> m Type
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    voidType
    tStmt [StmtCtx]
    c (CSwitch CExpression NodeInfo
    e CStatement NodeInfo
    s NodeInfo
    ni)         =
      [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e m Type -> (Type -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= NodeInfo -> Type -> m ()
    forall (m :: * -> *). MonadCError m => NodeInfo -> Type -> m ()
    checkIntegral' NodeInfo
    ni m () -> m Type -> m Type
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
      [StmtCtx] -> CStatement NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt (StmtCtx
    SwitchCtx StmtCtx -> [StmtCtx] -> [StmtCtx]
    forall a. a -> [a] -> [a]
    : [StmtCtx]
    c) CStatement NodeInfo
    s
    tStmt [StmtCtx]
    c (CWhile CExpression NodeInfo
    e CStatement NodeInfo
    s Bool
    _ NodeInfo
    _)         =
      [StmtCtx] -> CExpression NodeInfo -> m ()
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CExpression NodeInfo -> m ()
    checkGuard [StmtCtx]
    c CExpression NodeInfo
    e m () -> m Type -> m Type
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [StmtCtx] -> CStatement NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt (StmtCtx
    LoopCtx StmtCtx -> [StmtCtx] -> [StmtCtx]
    forall a. a -> [a] -> [a]
    : [StmtCtx]
    c) CStatement NodeInfo
    s
    tStmt [StmtCtx]
    _ (CGoto Ident
    l NodeInfo
    ni)             =
      do dt <- m DefTable
    forall (m :: * -> *). MonadSymtab m => m DefTable
    getDefTable
         case lookupLabel l dt of
           Just Ident
    _ -> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    voidType
           Maybe Ident
    Nothing -> NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni ([Char] -> m Type) -> [Char] -> m Type
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "undefined label in goto: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Ident -> [Char]
    identToString Ident
    l
    tStmt [StmtCtx]
    c (CCont NodeInfo
    ni)               =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([StmtCtx] -> Bool
    inLoop [StmtCtx]
    c) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni [Char]
    "continue statement outside of loop"
         Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    voidType
    tStmt [StmtCtx]
    c (CBreak NodeInfo
    ni)              =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([StmtCtx] -> Bool
    inLoop [StmtCtx]
    c Bool -> Bool -> Bool
    || [StmtCtx] -> Bool
    inSwitch [StmtCtx]
    c) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni [Char]
    "break statement outside of loop or switch statement"
         Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    voidType
    tStmt [StmtCtx]
    c (CReturn (Just CExpression NodeInfo
    e) NodeInfo
    ni)    =
      do t <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e
         rt <- case enclosingFunctionType c of
                 Just (FunctionType (FunType Type
    rt [ParamDecl]
    _ Bool
    _) Attributes
    _) -> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    rt
                 Just (FunctionType (FunTypeIncomplete Type
    rt) Attributes
    _) -> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    rt
                 Just Type
    ft -> NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni ([Char] -> m Type) -> [Char] -> m Type
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "bad function type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    pType Type
    ft
                 Maybe Type
    Nothing -> NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni [Char]
    "return statement outside function"
         case (rt, t) of
           -- apparently it's ok to return void from a void function?
           (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _, DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
           (Type, Type)
    _ -> NodeInfo -> CAssignOp -> Type -> Type -> m ()
    forall (m :: * -> *).
    MonadCError m =>
    NodeInfo -> CAssignOp -> Type -> Type -> m ()
    assignCompatible' NodeInfo
    ni CAssignOp
    CAssignOp Type
    rt Type
    t
         return voidType
    tStmt [StmtCtx]
    _ (CReturn Maybe (CExpression NodeInfo)
    Nothing NodeInfo
    _)      = Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    voidType
    -- XXX: anything to do for assembly?
    tStmt [StmtCtx]
    _ (CAsm CAssemblyStatement NodeInfo
    _ NodeInfo
    _)               = Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    voidType
    tStmt [StmtCtx]
    c (CCase CExpression NodeInfo
    e CStatement NodeInfo
    s NodeInfo
    ni)           =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([StmtCtx] -> Bool
    inSwitch [StmtCtx]
    c) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni [Char]
    "case statement outside of switch statement"
         [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e m Type -> (Type -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= NodeInfo -> Type -> m ()
    forall (m :: * -> *). MonadCError m => NodeInfo -> Type -> m ()
    checkIntegral' NodeInfo
    ni
         [StmtCtx] -> CStatement NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt [StmtCtx]
    c CStatement NodeInfo
    s
    tStmt [StmtCtx]
    c (CCases CExpression NodeInfo
    e1 CExpression NodeInfo
    e2 CStatement NodeInfo
    s NodeInfo
    ni)      =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([StmtCtx] -> Bool
    inSwitch [StmtCtx]
    c) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni [Char]
    "case statement outside of switch statement"
         [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e1 m Type -> (Type -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= NodeInfo -> Type -> m ()
    forall (m :: * -> *). MonadCError m => NodeInfo -> Type -> m ()
    checkIntegral' NodeInfo
    ni
         [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e2 m Type -> (Type -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= NodeInfo -> Type -> m ()
    forall (m :: * -> *). MonadCError m => NodeInfo -> Type -> m ()
    checkIntegral' NodeInfo
    ni
         [StmtCtx] -> CStatement NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt [StmtCtx]
    c CStatement NodeInfo
    s
    tStmt [StmtCtx]
    c (CDefault CStatement NodeInfo
    s NodeInfo
    ni)          =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([StmtCtx] -> Bool
    inSwitch [StmtCtx]
    c) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni [Char]
    "default statement outside of switch statement"
         [StmtCtx] -> CStatement NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt [StmtCtx]
    c CStatement NodeInfo
    s
    tStmt [StmtCtx]
    c (CFor Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
    i Maybe (CExpression NodeInfo)
    g Maybe (CExpression NodeInfo)
    inc CStatement NodeInfo
    s NodeInfo
    _)       =
      do m ()
    forall (m :: * -> *). MonadSymtab m => m ()
    enterBlockScope
         (Maybe (CExpression NodeInfo) -> m ())
    -> (CDeclaration NodeInfo -> m ())
    -> Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
    -> m ()
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (m ()
    -> (CExpression NodeInfo -> m ())
    -> Maybe (CExpression NodeInfo)
    -> m ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) CExpression NodeInfo -> m ()
    forall {m :: * -> *}. MonadTrav m => CExpression NodeInfo -> m ()
    checkExpr) (Bool -> CDeclaration NodeInfo -> m ()
    forall (m :: * -> *).
    MonadTrav m =>
    Bool -> CDeclaration NodeInfo -> m ()
    analyseDecl Bool
    True) Either (Maybe (CExpression NodeInfo)) (CDeclaration NodeInfo)
    i
         m ()
    -> (CExpression NodeInfo -> m ())
    -> Maybe (CExpression NodeInfo)
    -> m ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) ([StmtCtx] -> CExpression NodeInfo -> m ()
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CExpression NodeInfo -> m ()
    checkGuard [StmtCtx]
    c) Maybe (CExpression NodeInfo)
    g
         m ()
    -> (CExpression NodeInfo -> m ())
    -> Maybe (CExpression NodeInfo)
    -> m ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) CExpression NodeInfo -> m ()
    forall {m :: * -> *}. MonadTrav m => CExpression NodeInfo -> m ()
    checkExpr Maybe (CExpression NodeInfo)
    inc
         _ <- [StmtCtx] -> CStatement NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt (StmtCtx
    LoopCtx StmtCtx -> [StmtCtx] -> [StmtCtx]
    forall a. a -> [a] -> [a]
    : [StmtCtx]
    c) CStatement NodeInfo
    s
         leaveBlockScope
         return voidType
      where checkExpr :: CExpression NodeInfo -> m ()
    checkExpr CExpression NodeInfo
    e = m Type -> m ()
    forall (m :: * -> *) a. Monad m => m a -> m ()
    voidM(m Type -> m ()) -> m Type -> m ()
    forall a b. (a -> b) -> a -> b
    $ [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e
    tStmt [StmtCtx]
    c (CGotoPtr CExpression NodeInfo
    e NodeInfo
    ni)          =
      do t <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e
         case t of
           (PtrType Type
    _ TypeQuals
    _ Attributes
    _) -> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    voidType
           Type
    _               -> NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni [Char]
    "can't goto non-pointer"

    -- | Typecheck a block item. When statement expressions are blocks,
    --   they have the type of their last expression statement, so this
    --   needs to return a type.
    tBlockItem :: MonadTrav m => [StmtCtx] -> CBlockItem -> m Type
    tBlockItem :: forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CCompoundBlockItem NodeInfo -> m Type
    tBlockItem [StmtCtx]
    c (CBlockStmt CStatement NodeInfo
    s) = [StmtCtx] -> CStatement NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt [StmtCtx]
    c CStatement NodeInfo
    s
    tBlockItem [StmtCtx]
    _ (CBlockDecl CDeclaration NodeInfo
    d) = Bool -> CDeclaration NodeInfo -> m ()
    forall (m :: * -> *).
    MonadTrav m =>
    Bool -> CDeclaration NodeInfo -> m ()
    analyseDecl Bool
    True CDeclaration NodeInfo
    d m () -> m Type -> m Type
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    voidType
    -- TODO: fixup analyseFunDef to handle nested functions
    tBlockItem [StmtCtx]
    _ (CNestedFunDef CFunctionDef NodeInfo
    fd) = CFunctionDef NodeInfo -> m ()
    forall (m :: * -> *). MonadTrav m => CFunctionDef NodeInfo -> m ()
    analyseFunDef CFunctionDef NodeInfo
    fd m () -> m Type -> m Type
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    voidType

    checkGuard :: MonadTrav m => [StmtCtx] -> CExpr -> m ()
    checkGuard :: forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CExpression NodeInfo -> m ()
    checkGuard [StmtCtx]
    c CExpression NodeInfo
    e = [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e m Type -> (Type -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= NodeInfo -> Type -> m ()
    forall (m :: * -> *). MonadCError m => NodeInfo -> Type -> m ()
    checkScalar' (CExpression NodeInfo -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CExpression NodeInfo
    e)

    -- XXX: this is bogus, correct only for IA32. We should eventually
    -- have a collection of these and allow people to choose one.
    defaultMD :: MachineDesc
    defaultMD :: MachineDesc
    defaultMD =
      MachineDesc
      { iSize :: IntType -> Integer
    iSize = \IntType
    it ->
                case IntType
    it of
                  IntType
    TyBool    -> Integer
    1
                  IntType
    TyChar    -> Integer
    1
                  IntType
    TySChar   -> Integer
    1
                  IntType
    TyUChar   -> Integer
    1
                  IntType
    TyShort   -> Integer
    2
                  IntType
    TyUShort  -> Integer
    2
                  IntType
    TyInt     -> Integer
    4
                  IntType
    TyUInt    -> Integer
    4
                  IntType
    TyLong    -> Integer
    4
                  IntType
    TyULong   -> Integer
    4
                  IntType
    TyLLong   -> Integer
    8
                  IntType
    TyULLong  -> Integer
    8
                  IntType
    TyInt128  -> Integer
    16
                  IntType
    TyUInt128 -> Integer
    16
      , fSize :: FloatType -> Integer
    fSize = \FloatType
    ft ->
                case FloatType
    ft of
                  FloatType
    TyFloat   -> Integer
    4
                  FloatType
    TyDouble  -> Integer
    8
                  FloatType
    TyLDouble -> Integer
    16
      , builtinSize :: BuiltinType -> Integer
    builtinSize = \BuiltinType
    bt ->
                      case BuiltinType
    bt of
                        BuiltinType
    TyVaList -> Integer
    4
                        BuiltinType
    TyAny    -> Integer
    4
      , ptrSize :: Integer
    ptrSize = Integer
    4
      , voidSize :: Integer
    voidSize = Integer
    1
      , iAlign :: IntType -> Integer
    iAlign = \IntType
    it ->
                 case IntType
    it of
                   IntType
    TyBool    -> Integer
    1
                   IntType
    TyChar    -> Integer
    1
                   IntType
    TySChar   -> Integer
    1
                   IntType
    TyUChar   -> Integer
    1
                   IntType
    TyShort   -> Integer
    2
                   IntType
    TyUShort  -> Integer
    2
                   IntType
    TyInt     -> Integer
    4
                   IntType
    TyUInt    -> Integer
    4
                   IntType
    TyLong    -> Integer
    4
                   IntType
    TyULong   -> Integer
    4
                   IntType
    TyLLong   -> Integer
    8
                   IntType
    TyULLong  -> Integer
    8
                   IntType
    TyInt128  -> Integer
    16
                   IntType
    TyUInt128 -> Integer
    16
      , fAlign :: FloatType -> Integer
    fAlign = \FloatType
    ft ->
                 case FloatType
    ft of
                   FloatType
    TyFloat   -> Integer
    4
                   FloatType
    TyDouble  -> Integer
    8
                   FloatType
    TyLDouble -> Integer
    16
      , builtinAlign :: BuiltinType -> Integer
    builtinAlign = \BuiltinType
    bt ->
                       case BuiltinType
    bt of
                         BuiltinType
    TyVaList -> Integer
    4
                         BuiltinType
    TyAny    -> Integer
    4
      , ptrAlign :: Integer
    ptrAlign = Integer
    4
      , voidAlign :: Integer
    voidAlign = Integer
    1
      }

    tExpr :: MonadTrav m => [StmtCtx] -> ExprSide -> CExpr -> m Type
    tExpr :: forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    side CExpression NodeInfo
    e =
      case NodeInfo -> Maybe Name
    nameOfNode (CExpression NodeInfo -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CExpression NodeInfo
    e) of
        Just Name
    n ->
          do dt <- m DefTable
    forall (m :: * -> *). MonadSymtab m => m DefTable
    getDefTable
             case lookupType dt n of
               Just Type
    t -> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    t
               Maybe Type
    Nothing ->
                 do t <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr' [StmtCtx]
    c ExprSide
    side CExpression NodeInfo
    e
                    withDefTable (\DefTable
    dt' -> (Type
    t, DefTable -> Name -> Type -> DefTable
    insertType DefTable
    dt' Name
    n Type
    t))
        Maybe Name
    Nothing -> [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr' [StmtCtx]
    c ExprSide
    side CExpression NodeInfo
    e

    -- | Typecheck an expression, with information about whether it
    --   appears as an lvalue or an rvalue.
    tExpr' :: MonadTrav m => [StmtCtx] -> ExprSide -> CExpr -> m Type
    tExpr' :: forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr' [StmtCtx]
    c ExprSide
    side (CBinary CBinaryOp
    op CExpression NodeInfo
    le CExpression NodeInfo
    re NodeInfo
    ni)    =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ExprSide
    side ExprSide -> ExprSide -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExprSide
    LValue) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni [Char]
    "binary operator as lvalue"
         lt <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    le
         rt <- tExpr c RValue re
         binopType' ni op lt rt
    tExpr' [StmtCtx]
    c ExprSide
    side (CUnary CUnaryOp
    CAdrOp CExpression NodeInfo
    e NodeInfo
    ni)     =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ExprSide
    side ExprSide -> ExprSide -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExprSide
    LValue) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
              NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni [Char]
    "address-of operator as lvalue"
         case CExpression NodeInfo
    e of
           CCompoundLit CDeclaration NodeInfo
    _ CInitializerList NodeInfo
    _ NodeInfo
    _ -> Type -> Type
    simplePtr (Type -> Type) -> m Type -> m Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e
           CVar Ident
    i NodeInfo
    _ -> Ident -> m (Maybe IdentDecl)
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Ident -> m (Maybe IdentDecl)
    lookupObject Ident
    i m (Maybe IdentDecl) -> (Maybe IdentDecl -> m Type) -> m 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 -> Either [Char] Type -> m Type
    forall (m :: * -> *) a.
    MonadCError m =>
    NodeInfo -> Either [Char] a -> m a
    typeErrorOnLeft NodeInfo
    ni (Either [Char] Type -> m Type)
    -> (Maybe IdentDecl -> Either [Char] Type)
    -> Maybe IdentDecl
    -> m Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Either [Char] Type
    -> (IdentDecl -> Either [Char] Type)
    -> Maybe IdentDecl
    -> Either [Char] Type
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Ident -> Either [Char] Type
    forall a. Ident -> Either [Char] a
    notFound Ident
    i) IdentDecl -> Either [Char] Type
    varAddrType
           CExpression NodeInfo
    _        -> Type -> Type
    simplePtr (Type -> Type) -> m Type -> m Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    LValue CExpression NodeInfo
    e
    tExpr' [StmtCtx]
    c ExprSide
    _ (CUnary CUnaryOp
    CIndOp CExpression NodeInfo
    e NodeInfo
    ni)     =
      [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e m Type -> (Type -> m Type) -> m 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 -> Either [Char] Type -> m Type
    forall (m :: * -> *) a.
    MonadCError m =>
    NodeInfo -> Either [Char] a -> m a
    typeErrorOnLeft NodeInfo
    ni (Either [Char] Type -> m Type)
    -> (Type -> Either [Char] Type) -> Type -> m Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Either [Char] Type
    derefType)
    tExpr' [StmtCtx]
    c ExprSide
    _ (CUnary CUnaryOp
    CCompOp CExpression NodeInfo
    e NodeInfo
    ni)    =
      do t <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e
         checkIntegral' ni t
         return t
    tExpr' [StmtCtx]
    c ExprSide
    side (CUnary CUnaryOp
    CNegOp CExpression NodeInfo
    e NodeInfo
    ni)      =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ExprSide
    side ExprSide -> ExprSide -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExprSide
    LValue) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
              NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni [Char]
    "logical negation used as lvalue"
         [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e m Type -> (Type -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= NodeInfo -> Type -> m ()
    forall (m :: * -> *). MonadCError m => NodeInfo -> Type -> m ()
    checkScalar' NodeInfo
    ni
         Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    boolType
    tExpr' [StmtCtx]
    c ExprSide
    side (CUnary CUnaryOp
    op CExpression NodeInfo
    e NodeInfo
    _)          =
      [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c (if CUnaryOp -> Bool
    isEffectfulOp CUnaryOp
    op then ExprSide
    LValue else ExprSide
    side) CExpression NodeInfo
    e
    tExpr' [StmtCtx]
    c ExprSide
    _ (CIndex CExpression NodeInfo
    b CExpression NodeInfo
    i NodeInfo
    ni)             =
      do bt <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    b
         it <- tExpr c RValue i
         addrTy <- binopType' ni CAddOp bt it
         typeErrorOnLeft ni $ derefType addrTy
    tExpr' [StmtCtx]
    c ExprSide
    side (CCond CExpression NodeInfo
    e1 Maybe (CExpression NodeInfo)
    me2 CExpression NodeInfo
    e3 NodeInfo
    ni)     =
      do t1 <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e1
         checkScalar' (nodeInfo e1) t1
         t3 <- tExpr c side e3
         case me2 of
           Just CExpression NodeInfo
    e2 ->
             do t2 <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    side CExpression NodeInfo
    e2
                conditionalType' ni t2 t3
           Maybe (CExpression NodeInfo)
    Nothing -> NodeInfo -> Type -> Type -> m Type
    forall (m :: * -> *).
    MonadCError m =>
    NodeInfo -> Type -> Type -> m Type
    conditionalType' NodeInfo
    ni Type
    t1 Type
    t3
    tExpr' [StmtCtx]
    c ExprSide
    _ (CMember CExpression NodeInfo
    e Ident
    m Bool
    deref NodeInfo
    ni)   =
      do t <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e
         bt <- if deref then typeErrorOnLeft ni (derefType t) else return t
         fieldType ni m bt
    tExpr' [StmtCtx]
    c ExprSide
    side (CComma [CExpression NodeInfo]
    es NodeInfo
    _)            =
      (CExpression NodeInfo -> m Type)
    -> [CExpression NodeInfo] -> m [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 ([StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    side) [CExpression NodeInfo]
    es m [Type] -> ([Type] -> m Type) -> m Type
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> m Type) -> ([Type] -> Type) -> [Type] -> m Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Type] -> Type
    forall a. HasCallStack => [a] -> a
    last
    tExpr' [StmtCtx]
    c ExprSide
    side (CCast CDeclaration NodeInfo
    d CExpression NodeInfo
    e NodeInfo
    ni)           =
      do dt <- CDeclaration NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    CDeclaration NodeInfo -> m Type
    analyseTypeDecl CDeclaration NodeInfo
    d
         et <- tExpr c side e
         typeErrorOnLeft ni $ castCompatible dt et
         return dt
    tExpr' [StmtCtx]
    c ExprSide
    side (CSizeofExpr CExpression NodeInfo
    e NodeInfo
    ni)       =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ExprSide
    side ExprSide -> ExprSide -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExprSide
    LValue) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni [Char]
    "sizeof as lvalue"
         _ <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e
         return size_tType
    tExpr' [StmtCtx]
    c ExprSide
    side (CAlignofExpr CExpression NodeInfo
    e NodeInfo
    ni)      =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ExprSide
    side ExprSide -> ExprSide -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExprSide
    LValue) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni [Char]
    "alignof as lvalue"
         _ <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    e
         return size_tType
    tExpr' [StmtCtx]
    c ExprSide
    side (CComplexReal CExpression NodeInfo
    e NodeInfo
    ni)      = NodeInfo -> [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    NodeInfo -> [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    complexBaseType NodeInfo
    ni [StmtCtx]
    c ExprSide
    side CExpression NodeInfo
    e
    tExpr' [StmtCtx]
    c ExprSide
    side (CComplexImag CExpression NodeInfo
    e NodeInfo
    ni)      = NodeInfo -> [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    NodeInfo -> [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    complexBaseType NodeInfo
    ni [StmtCtx]
    c ExprSide
    side CExpression NodeInfo
    e
    tExpr' [StmtCtx]
    _ ExprSide
    side (CLabAddrExpr Ident
    _ NodeInfo
    ni)      =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ExprSide
    side ExprSide -> ExprSide -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExprSide
    LValue) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni [Char]
    "label address as lvalue"
         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
    $ Type -> TypeQuals -> Attributes -> Type
    PtrType Type
    voidType TypeQuals
    noTypeQuals []
    tExpr' [StmtCtx]
    _ ExprSide
    side (CCompoundLit CDeclaration NodeInfo
    d CInitializerList NodeInfo
    initList NodeInfo
    ni) =
      do Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ExprSide
    side ExprSide -> ExprSide -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExprSide
    LValue) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni [Char]
    "compound literal as lvalue"
         lt <- CDeclaration NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    CDeclaration NodeInfo -> m Type
    analyseTypeDecl CDeclaration NodeInfo
    d
         tInitList ni (canonicalType lt) initList
         return lt
    tExpr' [StmtCtx]
    _ ExprSide
    RValue (CAlignofType CDeclaration NodeInfo
    _ NodeInfo
    _)     = Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    size_tType
    tExpr' [StmtCtx]
    _ ExprSide
    RValue (CSizeofType CDeclaration NodeInfo
    _ NodeInfo
    _)      = Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    size_tType
    tExpr' [StmtCtx]
    _ ExprSide
    LValue (CAlignofType CDeclaration NodeInfo
    _ NodeInfo
    ni)    =
      NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni [Char]
    "alignoftype as lvalue"
    tExpr' [StmtCtx]
    _ ExprSide
    LValue (CSizeofType CDeclaration NodeInfo
    _ NodeInfo
    ni)     =
      NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni [Char]
    "sizeoftype as lvalue"
    tExpr' [StmtCtx]
    ctx ExprSide
    side (CGenericSelection CExpression NodeInfo
    expr [(Maybe (CDeclaration NodeInfo), CExpression NodeInfo)]
    list NodeInfo
    ni) = do
      ty_sel <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    ctx ExprSide
    side CExpression NodeInfo
    expr
      ty_list <- mapM analyseAssoc list
      def_expr_ty <-
        case dropWhile (isJust . fst) ty_list of
          [(Maybe Type
    Nothing,Type
    tExpr'')] -> Maybe Type -> m (Maybe Type)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> Maybe Type
    forall a. a -> Maybe a
    Just Type
    tExpr'')
          [] -> Maybe Type -> m (Maybe Type)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Type
    forall a. Maybe a
    Nothing
          [(Maybe Type, Type)]
    _ -> NodeInfo -> [Char] -> m (Maybe Type)
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni [Char]
    "more than one default clause in generic selection"
      case dropWhile (maybe True (not . typesMatch ty_sel) . fst) ty_list of
        ((Maybe Type
    _,Type
    expr_ty) : [(Maybe Type, Type)]
    _ ) -> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    expr_ty
        [] -> case Maybe Type
    def_expr_ty of
          (Just Type
    expr_ty) -> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    expr_ty
          Maybe Type
    Nothing -> NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni ([Char]
    "no clause matches for generic selection (not fully supported) - selector type is " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Doc -> [Char]
    forall a. Show a => a -> [Char]
    show (Type -> Doc
    forall p. Pretty p => p -> Doc
    pretty Type
    ty_sel) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                  [Char]
    ", available types are " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Doc] -> [Char]
    forall a. Show a => a -> [Char]
    show (((Maybe Type, Type) -> Doc) -> [(Maybe Type, Type)] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Type -> Doc
    forall p. Pretty p => p -> Doc
    pretty(Type -> Doc)
    -> ((Maybe Type, Type) -> Type) -> (Maybe Type, Type) -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Maybe Type -> Type
    forall a. HasCallStack => Maybe a -> a
    fromJust(Maybe Type -> Type)
    -> ((Maybe Type, Type) -> Maybe Type) -> (Maybe Type, Type) -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Maybe Type, Type) -> Maybe Type
    forall a b. (a, b) -> a
    fst) (((Maybe Type, Type) -> Bool)
    -> [(Maybe Type, Type)] -> [(Maybe Type, Type)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Maybe Type -> Bool
    forall a. Maybe a -> Bool
    isJust(Maybe Type -> Bool)
    -> ((Maybe Type, Type) -> Maybe Type) -> (Maybe Type, Type) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Maybe Type, Type) -> Maybe Type
    forall a b. (a, b) -> a
    fst) [(Maybe Type, Type)]
    ty_list)))
      where
        analyseAssoc :: (t (CDeclaration NodeInfo), CExpression NodeInfo)
    -> m (t Type, Type)
    analyseAssoc (t (CDeclaration NodeInfo)
    mdecl,CExpression NodeInfo
    expr') = do
          tDecl <- (CDeclaration NodeInfo -> m Type)
    -> t (CDeclaration NodeInfo) -> m (t 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) -> t a -> m (t b)
    mapM CDeclaration NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    CDeclaration NodeInfo -> m Type
    analyseTypeDecl t (CDeclaration NodeInfo)
    mdecl
          tExpr'' <- tExpr ctx side expr'
          return (tDecl, tExpr'')
        typesMatch :: Type -> Type -> Bool
    typesMatch (DirectType TypeName
    tn1 TypeQuals
    _ Attributes
    _) (DirectType TypeName
    tn2 TypeQuals
    _ Attributes
    _) = TypeName -> TypeName -> Bool
    directTypesMatch TypeName
    tn1 TypeName
    tn2
        typesMatch Type
    _ Type
    _ = Bool
    False -- not fully supported
        directTypesMatch :: TypeName -> TypeName -> Bool
    directTypesMatch TypeName
    TyVoid TypeName
    TyVoid = Bool
    True
        directTypesMatch (TyIntegral IntType
    t1) (TyIntegral IntType
    t2) = IntType
    t1 IntType -> IntType -> Bool
    forall a. Eq a => a -> a -> Bool
    == IntType
    t2
        directTypesMatch (TyFloating FloatType
    t1) (TyFloating FloatType
    t2) = FloatType
    t1 FloatType -> FloatType -> Bool
    forall a. Eq a => a -> a -> Bool
    == FloatType
    t2
        directTypesMatch (TyComplex FloatType
    t1) (TyComplex FloatType
    t2) = FloatType
    t1 FloatType -> FloatType -> Bool
    forall a. Eq a => a -> a -> Bool
    == FloatType
    t2
        directTypesMatch TypeName
    _ TypeName
    _ = Bool
    False -- TODO: not fully supported
    tExpr' [StmtCtx]
    _ ExprSide
    _ (CVar Ident
    i NodeInfo
    ni)              =
      Ident -> m (Maybe IdentDecl)
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Ident -> m (Maybe IdentDecl)
    lookupObject Ident
    i m (Maybe IdentDecl) -> (Maybe IdentDecl -> m Type) -> m Type
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
      m Type -> (IdentDecl -> m Type) -> Maybe IdentDecl -> m Type
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (NodeInfo -> Either [Char] Type -> m Type
    forall (m :: * -> *) a.
    MonadCError m =>
    NodeInfo -> Either [Char] a -> m a
    typeErrorOnLeft NodeInfo
    ni (Either [Char] Type -> m Type) -> Either [Char] Type -> m Type
    forall a b. (a -> b) -> a -> b
    $ Ident -> Either [Char] Type
    forall a. Ident -> Either [Char] a
    notFound Ident
    i) (Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> m Type) -> (IdentDecl -> Type) -> IdentDecl -> m Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IdentDecl -> Type
    forall n. Declaration n => n -> Type
    declType)
    tExpr' [StmtCtx]
    _ ExprSide
    _ (CConst CConstant NodeInfo
    c)                  = CConstant NodeInfo -> m Type
    forall (m :: * -> *).
    (MonadCError m, MonadName m) =>
    CConstant NodeInfo -> m Type
    constType CConstant NodeInfo
    c
    tExpr' [StmtCtx]
    _ ExprSide
    _ (CBuiltinExpr CBuiltinThing NodeInfo
    b)            = CBuiltinThing NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    CBuiltinThing NodeInfo -> m Type
    builtinType CBuiltinThing NodeInfo
    b
    tExpr' [StmtCtx]
    c ExprSide
    side (CCall (CVar Ident
    i NodeInfo
    _) [CExpression NodeInfo]
    args NodeInfo
    ni)
      | Ident -> [Char]
    identToString Ident
    i [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "__builtin_choose_expr" =
        case [CExpression NodeInfo]
    args of
          [CExpression NodeInfo
    g, CExpression NodeInfo
    e1, CExpression NodeInfo
    e2] ->
            -- XXX: the MachineDesc parameter below should be configurable
            do b <- MachineDesc
    -> Map Ident (CExpression NodeInfo)
    -> CExpression NodeInfo
    -> m (CExpression NodeInfo)
    forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc
    -> Map Ident (CExpression NodeInfo)
    -> CExpression NodeInfo
    -> m (CExpression NodeInfo)
    constEval MachineDesc
    defaultMD Map Ident (CExpression NodeInfo)
    forall k a. Map k a
    Map.empty CExpression NodeInfo
    g
               case boolValue b of
                 Just Bool
    True -> [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    side CExpression NodeInfo
    e1
                 Just Bool
    False -> [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    side CExpression NodeInfo
    e2
                 Maybe Bool
    Nothing ->
                   NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni [Char]
    "non-constant argument to __builtin_choose_expr"
          [CExpression NodeInfo]
    _ -> NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError NodeInfo
    ni [Char]
    "wrong number of arguments to __builtin_choose_expr"
    tExpr' [StmtCtx]
    c ExprSide
    _ (CCall CExpression NodeInfo
    fe [CExpression NodeInfo]
    args NodeInfo
    ni)          =
      do let defType :: Type
    defType = FunType -> Attributes -> Type
    FunctionType
                       (Type -> FunType
    FunTypeIncomplete
                        (TypeName -> TypeQuals -> Attributes -> Type
    DirectType (IntType -> TypeName
    TyIntegral IntType
    TyInt) TypeQuals
    noTypeQuals Attributes
    noAttributes))
                       Attributes
    noAttributes
             fallback :: Ident -> m Type
    fallback Ident
    i = do InvalidASTError -> m ()
    forall e (m :: * -> *). (Error e, MonadCError m) => e -> m ()
    warn (InvalidASTError -> m ()) -> InvalidASTError -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> [Char] -> InvalidASTError
    invalidAST NodeInfo
    ni ([Char] -> InvalidASTError) -> [Char] -> InvalidASTError
    forall a b. (a -> b) -> a -> b
    $
                                    [Char]
    "unknown function: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Ident -> [Char]
    identToString Ident
    i
                             Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    defType
         t <- case CExpression NodeInfo
    fe of
                CVar Ident
    i NodeInfo
    _ -> Ident -> m (Maybe IdentDecl)
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Ident -> m (Maybe IdentDecl)
    lookupObject Ident
    i m (Maybe IdentDecl) -> (Maybe IdentDecl -> m Type) -> m Type
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                            m Type -> (IdentDecl -> m Type) -> Maybe IdentDecl -> m Type
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Ident -> m Type
    forall {m :: * -> *}. MonadCError m => Ident -> m Type
    fallback Ident
    i) (m Type -> IdentDecl -> m Type
    forall a b. a -> b -> a
    const (m Type -> IdentDecl -> m Type) -> m Type -> IdentDecl -> m Type
    forall a b. (a -> b) -> a -> b
    $ [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    fe)
                CExpression NodeInfo
    _ -> [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    RValue CExpression NodeInfo
    fe
         atys <- mapM (tExpr c RValue) args
         -- XXX: we don't actually want to return the canonical return type here
         case canonicalType t of
           PtrType (FunctionType (FunType Type
    rt [ParamDecl]
    pdecls Bool
    varargs) Attributes
    _) TypeQuals
    _ Attributes
    _ ->
             do let ptys :: [Type]
    ptys = (ParamDecl -> Type) -> [ParamDecl] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map ParamDecl -> Type
    forall n. Declaration n => n -> Type
    declType [ParamDecl]
    pdecls
                ((Type, Type, CExpression NodeInfo) -> m ())
    -> [(Type, Type, CExpression NodeInfo)] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Type, Type, CExpression NodeInfo) -> m ()
    forall {m :: * -> *} {a}.
    (MonadCError m, MonadSymtab m, CNode a) =>
    (Type, Type, a) -> m ()
    checkArg ([(Type, Type, CExpression NodeInfo)] -> m ())
    -> [(Type, Type, CExpression NodeInfo)] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Type]
    -> [Type]
    -> [CExpression NodeInfo]
    -> [(Type, Type, CExpression NodeInfo)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Type]
    ptys [Type]
    atys [CExpression NodeInfo]
    args
                Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    varargs (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    atys Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Type] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    ptys) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                       NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni [Char]
    "incorrect number of arguments"
                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
    $ Type -> Type
    canonicalType Type
    rt
           PtrType (FunctionType (FunTypeIncomplete Type
    rt) Attributes
    _) TypeQuals
    _ Attributes
    _ ->
             do -- warn $ invalidAST ni "incomplete function type"
                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
    $ Type -> Type
    canonicalType Type
    rt
           Type
    _  -> NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni ([Char] -> m Type) -> [Char] -> m Type
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "attempt to call non-function of type " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    pType Type
    t
      where checkArg :: (Type, Type, a) -> m ()
    checkArg (Type
    pty, Type
    aty, a
    arg) =
              do attrs <- Type -> m Attributes
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Type -> m Attributes
    deepTypeAttrs Type
    pty
                 if isTransparentUnion attrs
                   then
                     case canonicalType pty of
                       DirectType (TyComp CompTypeRef
    ctr) TypeQuals
    _ Attributes
    _ ->
                         do td <- NodeInfo -> SUERef -> m TagDef
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> SUERef -> m TagDef
    lookupSUE (a -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo a
    arg) (CompTypeRef -> SUERef
    forall a. HasSUERef a => a -> SUERef
    sueRef CompTypeRef
    ctr)
                            _ms <- tagMembers (nodeInfo arg) td
                            {-
                            when (null $ rights $ matches ms) $
                                 astError (nodeInfo arg) $
                                 "argument matches none of the elements " ++
                                 "of transparent union"
                            -}
                            return ()
                         -- where matches =
                         --         map (\d -> assignCompatible
                         --                    CAssignOp
                         --                    (snd d)
                         --                    aty
                         --             )
                       Type
    _ -> NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    astError (a -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo a
    arg)
                            [Char]
    "non-composite has __transparent_union__ attribute"
                   else
                     assignCompatible' (nodeInfo arg) CAssignOp pty aty
            isTransparentUnion :: Attributes -> Bool
    isTransparentUnion =
              (Attr -> Bool) -> Attributes -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\(Attr Ident
    n [CExpression NodeInfo]
    _ NodeInfo
    _) -> Ident -> [Char]
    identToString Ident
    n [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "__transparent_union__")
    tExpr' [StmtCtx]
    c ExprSide
    _ (CAssign CAssignOp
    op CExpression NodeInfo
    le CExpression NodeInfo
    re NodeInfo
    ni)       =
      do lt <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    LValue CExpression NodeInfo
    le
         rt <- tExpr c RValue re
         when (constant $ typeQuals lt) $
              typeError ni $ "assignment to lvalue with `constant' qualifier: "
                             ++ (render . pretty) le
         case (canonicalType lt, re) of
           (Type
    lt', CConst (CIntConst CInteger
    i NodeInfo
    _))
             | Type -> Bool
    isPointerType Type
    lt' Bool -> Bool -> Bool
    && CInteger -> Integer
    getCInteger CInteger
    i Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    0 -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
           (Type
    _, CExpression NodeInfo
    _) -> NodeInfo -> CAssignOp -> Type -> Type -> m ()
    forall (m :: * -> *).
    MonadCError m =>
    NodeInfo -> CAssignOp -> Type -> Type -> m ()
    assignCompatible' NodeInfo
    ni CAssignOp
    op Type
    lt Type
    rt
         return lt
    tExpr' [StmtCtx]
    c ExprSide
    _ (CStatExpr CStatement NodeInfo
    s NodeInfo
    _)             =
      do m ()
    forall (m :: * -> *). MonadSymtab m => m ()
    enterBlockScope
         (Ident -> m (DeclarationStatus Ident)) -> [Ident] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((DefTable -> (DeclarationStatus Ident, DefTable))
    -> m (DeclarationStatus Ident)
    forall a. (DefTable -> (a, DefTable)) -> m a
    forall (m :: * -> *) a.
    MonadSymtab m =>
    (DefTable -> (a, DefTable)) -> m a
    withDefTable ((DefTable -> (DeclarationStatus Ident, DefTable))
     -> m (DeclarationStatus Ident))
    -> (Ident -> DefTable -> (DeclarationStatus Ident, DefTable))
    -> Ident
    -> m (DeclarationStatus Ident)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> DefTable -> (DeclarationStatus Ident, DefTable)
    defineLabel) (CStatement NodeInfo -> [Ident]
    getLabels CStatement NodeInfo
    s)
         t <- [StmtCtx] -> CStatement NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> CStatement NodeInfo -> m Type
    tStmt [StmtCtx]
    c CStatement NodeInfo
    s
         leaveBlockScope
         return t

    tInitList :: MonadTrav m => NodeInfo -> Type -> CInitList -> m ()
    tInitList :: forall (m :: * -> *).
    MonadTrav m =>
    NodeInfo -> Type -> CInitializerList NodeInfo -> m ()
    tInitList NodeInfo
    _ (ArrayType (DirectType (TyIntegral IntType
    TyChar) TypeQuals
    _ Attributes
    _) ArraySize
    _ TypeQuals
    _ Attributes
    _)
                  [([], CInitExpr e :: CExpression NodeInfo
    e@(CConst (CStrConst CString
    _ NodeInfo
    _)) NodeInfo
    _)] =
      [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [] ExprSide
    RValue CExpression NodeInfo
    e m Type -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    tInitList NodeInfo
    ni t :: Type
    t@(ArrayType Type
    _ ArraySize
    _ TypeQuals
    _ Attributes
    _) CInitializerList NodeInfo
    initList =
      do let default_ds :: [CPartDesignator NodeInfo]
    default_ds =
               CPartDesignator NodeInfo -> [CPartDesignator NodeInfo]
    forall a. a -> [a]
    repeat (CExpression NodeInfo -> NodeInfo -> CPartDesignator NodeInfo
    forall a. CExpression a -> a -> CPartDesignator a
    CArrDesig (CConstant NodeInfo -> CExpression NodeInfo
    forall a. CConstant a -> CExpression a
    CConst (CInteger -> NodeInfo -> CConstant NodeInfo
    forall a. CInteger -> a -> CConstant a
    CIntConst (Integer -> CInteger
    cInteger Integer
    0) NodeInfo
    ni)) NodeInfo
    ni)
         Type
    -> [CPartDesignator NodeInfo] -> CInitializerList NodeInfo -> m ()
    forall (m :: * -> *).
    MonadTrav m =>
    Type
    -> [CPartDesignator NodeInfo] -> CInitializerList NodeInfo -> m ()
    checkInits Type
    t [CPartDesignator NodeInfo]
    default_ds CInitializerList NodeInfo
    initList
    tInitList NodeInfo
    ni t :: Type
    t@(DirectType (TyComp CompTypeRef
    ctr) TypeQuals
    _ Attributes
    _) CInitializerList NodeInfo
    initList =
      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
         let default_ds = ((Ident, Type) -> CPartDesignator NodeInfo)
    -> [(Ident, Type)] -> [CPartDesignator NodeInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Ident, Type)
    m -> Ident -> NodeInfo -> CPartDesignator NodeInfo
    forall a. Ident -> a -> CPartDesignator a
    CMemberDesig ((Ident, Type) -> Ident
    forall a b. (a, b) -> a
    fst (Ident, Type)
    m) NodeInfo
    ni) [(Ident, Type)]
    ms
         checkInits t default_ds initList
    tInitList NodeInfo
    _ (PtrType (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) TypeQuals
    _ Attributes
    _ ) CInitializerList NodeInfo
    _ =
              () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- XXX: more checking
    tInitList NodeInfo
    _ Type
    t [([], CInit
    i)] = m CInit -> m ()
    forall (m :: * -> *) a. Monad m => m a -> m ()
    voidM(m CInit -> m ()) -> m CInit -> m ()
    forall a b. (a -> b) -> a -> b
    $ Type -> CInit -> m CInit
    forall (m :: * -> *). MonadTrav m => Type -> CInit -> m CInit
    tInit Type
    t CInit
    i
    tInitList NodeInfo
    ni Type
    t CInitializerList NodeInfo
    _ = NodeInfo -> [Char] -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni ([Char] -> m ()) -> [Char] -> m ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "initializer list for type: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    pType Type
    t

    checkInits :: MonadTrav m => Type -> [CDesignator] -> CInitList -> m ()
    checkInits :: forall (m :: * -> *).
    MonadTrav m =>
    Type
    -> [CPartDesignator NodeInfo] -> CInitializerList NodeInfo -> m ()
    checkInits Type
    _ [CPartDesignator NodeInfo]
    _ [] = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkInits Type
    t [CPartDesignator NodeInfo]
    dds (([CPartDesignator NodeInfo]
    ds, CInit
    i) : CInitializerList NodeInfo
    is) =
      do (dds', ds') <- case ([CPartDesignator NodeInfo]
    dds, [CPartDesignator NodeInfo]
    ds) of
                          ([], []) ->
                            NodeInfo
    -> [Char]
    -> m ([CPartDesignator NodeInfo], [CPartDesignator NodeInfo])
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError (CInit -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CInit
    i) [Char]
    "excess elements in initializer"
                          (CPartDesignator NodeInfo
    dd' : [CPartDesignator NodeInfo]
    rest, []) -> ([CPartDesignator NodeInfo], [CPartDesignator NodeInfo])
    -> m ([CPartDesignator NodeInfo], [CPartDesignator NodeInfo])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CPartDesignator NodeInfo]
    rest, [CPartDesignator NodeInfo
    dd'])
                          ([CPartDesignator NodeInfo]
    _, CPartDesignator NodeInfo
    d : [CPartDesignator NodeInfo]
    _) -> ([CPartDesignator NodeInfo], [CPartDesignator NodeInfo])
    -> m ([CPartDesignator NodeInfo], [CPartDesignator NodeInfo])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CPartDesignator NodeInfo]
    -> CPartDesignator NodeInfo -> [CPartDesignator NodeInfo]
    advanceDesigList [CPartDesignator NodeInfo]
    dds CPartDesignator NodeInfo
    d, [CPartDesignator NodeInfo]
    ds)
         t' <- tDesignator t ds'
         _ <- tInit t' i
         checkInits t dds' is

    advanceDesigList :: [CDesignator] -> CDesignator -> [CDesignator]
    advanceDesigList :: [CPartDesignator NodeInfo]
    -> CPartDesignator NodeInfo -> [CPartDesignator NodeInfo]
    advanceDesigList [CPartDesignator NodeInfo]
    ds CPartDesignator NodeInfo
    d = Int -> [CPartDesignator NodeInfo] -> [CPartDesignator NodeInfo]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([CPartDesignator NodeInfo] -> [CPartDesignator NodeInfo])
    -> [CPartDesignator NodeInfo] -> [CPartDesignator NodeInfo]
    forall a b. (a -> b) -> a -> b
    $ (CPartDesignator NodeInfo -> Bool)
    -> [CPartDesignator NodeInfo] -> [CPartDesignator NodeInfo]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool)
    -> (CPartDesignator NodeInfo -> Bool)
    -> CPartDesignator NodeInfo
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CPartDesignator NodeInfo -> CPartDesignator NodeInfo -> Bool
    matchDesignator CPartDesignator NodeInfo
    d) [CPartDesignator NodeInfo]
    ds

    matchDesignator :: CDesignator -> CDesignator -> Bool
    matchDesignator :: CPartDesignator NodeInfo -> CPartDesignator NodeInfo -> Bool
    matchDesignator (CMemberDesig Ident
    m1 NodeInfo
    _) (CMemberDesig Ident
    m2 NodeInfo
    _) = Ident
    m1 Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    m2
    matchDesignator CPartDesignator NodeInfo
    _ CPartDesignator NodeInfo
    _ = Bool
    True -- XXX: for now, array ranges aren't checked

    tDesignator :: MonadTrav m => Type -> [CDesignator] -> m Type
    -- XXX: check that initializers are within array size
    tDesignator :: forall (m :: * -> *).
    MonadTrav m =>
    Type -> [CPartDesignator NodeInfo] -> m Type
    tDesignator (ArrayType Type
    bt ArraySize
    _ TypeQuals
    _ Attributes
    _) (CArrDesig CExpression NodeInfo
    e NodeInfo
    ni : [CPartDesignator NodeInfo]
    ds) =
      do [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [] ExprSide
    RValue CExpression NodeInfo
    e m Type -> (Type -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= NodeInfo -> Type -> m ()
    forall (m :: * -> *). MonadCError m => NodeInfo -> Type -> m ()
    checkIntegral' NodeInfo
    ni
         Type -> [CPartDesignator NodeInfo] -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    Type -> [CPartDesignator NodeInfo] -> m Type
    tDesignator Type
    bt [CPartDesignator NodeInfo]
    ds
    tDesignator (ArrayType Type
    bt ArraySize
    _ TypeQuals
    _ Attributes
    _) (CRangeDesig CExpression NodeInfo
    e1 CExpression NodeInfo
    e2 NodeInfo
    ni : [CPartDesignator NodeInfo]
    ds) =
      do [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [] ExprSide
    RValue CExpression NodeInfo
    e1 m Type -> (Type -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= NodeInfo -> Type -> m ()
    forall (m :: * -> *). MonadCError m => NodeInfo -> Type -> m ()
    checkIntegral' NodeInfo
    ni
         [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [] ExprSide
    RValue CExpression NodeInfo
    e2 m Type -> (Type -> m ()) -> m ()
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= NodeInfo -> Type -> m ()
    forall (m :: * -> *). MonadCError m => NodeInfo -> Type -> m ()
    checkIntegral' NodeInfo
    ni
         Type -> [CPartDesignator NodeInfo] -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    Type -> [CPartDesignator NodeInfo] -> m Type
    tDesignator Type
    bt [CPartDesignator NodeInfo]
    ds
    tDesignator (ArrayType Type
    _ ArraySize
    _ TypeQuals
    _ Attributes
    _) (CPartDesignator NodeInfo
    d : [CPartDesignator NodeInfo]
    _) =
      NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError (CPartDesignator NodeInfo -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CPartDesignator NodeInfo
    d) [Char]
    "member designator in array initializer"
    tDesignator t :: Type
    t@(DirectType (TyComp CompTypeRef
    _) TypeQuals
    _ Attributes
    _) (CMemberDesig Ident
    m NodeInfo
    ni : [CPartDesignator NodeInfo]
    ds) =
      do mt <- NodeInfo -> Ident -> Type -> m Type
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> Ident -> Type -> m Type
    fieldType NodeInfo
    ni Ident
    m Type
    t
         tDesignator (canonicalType mt) ds
    tDesignator (DirectType (TyComp CompTypeRef
    _) TypeQuals
    _ Attributes
    _) (CPartDesignator NodeInfo
    d : [CPartDesignator NodeInfo]
    _) =
      NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError (CPartDesignator NodeInfo -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CPartDesignator NodeInfo
    d) [Char]
    "array designator in compound initializer"
    tDesignator Type
    t [] = Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    t
    tDesignator Type
    _t [CPartDesignator NodeInfo]
    _ =
      [Char] -> m Type
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "unepxected type with designator"

    tInit :: MonadTrav m => Type -> CInit -> m Initializer
    tInit :: forall (m :: * -> *). MonadTrav m => Type -> CInit -> m CInit
    tInit Type
    t i :: CInit
    i@(CInitExpr CExpression NodeInfo
    e NodeInfo
    ni) =
      do it <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [] ExprSide
    RValue CExpression NodeInfo
    e
         assignCompatible' ni CAssignOp t it
         return i
    tInit Type
    t i :: CInit
    i@(CInitList CInitializerList NodeInfo
    initList NodeInfo
    ni) =
      NodeInfo -> Type -> CInitializerList NodeInfo -> m ()
    forall (m :: * -> *).
    MonadTrav m =>
    NodeInfo -> Type -> CInitializerList NodeInfo -> m ()
    tInitList NodeInfo
    ni (Type -> Type
    canonicalType Type
    t) CInitializerList NodeInfo
    initList m () -> m CInit -> m CInit
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> CInit -> m CInit
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CInit
    i

    complexBaseType :: MonadTrav m => NodeInfo -> [StmtCtx] -> ExprSide -> CExpr -> m Type
    complexBaseType :: forall (m :: * -> *).
    MonadTrav m =>
    NodeInfo -> [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    complexBaseType NodeInfo
    ni [StmtCtx]
    c ExprSide
    side CExpression NodeInfo
    e =
      do t <- [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [StmtCtx]
    c ExprSide
    side CExpression NodeInfo
    e
         case canonicalType t of
           DirectType (TyComplex FloatType
    ft) TypeQuals
    quals Attributes
    attrs ->
             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 FloatType
    ft) TypeQuals
    quals Attributes
    attrs
           Type
    _ -> NodeInfo -> [Char] -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> [Char] -> m a
    typeError NodeInfo
    ni ([Char] -> m Type) -> [Char] -> m Type
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "expected complex type, got: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    pType Type
    t

    -- | Return the type of a builtin.
    builtinType :: MonadTrav m => CBuiltin -> m Type
    builtinType :: forall (m :: * -> *).
    MonadTrav m =>
    CBuiltinThing NodeInfo -> m Type
    builtinType (CBuiltinVaArg CExpression NodeInfo
    _ CDeclaration NodeInfo
    d NodeInfo
    _)           = CDeclaration NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    CDeclaration NodeInfo -> m Type
    analyseTypeDecl CDeclaration NodeInfo
    d
    builtinType (CBuiltinOffsetOf CDeclaration NodeInfo
    _ [CPartDesignator NodeInfo]
    _ NodeInfo
    _)        = Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    size_tType
    builtinType (CBuiltinTypesCompatible CDeclaration NodeInfo
    _ CDeclaration NodeInfo
    _ NodeInfo
    _) = Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    boolType
    builtinType (CBuiltinConvertVector CExpression NodeInfo
    _expr CDeclaration NodeInfo
    ty NodeInfo
    _) = CDeclaration NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    CDeclaration NodeInfo -> m Type
    analyseTypeDecl CDeclaration NodeInfo
    ty
    builtinType (CBuiltinBitCast CDeclaration NodeInfo
    ty CExpression NodeInfo
    _expr NodeInfo
    _)    = CDeclaration NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    CDeclaration NodeInfo -> m Type
    analyseTypeDecl CDeclaration NodeInfo
    ty

    -- return @Just declspecs@ without @CTypedef@ if the declaration specifier contain @typedef@
    hasTypeDef :: [CDeclSpec] -> Maybe [CDeclSpec]
    hasTypeDef :: [CDeclarationSpecifier NodeInfo]
    -> Maybe [CDeclarationSpecifier NodeInfo]
    hasTypeDef [CDeclarationSpecifier NodeInfo]
    declspecs =
        case (CDeclarationSpecifier NodeInfo
     -> (Bool, [CDeclarationSpecifier NodeInfo])
     -> (Bool, [CDeclarationSpecifier NodeInfo]))
    -> (Bool, [CDeclarationSpecifier NodeInfo])
    -> [CDeclarationSpecifier NodeInfo]
    -> (Bool, [CDeclarationSpecifier NodeInfo])
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CDeclarationSpecifier NodeInfo
    -> (Bool, [CDeclarationSpecifier NodeInfo])
    -> (Bool, [CDeclarationSpecifier NodeInfo])
    forall {a}.
    CDeclarationSpecifier a
    -> (Bool, [CDeclarationSpecifier a])
    -> (Bool, [CDeclarationSpecifier a])
    hasTypeDefSpec (Bool
    False,[]) [CDeclarationSpecifier NodeInfo]
    declspecs of
            (Bool
    True,[CDeclarationSpecifier NodeInfo]
    specs') -> [CDeclarationSpecifier NodeInfo]
    -> Maybe [CDeclarationSpecifier NodeInfo]
    forall a. a -> Maybe a
    Just [CDeclarationSpecifier NodeInfo]
    specs'
            (Bool
    False,[CDeclarationSpecifier NodeInfo]
    _)     -> Maybe [CDeclarationSpecifier NodeInfo]
    forall a. Maybe a
    Nothing
        where
        hasTypeDefSpec :: CDeclarationSpecifier a
    -> (Bool, [CDeclarationSpecifier a])
    -> (Bool, [CDeclarationSpecifier a])
    hasTypeDefSpec (CStorageSpec (CTypedef a
    _)) (Bool
    _,[CDeclarationSpecifier a]
    specs) = (Bool
    True, [CDeclarationSpecifier a]
    specs)
        hasTypeDefSpec CDeclarationSpecifier a
    spec (Bool
    b,[CDeclarationSpecifier a]
    specs) = (Bool
    b,CDeclarationSpecifier a
    specCDeclarationSpecifier a
    -> [CDeclarationSpecifier a] -> [CDeclarationSpecifier a]
    forall a. a -> [a] -> [a]
    :[CDeclarationSpecifier a]
    specs)