    {-# LANGUAGE PatternGuards, FlexibleContexts #-}
    {-# OPTIONS_GHC -Wwarn=incomplete-patterns #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.C.Analysis.DeclAnalysis
    -- Copyright   :  (c) 2008 Benedikt Huber
    -- License     :  BSD-style
    -- Maintainer  :  benedikt.huber@gmail.com
    -- Stability   :  alpha
    -- Portability :  ghc
    --
    -- This module performs the analysis of declarations and the translation of
    -- type specifications in the AST.
    -----------------------------------------------------------------------------
    module Language.C.Analysis.DeclAnalysis (
      -- * Translating types
      analyseTypeDecl,
      tType,tDirectType,tNumType,tArraySize,tTypeQuals,
      mergeOldStyle,
      -- * Dissecting type specs
      canonicalTypeSpec, NumBaseType(..),SignSpec(..),SizeMod(..),NumTypeSpec(..),TypeSpecAnalysis(..),
      canonicalStorageSpec, StorageSpec(..), hasThreadLocalSpec, hasClKernelSpec, isTypeDef,
      -- * Helpers
      VarDeclInfo(..),
      tAttr,mkVarName,getOnlyDeclr,nameOfDecl,analyseVarDecl,analyseVarDecl'
    )
    where
    import Language.C.Data.Error
    import Language.C.Data.Node
    import Language.C.Data.Ident
    import Language.C.Pretty
    import Language.C.Syntax
    import {-# SOURCE #-} Language.C.Analysis.AstAnalysis (tExpr, ExprSide(..))
    import Language.C.Analysis.DefTable (TagFwdDecl(..), insertType)
    import Language.C.Analysis.SemError
    import Language.C.Analysis.SemRep
    import Language.C.Analysis.TravMonad

    import Data.Foldable as F (foldrM)
    import Control.Monad (liftM,when,ap,unless,zipWithM)
    import Data.List (intercalate, mapAccumL)
    import qualified Data.Map as Map
    import Text.PrettyPrint.HughesPJ

    -- * handling declarations

    -- | analyse and translate a parameter declaration
    -- Should be called in either prototype or block scope
    tParamDecl :: (MonadTrav m) => CDecl -> m ParamDecl
    tParamDecl :: forall (m :: * -> *). MonadTrav m => CDecl -> m ParamDecl
    tParamDecl (CStaticAssert CExpression NodeInfo
    _ CStringLiteral NodeInfo
    _ NodeInfo
    node) =
      NodeInfo -> String -> m ParamDecl
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "expected parameter, not static assertion"
    tParamDecl (CDecl [CDeclarationSpecifier NodeInfo]
    declspecs [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    declrs NodeInfo
    node) =
      do declr <- m (CDeclarator NodeInfo)
    getParamDeclr
         -- analyse the variable declaration
         (VarDeclInfo name fun_spec  storage_spec attrs ty declr_node) <- analyseVarDecl' True declspecs declr [] Nothing
         when (isInline fun_spec || isNoreturn fun_spec) $
           throwTravError (badSpecifierError node "parameter declaration with function specifier")
         -- compute storage of parameter (NoStorage, but might have a register specifier)
         storage <- throwOnLeft $ computeParamStorage node storage_spec
         let paramDecl = VarName -> Storage -> Attributes -> Type -> NodeInfo -> ParamDecl
    mkParamDecl VarName
    name Storage
    storage Attributes
    attrs Type
    ty NodeInfo
    declr_node
         -- XXX: we shouldn't modify the deftable here, just analyse and build representation
         return paramDecl
      where
      getParamDeclr :: m (CDeclarator NodeInfo)
    getParamDeclr =
          case [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    declrs of
              [] -> CDeclarator NodeInfo -> m (CDeclarator NodeInfo)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (NodeInfo -> CDeclarator NodeInfo
    emptyDeclr NodeInfo
    node)
              [(Just CDeclarator NodeInfo
    declr,Maybe (CInitializer NodeInfo)
    Nothing,Maybe (CExpression NodeInfo)
    Nothing)] -> CDeclarator NodeInfo -> m (CDeclarator NodeInfo)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CDeclarator NodeInfo
    declr
              [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    _ -> NodeInfo -> String -> m (CDeclarator NodeInfo)
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "bad parameter declaration: multiple decls / bitfield or initializer present"
      mkParamDecl :: VarName -> Storage -> Attributes -> Type -> NodeInfo -> ParamDecl
    mkParamDecl VarName
    name Storage
    storage Attributes
    attrs Type
    ty NodeInfo
    declr_node =
        let vd :: VarDecl
    vd = VarName -> DeclAttrs -> Type -> VarDecl
    VarDecl VarName
    name (FunctionAttrs -> Storage -> Attributes -> DeclAttrs
    DeclAttrs FunctionAttrs
    noFunctionAttrs Storage
    storage Attributes
    attrs) Type
    ty in
        case VarName
    name of
          VarName
    NoName -> VarDecl -> NodeInfo -> ParamDecl
    AbstractParamDecl VarDecl
    vd NodeInfo
    declr_node
          VarName
    _ -> VarDecl -> NodeInfo -> ParamDecl
    ParamDecl VarDecl
    vd NodeInfo
    declr_node

    -- | a parameter declaration has no linkage and either auto or register storage
    computeParamStorage :: NodeInfo -> StorageSpec -> Either BadSpecifierError Storage
    computeParamStorage :: NodeInfo -> StorageSpec -> Either BadSpecifierError Storage
    computeParamStorage NodeInfo
    _ StorageSpec
    NoStorageSpec = Storage -> Either BadSpecifierError Storage
    forall a b. b -> Either a b
    Right (Bool -> Storage
    Auto Bool
    False)
    computeParamStorage NodeInfo
    _ StorageSpec
    RegSpec       = Storage -> Either BadSpecifierError Storage
    forall a b. b -> Either a b
    Right (Bool -> Storage
    Auto Bool
    True)
    computeParamStorage NodeInfo
    _ StorageSpec
    ClGlobalSpec  = Storage -> Either BadSpecifierError Storage
    forall a b. b -> Either a b
    Right (Linkage -> Bool -> Storage
    Static Linkage
    NoLinkage Bool
    False)
    computeParamStorage NodeInfo
    _ StorageSpec
    ClLocalSpec   = Storage -> Either BadSpecifierError Storage
    forall a b. b -> Either a b
    Right (Linkage -> Bool -> Storage
    Static Linkage
    NoLinkage Bool
    True)
    computeParamStorage NodeInfo
    node StorageSpec
    spec       = BadSpecifierError -> Either BadSpecifierError Storage
    forall a b. a -> Either a b
    Left (BadSpecifierError -> Either BadSpecifierError Storage)
    -> (String -> BadSpecifierError)
    -> String
    -> Either BadSpecifierError Storage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NodeInfo -> String -> BadSpecifierError
    badSpecifierError NodeInfo
    node (String -> Either BadSpecifierError Storage)
    -> String -> Either BadSpecifierError Storage
    forall a b. (a -> b) -> a -> b
    $ String
    "Bad storage specified for parameter: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ StorageSpec -> String
    forall a. Show a => a -> String
    show StorageSpec
    spec

    -- | analyse and translate a member declaration
    tMemberDecls :: (MonadTrav m) => CDecl -> m [MemberDecl]
    -- Anonymous struct or union members
    -- TODO storage specs, align specs and attributes are ignored
    tMemberDecls :: forall (m :: * -> *). MonadTrav m => CDecl -> m [MemberDecl]
    tMemberDecls (CStaticAssert CExpression NodeInfo
    _ CStringLiteral NodeInfo
    _ NodeInfo
    node) =
      NodeInfo -> String -> m [MemberDecl]
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "expected struct or union member, found static assertion"
    tMemberDecls (CDecl [CDeclarationSpecifier NodeInfo]
    declspecs [] NodeInfo
    node) =
      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
         Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([CFunctionSpecifier NodeInfo] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CFunctionSpecifier NodeInfo]
    funspecs) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> String -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "member declaration with function specifier"
         canonTySpecs <- [CTypeSpecifier NodeInfo] -> m TypeSpecAnalysis
    forall (m :: * -> *).
    MonadTrav m =>
    [CTypeSpecifier NodeInfo] -> m TypeSpecAnalysis
    canonicalTypeSpec [CTypeSpecifier NodeInfo]
    typespecs
         ty <- tType True node typequals canonTySpecs [] []
         case ty of
           DirectType (TyComp CompTypeRef
    _) TypeQuals
    _ Attributes
    _ ->
             [MemberDecl] -> m [MemberDecl]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([MemberDecl] -> m [MemberDecl]) -> [MemberDecl] -> m [MemberDecl]
    forall a b. (a -> b) -> a -> b
    $ [VarDecl -> Maybe (CExpression NodeInfo) -> NodeInfo -> MemberDecl
    MemberDecl
                       -- XXX: are these DeclAttrs correct?
                       (VarName -> DeclAttrs -> Type -> VarDecl
    VarDecl VarName
    NoName (FunctionAttrs -> Storage -> Attributes -> DeclAttrs
    DeclAttrs FunctionAttrs
    noFunctionAttrs Storage
    NoStorage []) Type
    ty)
                       Maybe (CExpression NodeInfo)
    forall a. Maybe a
    Nothing NodeInfo
    node]
           Type
    _ -> NodeInfo -> String -> m [MemberDecl]
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "anonymous member has a non-composite type"
    -- Named members
    tMemberDecls (CDecl [CDeclarationSpecifier NodeInfo]
    declspecs [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    declrs NodeInfo
    node) = (Bool
     -> (Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
         Maybe (CExpression NodeInfo))
     -> m MemberDecl)
    -> [Bool]
    -> [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
         Maybe (CExpression NodeInfo))]
    -> m [MemberDecl]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Bool
    -> (Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
        Maybe (CExpression NodeInfo))
    -> m MemberDecl
    forall {m :: * -> *} {a}.
    MonadTrav m =>
    Bool
    -> (Maybe (CDeclarator NodeInfo), Maybe a,
        Maybe (CExpression NodeInfo))
    -> m MemberDecl
    tMemberDecl (Bool
    TrueBool -> [Bool] -> [Bool]
    forall a. a -> [a] -> [a]
    :Bool -> [Bool]
    forall a. a -> [a]
    repeat Bool
    False) [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    declrs
        where
        tMemberDecl :: Bool
    -> (Maybe (CDeclarator NodeInfo), Maybe a,
        Maybe (CExpression NodeInfo))
    -> m MemberDecl
    tMemberDecl Bool
    handle_sue_def (Just CDeclarator NodeInfo
    member_declr,Maybe a
    Nothing,Maybe (CExpression NodeInfo)
    bit_field_size_opt) =
            -- TODO: use analyseVarDecl here, not analyseVarDecl'
            do var_decl <- Bool
    -> [CDeclarationSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> [CDecl]
    -> Maybe (CInitializer NodeInfo)
    -> m VarDeclInfo
    forall (m :: * -> *).
    MonadTrav m =>
    Bool
    -> [CDeclarationSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> [CDecl]
    -> Maybe (CInitializer NodeInfo)
    -> m VarDeclInfo
    analyseVarDecl' Bool
    handle_sue_def [CDeclarationSpecifier NodeInfo]
    declspecs CDeclarator NodeInfo
    member_declr [] Maybe (CInitializer NodeInfo)
    forall a. Maybe a
    Nothing
               let (VarDeclInfo name fun_spec storage_spec attrs ty _node_info) = var_decl
               --
               checkValidMemberSpec fun_spec storage_spec
               return $ MemberDecl (VarDecl name (DeclAttrs noFunctionAttrs NoStorage attrs) ty)
                                   bit_field_size_opt node
        tMemberDecl Bool
    handle_sue_def (Maybe (CDeclarator NodeInfo)
    Nothing,Maybe a
    Nothing,Just CExpression NodeInfo
    bit_field_size) =
            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
               -- TODO: funspecs/alignspecs not yet processed
               _storage_spec  <- [CStorageSpecifier NodeInfo] -> m StorageSpec
    forall (m :: * -> *).
    MonadCError m =>
    [CStorageSpecifier NodeInfo] -> m StorageSpec
    canonicalStorageSpec [CStorageSpecifier NodeInfo]
    storage_specs
               -- TODO: storage_spec not used
               canonTySpecs  <- canonicalTypeSpec typespecs
               typ           <- tType handle_sue_def node typequals canonTySpecs [] []
               --
               return $ AnonBitField typ bit_field_size node
        tMemberDecl Bool
    _ (Maybe (CDeclarator NodeInfo), Maybe a,
     Maybe (CExpression NodeInfo))
    _ = NodeInfo -> String -> m MemberDecl
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "Bad member declaration"
        checkValidMemberSpec :: FunctionAttrs -> StorageSpec -> m ()
    checkValidMemberSpec FunctionAttrs
    fun_spec StorageSpec
    storage_spec =
            do  Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (FunctionAttrs
    fun_spec FunctionAttrs -> FunctionAttrs -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FunctionAttrs
    noFunctionAttrs)   (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> String -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "member declaration with inline specifier"
                Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (StorageSpec
    storage_spec StorageSpec -> StorageSpec -> Bool
    forall a. Eq a => a -> a -> Bool
    /= StorageSpec
    NoStorageSpec) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> String -> m ()
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "storage specifier for member"
                () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    data StorageSpec = NoStorageSpec | AutoSpec | RegSpec | ThreadSpec | StaticSpec Bool | ExternSpec Bool
                     | ClKernelSpec | ClGlobalSpec | ClLocalSpec
                        deriving (StorageSpec -> StorageSpec -> Bool
    (StorageSpec -> StorageSpec -> Bool)
    -> (StorageSpec -> StorageSpec -> Bool) -> Eq StorageSpec
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: StorageSpec -> StorageSpec -> Bool
    == :: StorageSpec -> StorageSpec -> Bool
    $c/= :: StorageSpec -> StorageSpec -> Bool
    /= :: StorageSpec -> StorageSpec -> Bool
    Eq,Eq StorageSpec
    Eq StorageSpec =>
    (StorageSpec -> StorageSpec -> Ordering)
    -> (StorageSpec -> StorageSpec -> Bool)
    -> (StorageSpec -> StorageSpec -> Bool)
    -> (StorageSpec -> StorageSpec -> Bool)
    -> (StorageSpec -> StorageSpec -> Bool)
    -> (StorageSpec -> StorageSpec -> StorageSpec)
    -> (StorageSpec -> StorageSpec -> StorageSpec)
    -> Ord StorageSpec
    StorageSpec -> StorageSpec -> Bool
    StorageSpec -> StorageSpec -> Ordering
    StorageSpec -> StorageSpec -> StorageSpec
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: StorageSpec -> StorageSpec -> Ordering
    compare :: StorageSpec -> StorageSpec -> Ordering
    $c< :: StorageSpec -> StorageSpec -> Bool
    < :: StorageSpec -> StorageSpec -> Bool
    $c<= :: StorageSpec -> StorageSpec -> Bool
    <= :: StorageSpec -> StorageSpec -> Bool
    $c> :: StorageSpec -> StorageSpec -> Bool
    > :: StorageSpec -> StorageSpec -> Bool
    $c>= :: StorageSpec -> StorageSpec -> Bool
    >= :: StorageSpec -> StorageSpec -> Bool
    $cmax :: StorageSpec -> StorageSpec -> StorageSpec
    max :: StorageSpec -> StorageSpec -> StorageSpec
    $cmin :: StorageSpec -> StorageSpec -> StorageSpec
    min :: StorageSpec -> StorageSpec -> StorageSpec
    Ord,Int -> StorageSpec -> String -> String
    [StorageSpec] -> String -> String
    StorageSpec -> String
    (Int -> StorageSpec -> String -> String)
    -> (StorageSpec -> String)
    -> ([StorageSpec] -> String -> String)
    -> Show StorageSpec
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> StorageSpec -> String -> String
    showsPrec :: Int -> StorageSpec -> String -> String
    $cshow :: StorageSpec -> String
    show :: StorageSpec -> String
    $cshowList :: [StorageSpec] -> String -> String
    showList :: [StorageSpec] -> String -> String
    Show,ReadPrec [StorageSpec]
    ReadPrec StorageSpec
    Int -> ReadS StorageSpec
    ReadS [StorageSpec]
    (Int -> ReadS StorageSpec)
    -> ReadS [StorageSpec]
    -> ReadPrec StorageSpec
    -> ReadPrec [StorageSpec]
    -> Read StorageSpec
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS StorageSpec
    readsPrec :: Int -> ReadS StorageSpec
    $creadList :: ReadS [StorageSpec]
    readList :: ReadS [StorageSpec]
    $creadPrec :: ReadPrec StorageSpec
    readPrec :: ReadPrec StorageSpec
    $creadListPrec :: ReadPrec [StorageSpec]
    readListPrec :: ReadPrec [StorageSpec]
    Read)

    hasThreadLocalSpec :: StorageSpec -> Bool
    hasThreadLocalSpec :: StorageSpec -> Bool
    hasThreadLocalSpec StorageSpec
    ThreadSpec = Bool
    True
    hasThreadLocalSpec StorageSpec
    ClLocalSpec = Bool
    True
    hasThreadLocalSpec (StaticSpec Bool
    b) = Bool
    b
    hasThreadLocalSpec (ExternSpec Bool
    b) = Bool
    b
    hasThreadLocalSpec StorageSpec
    _  = Bool
    False

    hasClKernelSpec :: StorageSpec -> Bool
    hasClKernelSpec :: StorageSpec -> Bool
    hasClKernelSpec StorageSpec
    ClKernelSpec = Bool
    True

    data VarDeclInfo = VarDeclInfo VarName FunctionAttrs StorageSpec Attributes Type NodeInfo

    analyseVarDecl' :: (MonadTrav m) =>
                      Bool -> [CDeclSpec] ->
                      CDeclr -> [CDecl] -> Maybe CInit -> m VarDeclInfo
    analyseVarDecl' :: forall (m :: * -> *).
    MonadTrav m =>
    Bool
    -> [CDeclarationSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> [CDecl]
    -> Maybe (CInitializer NodeInfo)
    -> m VarDeclInfo
    analyseVarDecl' Bool
    handle_sue_def [CDeclarationSpecifier NodeInfo]
    declspecs CDeclarator NodeInfo
    declr [CDecl]
    oldstyle Maybe (CInitializer NodeInfo)
    init_opt =
      do let ([CStorageSpecifier NodeInfo]
    storage_specs, [CAttribute NodeInfo]
    attrs, [CTypeQualifier NodeInfo]
    type_quals, [CTypeSpecifier NodeInfo]
    type_specs, [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]
    type_specs
         -- TODO: alignspecs not yet processed
         analyseVarDecl handle_sue_def storage_specs attrs type_quals canonTySpecs funspecs
                        declr oldstyle init_opt

    -- | analyse declarators
    analyseVarDecl :: (MonadTrav m) =>
                      Bool -> [CStorageSpec] -> [CAttr] -> [CTypeQual] ->
                      TypeSpecAnalysis -> [CFunSpec] ->
                      CDeclr -> [CDecl] -> Maybe CInit -> m VarDeclInfo
    analyseVarDecl :: forall (m :: * -> *).
    MonadTrav m =>
    Bool
    -> [CStorageSpecifier NodeInfo]
    -> [CAttribute NodeInfo]
    -> [CTypeQualifier NodeInfo]
    -> TypeSpecAnalysis
    -> [CFunctionSpecifier NodeInfo]
    -> CDeclarator NodeInfo
    -> [CDecl]
    -> Maybe (CInitializer NodeInfo)
    -> m VarDeclInfo
    analyseVarDecl Bool
    handle_sue_def [CStorageSpecifier NodeInfo]
    storage_specs [CAttribute NodeInfo]
    decl_attrs [CTypeQualifier NodeInfo]
    typequals TypeSpecAnalysis
    canonTySpecs [CFunctionSpecifier NodeInfo]
    fun_specs
                   (CDeclr Maybe Ident
    name_opt [CDerivedDeclr]
    derived_declrs Maybe (CStringLiteral NodeInfo)
    asmname_opt [CAttribute NodeInfo]
    declr_attrs NodeInfo
    node)
                   [CDecl]
    oldstyle_params Maybe (CInitializer NodeInfo)
    _init_opt
        = do -- analyse the storage specifiers
             storage_spec  <- [CStorageSpecifier NodeInfo] -> m StorageSpec
    forall (m :: * -> *).
    MonadCError m =>
    [CStorageSpecifier NodeInfo] -> m StorageSpec
    canonicalStorageSpec [CStorageSpecifier NodeInfo]
    storage_specs
             -- translate the type into semantic representation
             typ          <- tType handle_sue_def node typequals canonTySpecs derived_declrs oldstyle_params
             -- translate attributes
             attrs'       <- mapM tAttr (decl_attrs ++ declr_attrs)
             -- make name
             name         <- mkVarName node name_opt asmname_opt
             return $ VarDeclInfo name function_spec storage_spec attrs' typ node
        where
            updateFunSpec :: CFunctionSpecifier a -> FunctionAttrs -> FunctionAttrs
    updateFunSpec (CInlineQual a
    _) FunctionAttrs
    f = FunctionAttrs
    f { isInline = True }
            updateFunSpec (CNoreturnQual a
    _) FunctionAttrs
    f = FunctionAttrs
    f { isNoreturn = True }
            function_spec :: FunctionAttrs
    function_spec = (CFunctionSpecifier NodeInfo -> FunctionAttrs -> FunctionAttrs)
    -> FunctionAttrs -> [CFunctionSpecifier NodeInfo] -> FunctionAttrs
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CFunctionSpecifier NodeInfo -> FunctionAttrs -> FunctionAttrs
    forall {a}. CFunctionSpecifier a -> FunctionAttrs -> FunctionAttrs
    updateFunSpec FunctionAttrs
    noFunctionAttrs [CFunctionSpecifier NodeInfo]
    fun_specs

    -- return @True@ if the declarations is a type def
    isTypeDef :: [CDeclSpec] -> Bool
    isTypeDef :: [CDeclarationSpecifier NodeInfo] -> Bool
    isTypeDef [CDeclarationSpecifier NodeInfo]
    declspecs = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [NodeInfo] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ NodeInfo
    n | (CStorageSpec (CTypedef NodeInfo
    n)) <- [CDeclarationSpecifier NodeInfo]
    declspecs ]

    -- * translation

    -- | get the type of a /type declaration/
    --
    -- A type declaration @T@ may appear in thre forms:
    --
    --  * @typeof(T)@
    --
    --  * as abstract declarator in a function prototype, as in @f(int)@
    --
    --  * in a declaration without declarators, as in @struct x { int a } ;@
    --
    -- Currently, @analyseTypeDecl@ is exlusively used for analysing types for GNU's @typeof(T)@.
    --
    -- We move attributes to the type, as they have no meaning for the abstract declarator
    analyseTypeDecl :: (MonadTrav m) => CDecl -> m Type
    analyseTypeDecl :: forall (m :: * -> *). MonadTrav m => CDecl -> m Type
    analyseTypeDecl (CStaticAssert CExpression NodeInfo
    _ CStringLiteral NodeInfo
    _ NodeInfo
    node) =
      NodeInfo -> String -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "Expected type declaration, found static assert"
    analyseTypeDecl (CDecl [CDeclarationSpecifier NodeInfo]
    declspecs [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    declrs NodeInfo
    node)
        | [] <- [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    declrs = CDeclarator NodeInfo -> m Type
    forall {m :: * -> *}. MonadTrav m => CDeclarator NodeInfo -> m Type
    analyseTyDeclr (NodeInfo -> CDeclarator NodeInfo
    emptyDeclr NodeInfo
    node)
        | [(Just CDeclarator NodeInfo
    declr,Maybe (CInitializer NodeInfo)
    Nothing,Maybe (CExpression NodeInfo)
    Nothing)] <- [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    declrs = CDeclarator NodeInfo -> m Type
    forall {m :: * -> *}. MonadTrav m => CDeclarator NodeInfo -> m Type
    analyseTyDeclr CDeclarator NodeInfo
    declr
        | Bool
    otherwise = NodeInfo -> String -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "Bad declarator for type declaration"
        where
        analyseTyDeclr :: CDeclarator NodeInfo -> m Type
    analyseTyDeclr (CDeclr Maybe Ident
    Nothing [CDerivedDeclr]
    derived_declrs Maybe (CStringLiteral NodeInfo)
    Nothing [CAttribute NodeInfo]
    attrs NodeInfo
    _declrnode)
            | (Bool -> Bool
    not ([CStorageSpecifier NodeInfo] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CStorageSpecifier NodeInfo]
    storagespec) Bool -> Bool -> Bool
    || Bool -> Bool
    not ([CFunctionSpecifier NodeInfo] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CFunctionSpecifier NodeInfo]
    funspecs) Bool -> Bool -> Bool
    || Bool -> Bool
    not ([CAlignmentSpecifier NodeInfo] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CAlignmentSpecifier NodeInfo]
    alignspecs)) =
                NodeInfo -> String -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "storage, function or alignment specifier for type declaration"
            | Bool
    otherwise                          =
              do canonTySpecs <- [CTypeSpecifier NodeInfo] -> m TypeSpecAnalysis
    forall (m :: * -> *).
    MonadTrav m =>
    [CTypeSpecifier NodeInfo] -> m TypeSpecAnalysis
    canonicalTypeSpec [CTypeSpecifier NodeInfo]
    typespecs
                 t <- tType True node (map CAttrQual (attrs++attrs_decl) ++ typequals)
                       canonTySpecs derived_declrs []
                 case nameOfNode node of
                   Just Name
    n -> (DefTable -> (Type, DefTable)) -> m Type
    forall a. (DefTable -> (a, DefTable)) -> m a
    forall (m :: * -> *) a.
    MonadSymtab m =>
    (DefTable -> (a, DefTable)) -> m a
    withDefTable (\DefTable
    dt -> (Type
    t, DefTable -> Name -> Type -> DefTable
    insertType DefTable
    dt Name
    n Type
    t))
                   Maybe Name
    Nothing -> Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    t
            where
            ([CStorageSpecifier NodeInfo]
    storagespec, [CAttribute NodeInfo]
    attrs_decl, [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
        analyseTyDeclr CDeclarator NodeInfo
    _ = NodeInfo -> String -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "Non-abstract declarator in type declaration"

    -- | translate a type
    tType :: (MonadTrav m) => Bool -> NodeInfo -> [CTypeQual] -> TypeSpecAnalysis -> [CDerivedDeclr] -> [CDecl] -> m Type
    tType :: forall (m :: * -> *).
    MonadTrav m =>
    Bool
    -> NodeInfo
    -> [CTypeQualifier NodeInfo]
    -> TypeSpecAnalysis
    -> [CDerivedDeclr]
    -> [CDecl]
    -> m Type
    tType Bool
    handle_sue_def NodeInfo
    top_node [CTypeQualifier NodeInfo]
    typequals TypeSpecAnalysis
    canonTySpecs [CDerivedDeclr]
    derived_declrs [CDecl]
    oldstyle_params
        = NodeInfo -> [CDecl] -> [CDerivedDeclr] -> m [CDerivedDeclr]
    forall (m :: * -> *).
    MonadCError m =>
    NodeInfo -> [CDecl] -> [CDerivedDeclr] -> m [CDerivedDeclr]
    mergeOldStyle NodeInfo
    top_node [CDecl]
    oldstyle_params [CDerivedDeclr]
    derived_declrs m [CDerivedDeclr] -> ([CDerivedDeclr] -> 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
    >>= [CDerivedDeclr] -> m Type
    forall {m :: * -> *}. MonadTrav m => [CDerivedDeclr] -> m Type
    buildType
        where
        buildType :: [CDerivedDeclr] -> m Type
    buildType [] =
            Bool
    -> NodeInfo
    -> [CTypeQualifier NodeInfo]
    -> TypeSpecAnalysis
    -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    Bool
    -> NodeInfo
    -> [CTypeQualifier NodeInfo]
    -> TypeSpecAnalysis
    -> m Type
    tDirectType Bool
    handle_sue_def NodeInfo
    top_node [CTypeQualifier NodeInfo]
    typequals TypeSpecAnalysis
    canonTySpecs
        buildType (CPtrDeclr [CTypeQualifier NodeInfo]
    ptrquals NodeInfo
    node : [CDerivedDeclr]
    dds) =
            [CDerivedDeclr] -> m Type
    buildType [CDerivedDeclr]
    dds 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
    >>= [CTypeQualifier NodeInfo] -> NodeInfo -> Type -> m Type
    forall {m :: * -> *} {p}.
    MonadTrav m =>
    [CTypeQualifier NodeInfo] -> p -> Type -> m Type
    buildPointerType [CTypeQualifier NodeInfo]
    ptrquals NodeInfo
    node
        buildType (CArrDeclr [CTypeQualifier NodeInfo]
    arrquals CArraySize NodeInfo
    size NodeInfo
    node : [CDerivedDeclr]
    dds)
            = [CDerivedDeclr] -> m Type
    buildType [CDerivedDeclr]
    dds 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
    >>= [CTypeQualifier NodeInfo]
    -> CArraySize NodeInfo -> NodeInfo -> Type -> m Type
    forall {m :: * -> *} {p}.
    MonadTrav m =>
    [CTypeQualifier NodeInfo]
    -> CArraySize NodeInfo -> p -> Type -> m Type
    buildArrayType [CTypeQualifier NodeInfo]
    arrquals CArraySize NodeInfo
    size NodeInfo
    node
        buildType (CFunDeclr (Right ([CDecl]
    params, Bool
    isVariadic)) [CAttribute NodeInfo]
    attrs NodeInfo
    node : [CDerivedDeclr]
    dds)
            = [CDerivedDeclr] -> m Type
    buildType [CDerivedDeclr]
    dds 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
    >>= (((FunType, Attributes) -> Type)
    -> m (FunType, Attributes) -> m Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM  ((FunType -> Attributes -> Type) -> (FunType, Attributes) -> Type
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry FunType -> Attributes -> Type
    FunctionType) (m (FunType, Attributes) -> m Type)
    -> (Type -> m (FunType, Attributes)) -> Type -> m Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [CDecl]
    -> Bool
    -> [CAttribute NodeInfo]
    -> NodeInfo
    -> Type
    -> m (FunType, Attributes)
    forall {m :: * -> *} {t :: * -> *} {p}.
    (MonadTrav m, Traversable t) =>
    [CDecl]
    -> Bool
    -> t (CAttribute NodeInfo)
    -> p
    -> Type
    -> m (FunType, t Attr)
    buildFunctionType [CDecl]
    params Bool
    isVariadic [CAttribute NodeInfo]
    attrs NodeInfo
    node)
        buildType (CFunDeclr (Left [Ident]
    _) [CAttribute NodeInfo]
    _ NodeInfo
    _ : [CDerivedDeclr]
    _)
            -- /FIXME/: this is really an internal error, not an AST error.
            = NodeInfo -> String -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    top_node String
    "old-style parameters remaining after mergeOldStyle"
        buildPointerType :: [CTypeQualifier NodeInfo] -> p -> Type -> m Type
    buildPointerType [CTypeQualifier NodeInfo]
    ptrquals p
    _node Type
    inner_ty
            = ((TypeQuals, Attributes) -> Type)
    -> m (TypeQuals, Attributes) -> m Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (\(TypeQuals
    quals,Attributes
    attrs) -> Type -> TypeQuals -> Attributes -> Type
    PtrType Type
    inner_ty TypeQuals
    quals Attributes
    attrs) ([CTypeQualifier NodeInfo] -> m (TypeQuals, Attributes)
    forall (m :: * -> *).
    MonadTrav m =>
    [CTypeQualifier NodeInfo] -> m (TypeQuals, Attributes)
    tTypeQuals [CTypeQualifier NodeInfo]
    ptrquals)
        buildArrayType :: [CTypeQualifier NodeInfo]
    -> CArraySize NodeInfo -> p -> Type -> m Type
    buildArrayType [CTypeQualifier NodeInfo]
    arr_quals CArraySize NodeInfo
    size p
    _node Type
    inner_ty
            = do (quals,attrs) <- [CTypeQualifier NodeInfo] -> m (TypeQuals, Attributes)
    forall (m :: * -> *).
    MonadTrav m =>
    [CTypeQualifier NodeInfo] -> m (TypeQuals, Attributes)
    tTypeQuals [CTypeQualifier NodeInfo]
    arr_quals
                 arr_sz        <- tArraySize size
                 return$ ArrayType inner_ty arr_sz quals attrs
        -- We build functions in function prototype scope.
        -- When analyzing the  the function body, we push parameters in function body scope.
        buildFunctionType :: [CDecl]
    -> Bool
    -> t (CAttribute NodeInfo)
    -> p
    -> Type
    -> m (FunType, t Attr)
    buildFunctionType [CDecl]
    params Bool
    is_variadic t (CAttribute NodeInfo)
    attrs p
    _node Type
    return_ty
            = do m ()
    forall (m :: * -> *). MonadSymtab m => m ()
    enterPrototypeScope
                 params' <- (CDecl -> m ParamDecl) -> [CDecl] -> m [ParamDecl]
    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 CDecl -> m ParamDecl
    forall (m :: * -> *). MonadTrav m => CDecl -> m ParamDecl
    tParamDecl [CDecl]
    params
                 leavePrototypeScope
                 attrs'  <- mapM tAttr attrs
                 return $ (\FunType
    t -> (FunType
    t,t Attr
    attrs')) $
                    case (map declType params',is_variadic) of
                        ([],Bool
    False) -> Type -> FunType
    FunTypeIncomplete Type
    return_ty  -- may be improved later on
                        ([DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _],Bool
    False) -> Type -> [ParamDecl] -> Bool -> FunType
    FunType Type
    return_ty [] Bool
    False
                        ([Type], Bool)
    _ -> Type -> [ParamDecl] -> Bool -> FunType
    FunType Type
    return_ty [ParamDecl]
    params' Bool
    is_variadic

    -- | translate a type without (syntactic) indirections
    -- Due to the GNU @typeof@ extension and typeDefs, this can be an arbitrary type
    tDirectType :: (MonadTrav m) =>
                   Bool -> NodeInfo -> [CTypeQual] -> TypeSpecAnalysis -> m Type
    tDirectType :: forall (m :: * -> *).
    MonadTrav m =>
    Bool
    -> NodeInfo
    -> [CTypeQualifier NodeInfo]
    -> TypeSpecAnalysis
    -> m Type
    tDirectType Bool
    handle_sue_def NodeInfo
    node [CTypeQualifier NodeInfo]
    ty_quals TypeSpecAnalysis
    canonTySpec = do
        (quals,attrs) <- [CTypeQualifier NodeInfo] -> m (TypeQuals, Attributes)
    forall (m :: * -> *).
    MonadTrav m =>
    [CTypeQualifier NodeInfo] -> m (TypeQuals, Attributes)
    tTypeQuals [CTypeQualifier NodeInfo]
    ty_quals
        let baseType TypeName
    ty_name = TypeName -> TypeQuals -> Attributes -> Type
    DirectType TypeName
    ty_name TypeQuals
    quals Attributes
    attrs
        case canonTySpec of
            TypeSpecAnalysis
    TSNone -> 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 -> Type
    baseType (IntType -> TypeName
    TyIntegral IntType
    TyInt)
            TypeSpecAnalysis
    TSVoid -> 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 -> Type
    baseType TypeName
    TyVoid
            TypeSpecAnalysis
    TSBool -> 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 -> Type
    baseType (IntType -> TypeName
    TyIntegral IntType
    TyBool)
            TSNum NumTypeSpec
    tsnum -> do
                numType <- NumTypeSpec -> m (Either (FloatType, Bool) IntType)
    forall (m :: * -> *).
    MonadCError m =>
    NumTypeSpec -> m (Either (FloatType, Bool) IntType)
    tNumType NumTypeSpec
    tsnum
                return . baseType $
                    case numType of
                        Left (FloatType
    floatType,Bool
    iscomplex) | Bool
    iscomplex -> FloatType -> TypeName
    TyComplex FloatType
    floatType
                                                   | Bool
    otherwise -> FloatType -> TypeName
    TyFloating FloatType
    floatType
                        Right IntType
    intType  -> IntType -> TypeName
    TyIntegral IntType
    intType
            TSTypeDef TypeDefRef
    tdr -> 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
    $ TypeDefRef -> TypeQuals -> Attributes -> Type
    TypeDefType TypeDefRef
    tdr TypeQuals
    quals Attributes
    attrs
            TSNonBasic (CSUType CStructureUnion NodeInfo
    su NodeInfo
    _tnode)       -> (CompTypeRef -> Type) -> m CompTypeRef -> m Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (TypeName -> Type
    baseType (TypeName -> Type)
    -> (CompTypeRef -> TypeName) -> CompTypeRef -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CompTypeRef -> TypeName
    TyComp) (m CompTypeRef -> m Type) -> m CompTypeRef -> m Type
    forall a b. (a -> b) -> a -> b
    $ Bool -> CStructureUnion NodeInfo -> m CompTypeRef
    forall (m :: * -> *).
    MonadTrav m =>
    Bool -> CStructureUnion NodeInfo -> m CompTypeRef
    tCompTypeDecl Bool
    handle_sue_def CStructureUnion NodeInfo
    su
            TSNonBasic (CEnumType CEnumeration NodeInfo
    enum NodeInfo
    _tnode)   -> (EnumTypeRef -> Type) -> m EnumTypeRef -> m Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (TypeName -> Type
    baseType (TypeName -> Type)
    -> (EnumTypeRef -> TypeName) -> EnumTypeRef -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EnumTypeRef -> TypeName
    TyEnum) (m EnumTypeRef -> m Type) -> m EnumTypeRef -> m Type
    forall a b. (a -> b) -> a -> b
    $ Bool -> CEnumeration NodeInfo -> m EnumTypeRef
    forall (m :: * -> *).
    MonadTrav m =>
    Bool -> CEnumeration NodeInfo -> m EnumTypeRef
    tEnumTypeDecl Bool
    handle_sue_def CEnumeration NodeInfo
    enum
            TSType Type
    t                             ->  NodeInfo -> TypeQuals -> Attributes -> Type -> m Type
    forall (m :: * -> *).
    MonadCError m =>
    NodeInfo -> TypeQuals -> Attributes -> Type -> m Type
    mergeTypeAttributes NodeInfo
    node TypeQuals
    quals Attributes
    attrs Type
    t
            TSNonBasic CTypeSpecifier NodeInfo
    t -> NodeInfo -> String -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node (String
    "Unexpected typespec: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CTypeSpecifier NodeInfo -> String
    forall a. Show a => a -> String
    show CTypeSpecifier NodeInfo
    t)

    -- | Merge type attributes
    --
    -- This handles for example the form
    --
    -- > /* tyqual attr typeof(type) */
    -- > const typeof(char volatile) x;
    mergeTypeAttributes :: (MonadCError m) => NodeInfo -> TypeQuals -> [Attr] -> Type -> m Type
    mergeTypeAttributes :: forall (m :: * -> *).
    MonadCError m =>
    NodeInfo -> TypeQuals -> Attributes -> Type -> m Type
    mergeTypeAttributes NodeInfo
    node_info TypeQuals
    quals Attributes
    attrs Type
    typ =
        case Type
    typ of
            DirectType TypeName
    ty_name TypeQuals
    quals' Attributes
    attrs' -> TypeQuals
    -> Attributes -> (TypeQuals -> Attributes -> Type) -> m Type
    forall {m :: * -> *} {a}.
    Monad m =>
    TypeQuals -> Attributes -> (TypeQuals -> Attributes -> a) -> m a
    merge TypeQuals
    quals' Attributes
    attrs' ((TypeQuals -> Attributes -> Type) -> m Type)
    -> (TypeQuals -> Attributes -> Type) -> m Type
    forall a b. (a -> b) -> a -> b
    $ TypeName -> TypeQuals -> Attributes -> Type
    DirectType TypeName
    ty_name
            PtrType Type
    ty TypeQuals
    quals' Attributes
    attrs'  -> TypeQuals
    -> Attributes -> (TypeQuals -> Attributes -> Type) -> m Type
    forall {m :: * -> *} {a}.
    Monad m =>
    TypeQuals -> Attributes -> (TypeQuals -> Attributes -> a) -> m a
    merge TypeQuals
    quals' Attributes
    attrs' ((TypeQuals -> Attributes -> Type) -> m Type)
    -> (TypeQuals -> Attributes -> Type) -> m Type
    forall a b. (a -> b) -> a -> b
    $ Type -> TypeQuals -> Attributes -> Type
    PtrType Type
    ty
            ArrayType Type
    ty ArraySize
    array_sz TypeQuals
    quals' Attributes
    attrs' -> TypeQuals
    -> Attributes -> (TypeQuals -> Attributes -> Type) -> m Type
    forall {m :: * -> *} {a}.
    Monad m =>
    TypeQuals -> Attributes -> (TypeQuals -> Attributes -> a) -> m a
    merge TypeQuals
    quals' Attributes
    attrs' ((TypeQuals -> Attributes -> Type) -> m Type)
    -> (TypeQuals -> Attributes -> Type) -> m Type
    forall a b. (a -> b) -> a -> b
    $ Type -> ArraySize -> TypeQuals -> Attributes -> Type
    ArrayType Type
    ty ArraySize
    array_sz
            FunctionType FunType
    fty Attributes
    attrs'
                 | TypeQuals
    quals TypeQuals -> TypeQuals -> Bool
    forall a. Eq a => a -> a -> Bool
    /= TypeQuals
    noTypeQuals -> NodeInfo -> String -> m Type
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node_info String
    "type qualifiers for function type"
                 | Bool
    otherwise            -> 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 FunType
    fty (Attributes
    attrs' Attributes -> Attributes -> Attributes
    forall a. [a] -> [a] -> [a]
    ++ Attributes
    attrs)
            TypeDefType TypeDefRef
    tdr TypeQuals
    quals' Attributes
    attrs'
                -> TypeQuals
    -> Attributes -> (TypeQuals -> Attributes -> Type) -> m Type
    forall {m :: * -> *} {a}.
    Monad m =>
    TypeQuals -> Attributes -> (TypeQuals -> Attributes -> a) -> m a
    merge TypeQuals
    quals' Attributes
    attrs' ((TypeQuals -> Attributes -> Type) -> m Type)
    -> (TypeQuals -> Attributes -> Type) -> m Type
    forall a b. (a -> b) -> a -> b
    $ TypeDefRef -> TypeQuals -> Attributes -> Type
    TypeDefType TypeDefRef
    tdr
        where
        merge :: TypeQuals -> Attributes -> (TypeQuals -> Attributes -> a) -> m a
    merge TypeQuals
    quals' Attributes
    attrs' TypeQuals -> Attributes -> a
    tyf = a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> m a) -> a -> m a
    forall a b. (a -> b) -> a -> b
    $ TypeQuals -> Attributes -> a
    tyf (TypeQuals -> TypeQuals -> TypeQuals
    mergeTypeQuals TypeQuals
    quals TypeQuals
    quals') (Attributes
    attrs' Attributes -> Attributes -> Attributes
    forall a. [a] -> [a] -> [a]
    ++ Attributes
    attrs)

    typeDefRef :: (MonadCError m, MonadSymtab m) => NodeInfo -> Ident -> m TypeDefRef
    typeDefRef :: forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> Ident -> m TypeDefRef
    typeDefRef NodeInfo
    t_node Ident
    name = Ident -> m Type
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Ident -> m Type
    lookupTypeDef Ident
    name m Type -> (Type -> m TypeDefRef) -> m TypeDefRef
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Type
    ty -> TypeDefRef -> m TypeDefRef
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ident -> Type -> NodeInfo -> TypeDefRef
    TypeDefRef Ident
    name Type
    ty NodeInfo
    t_node)

    -- extract a struct\/union
    -- we emit @declStructUnion@ and @defStructUnion@ actions
    --
    -- TODO: should attributes be part of declarartions too ?
    tCompTypeDecl :: (MonadTrav m) => Bool -> CStructUnion -> m CompTypeRef
    tCompTypeDecl :: forall (m :: * -> *).
    MonadTrav m =>
    Bool -> CStructureUnion NodeInfo -> m CompTypeRef
    tCompTypeDecl Bool
    handle_def (CStruct CStructTag
    tag Maybe Ident
    ident_opt Maybe [CDecl]
    member_decls_opt [CAttribute NodeInfo]
    attrs NodeInfo
    node_info) = do
        -- create reference
        sue_ref <- NodeInfo -> Maybe Ident -> m SUERef
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> Maybe Ident -> m SUERef
    createSUERef NodeInfo
    node_info Maybe Ident
    ident_opt
        let tag' = CStructTag -> CompTyKind
    tTag CStructTag
    tag
        attrs' <- mapM tAttr attrs
        -- record tag name
        let decl = SUERef -> CompTyKind -> NodeInfo -> CompTypeRef
    CompTypeRef SUERef
    sue_ref CompTyKind
    tag' NodeInfo
    node_info
        handleTagDecl (CompDecl decl)
        -- when handle_def is true, enter the definition
        when handle_def $
            maybeM member_decls_opt $ \[CDecl]
    decls ->
                    SUERef
    -> CompTyKind -> [CDecl] -> Attributes -> NodeInfo -> m CompType
    forall (m :: * -> *).
    MonadTrav m =>
    SUERef
    -> CompTyKind -> [CDecl] -> Attributes -> NodeInfo -> m CompType
    tCompType SUERef
    sue_ref CompTyKind
    tag' [CDecl]
    decls Attributes
    attrs' NodeInfo
    node_info
                m CompType -> (CompType -> 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
    >>= (TagDef -> m ()
    forall (m :: * -> *). MonadTrav m => TagDef -> m ()
    handleTagDef(TagDef -> m ()) -> (CompType -> TagDef) -> CompType -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .CompType -> TagDef
    CompDef)
        return decl

    tTag :: CStructTag -> CompTyKind
    tTag :: CStructTag -> CompTyKind
    tTag CStructTag
    CStructTag = CompTyKind
    StructTag
    tTag CStructTag
    CUnionTag  = CompTyKind
    UnionTag

    tCompType :: (MonadTrav m) => SUERef -> CompTyKind -> [CDecl] -> Attributes -> NodeInfo -> m CompType
    tCompType :: forall (m :: * -> *).
    MonadTrav m =>
    SUERef
    -> CompTyKind -> [CDecl] -> Attributes -> NodeInfo -> m CompType
    tCompType SUERef
    tag CompTyKind
    sue_ref [CDecl]
    member_decls Attributes
    attrs NodeInfo
    node
        = ([MemberDecl] -> Attributes -> NodeInfo -> CompType)
    -> m ([MemberDecl] -> Attributes -> NodeInfo -> CompType)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SUERef
    -> CompTyKind -> [MemberDecl] -> Attributes -> NodeInfo -> CompType
    CompType SUERef
    tag CompTyKind
    sue_ref) m ([MemberDecl] -> Attributes -> NodeInfo -> CompType)
    -> m [MemberDecl] -> m (Attributes -> NodeInfo -> CompType)
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    `ap`
            ((CDecl -> m [MemberDecl]) -> [CDecl] -> m [MemberDecl]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    concatMapM CDecl -> m [MemberDecl]
    forall (m :: * -> *). MonadTrav m => CDecl -> m [MemberDecl]
    tMemberDecls [CDecl]
    member_decls) m (Attributes -> NodeInfo -> CompType)
    -> m Attributes -> m (NodeInfo -> CompType)
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    `ap`
            (Attributes -> m Attributes
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Attributes
    attrs) m (NodeInfo -> CompType) -> m NodeInfo -> m CompType
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    `ap`
            (NodeInfo -> m NodeInfo
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return NodeInfo
    node)

    -- | translate a enum type decl
    --
    --  > enum my_enum
    --  > enum your_enum { x, y=3 }
    --
    tEnumTypeDecl :: (MonadTrav m) => Bool -> CEnum -> m EnumTypeRef
    tEnumTypeDecl :: forall (m :: * -> *).
    MonadTrav m =>
    Bool -> CEnumeration NodeInfo -> m EnumTypeRef
    tEnumTypeDecl Bool
    handle_def (CEnum Maybe Ident
    ident_opt Maybe [(Ident, Maybe (CExpression NodeInfo))]
    enumerators_opt [CAttribute NodeInfo]
    attrs NodeInfo
    node_info)
        | (Maybe Ident
    Nothing, Maybe [(Ident, Maybe (CExpression NodeInfo))]
    Nothing) <- (Maybe Ident
    ident_opt, Maybe [(Ident, Maybe (CExpression NodeInfo))]
    enumerators_opt) = NodeInfo -> String -> m EnumTypeRef
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node_info String
    "both definition and name of enum missing"
        | Just [] <- Maybe [(Ident, Maybe (CExpression NodeInfo))]
    enumerators_opt                         = NodeInfo -> String -> m EnumTypeRef
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node_info String
    "empty enumerator list"
        | Bool
    otherwise
            = do sue_ref <- NodeInfo -> Maybe Ident -> m SUERef
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> Maybe Ident -> m SUERef
    createSUERef NodeInfo
    node_info Maybe Ident
    ident_opt
                 attrs' <- mapM tAttr attrs
                 let decl = SUERef -> NodeInfo -> EnumTypeRef
    EnumTypeRef SUERef
    sue_ref NodeInfo
    node_info
                 when handle_def $
                     maybeM enumerators_opt $ \[(Ident, Maybe (CExpression NodeInfo))]
    enumerators ->
                             SUERef
    -> [(Ident, Maybe (CExpression NodeInfo))]
    -> Attributes
    -> NodeInfo
    -> m EnumType
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    SUERef
    -> [(Ident, Maybe (CExpression NodeInfo))]
    -> Attributes
    -> NodeInfo
    -> m EnumType
    tEnumType SUERef
    sue_ref [(Ident, Maybe (CExpression NodeInfo))]
    enumerators Attributes
    attrs' NodeInfo
    node_info
                        m EnumType -> (EnumType -> 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
    >>=  (TagDef -> m ()
    forall (m :: * -> *). MonadTrav m => TagDef -> m ()
    handleTagDef (TagDef -> m ()) -> (EnumType -> TagDef) -> EnumType -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EnumType -> TagDef
    EnumDef)
                 return decl

    -- | translate and analyse an enumeration type
    tEnumType :: (MonadCError m, MonadSymtab m) =>
                 SUERef -> [(Ident, Maybe CExpr)] -> Attributes -> NodeInfo -> m EnumType
    tEnumType :: forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    SUERef
    -> [(Ident, Maybe (CExpression NodeInfo))]
    -> Attributes
    -> NodeInfo
    -> m EnumType
    tEnumType SUERef
    sue_ref [(Ident, Maybe (CExpression NodeInfo))]
    enumerators Attributes
    attrs NodeInfo
    node = do
        (Enumerator -> m ()) -> [Enumerator] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Enumerator -> m ()
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    Enumerator -> m ()
    handleEnumeratorDef [Enumerator]
    enumerators'
        EnumType -> m EnumType
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EnumType
    ty
        where
        ty :: EnumType
    ty = SUERef -> [Enumerator] -> Attributes -> NodeInfo -> EnumType
    EnumType SUERef
    sue_ref [Enumerator]
    enumerators' Attributes
    attrs NodeInfo
    node
        (Either Integer (CExpression NodeInfo, Integer)
    _,[Enumerator]
    enumerators') = (Either Integer (CExpression NodeInfo, Integer)
     -> (Ident, Maybe (CExpression NodeInfo))
     -> (Either Integer (CExpression NodeInfo, Integer), Enumerator))
    -> Either Integer (CExpression NodeInfo, Integer)
    -> [(Ident, Maybe (CExpression NodeInfo))]
    -> (Either Integer (CExpression NodeInfo, Integer), [Enumerator])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL Either Integer (CExpression NodeInfo, Integer)
    -> (Ident, Maybe (CExpression NodeInfo))
    -> (Either Integer (CExpression NodeInfo, Integer), Enumerator)
    nextEnumerator (Integer -> Either Integer (CExpression NodeInfo, Integer)
    forall a b. a -> Either a b
    Left Integer
    0) [(Ident, Maybe (CExpression NodeInfo))]
    enumerators
        nextEnumerator :: Either Integer (CExpression NodeInfo, Integer)
    -> (Ident, Maybe (CExpression NodeInfo))
    -> (Either Integer (CExpression NodeInfo, Integer), Enumerator)
    nextEnumerator Either Integer (CExpression NodeInfo, Integer)
    memo (Ident
    ident,Maybe (CExpression NodeInfo)
    e) =
          let (Either Integer (CExpression NodeInfo, Integer)
    memo',CExpression NodeInfo
    expr) = Either Integer (CExpression NodeInfo, Integer)
    -> Maybe (CExpression NodeInfo)
    -> (Either Integer (CExpression NodeInfo, Integer),
        CExpression NodeInfo)
    nextEnrExpr Either Integer (CExpression NodeInfo, Integer)
    memo Maybe (CExpression NodeInfo)
    e in
          (Either Integer (CExpression NodeInfo, Integer)
    memo', Ident -> CExpression NodeInfo -> EnumType -> NodeInfo -> Enumerator
    Enumerator Ident
    ident CExpression NodeInfo
    expr EnumType
    ty (Ident -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo Ident
    ident))
        nextEnrExpr :: Either Integer (Expr,Integer) -> Maybe CExpr -> (Either Integer (Expr,Integer), CExpr)
        nextEnrExpr :: Either Integer (CExpression NodeInfo, Integer)
    -> Maybe (CExpression NodeInfo)
    -> (Either Integer (CExpression NodeInfo, Integer),
        CExpression NodeInfo)
    nextEnrExpr (Left Integer
    i) Maybe (CExpression NodeInfo)
    Nothing = (Integer -> Either Integer (CExpression NodeInfo, Integer)
    forall a b. a -> Either a b
    Left (Integer -> Integer
    forall a. Enum a => a -> a
    succ Integer
    i), Integer -> CExpression NodeInfo
    intExpr Integer
    i)
        nextEnrExpr (Right (CExpression NodeInfo
    e,Integer
    offs)) Maybe (CExpression NodeInfo)
    Nothing = ((CExpression NodeInfo, Integer)
    -> Either Integer (CExpression NodeInfo, Integer)
    forall a b. b -> Either a b
    Right (CExpression NodeInfo
    e, Integer -> Integer
    forall a. Enum a => a -> a
    succ Integer
    offs), CExpression NodeInfo -> Integer -> CExpression NodeInfo
    offsExpr CExpression NodeInfo
    e Integer
    offs)
        nextEnrExpr Either Integer (CExpression NodeInfo, Integer)
    _ (Just CExpression NodeInfo
    e) = ((CExpression NodeInfo, Integer)
    -> Either Integer (CExpression NodeInfo, Integer)
    forall a b. b -> Either a b
    Right (CExpression NodeInfo
    e,Integer
    1), CExpression NodeInfo
    e)
        intExpr :: Integer -> CExpression NodeInfo
    intExpr Integer
    i = 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
    i) NodeInfo
    undefNode)
        offsExpr :: CExpression NodeInfo -> Integer -> CExpression NodeInfo
    offsExpr CExpression NodeInfo
    e Integer
    offs = CBinaryOp
    -> CExpression NodeInfo
    -> CExpression NodeInfo
    -> NodeInfo
    -> CExpression NodeInfo
    forall a.
    CBinaryOp -> CExpression a -> CExpression a -> a -> CExpression a
    CBinary CBinaryOp
    CAddOp CExpression NodeInfo
    e (Integer -> CExpression NodeInfo
    intExpr Integer
    offs) NodeInfo
    undefNode

    -- | Mapping from num type specs to C types (C99 6.7.2-2), ignoring the complex qualifier.
    tNumType :: (MonadCError m) => NumTypeSpec -> m (Either (FloatType,Bool) IntType)
    tNumType :: forall (m :: * -> *).
    MonadCError m =>
    NumTypeSpec -> m (Either (FloatType, Bool) IntType)
    tNumType (NumTypeSpec NumBaseType
    basetype SignSpec
    sgn SizeMod
    sz Bool
    iscomplex) =
        case (NumBaseType
    basetype,SignSpec
    sgn,SizeMod
    sz) of
            (NumBaseType
    BaseChar,SignSpec
    _,SizeMod
    NoSizeMod)      | SignSpec
    Signed <- SignSpec
    sgn   -> IntType -> m (Either (FloatType, Bool) IntType)
    forall {a} {a}. a -> m (Either a a)
    intType IntType
    TySChar
                                        | SignSpec
    Unsigned <- SignSpec
    sgn -> IntType -> m (Either (FloatType, Bool) IntType)
    forall {a} {a}. a -> m (Either a a)
    intType IntType
    TyUChar
                                        | Bool
    otherwise       -> IntType -> m (Either (FloatType, Bool) IntType)
    forall {a} {a}. a -> m (Either a a)
    intType IntType
    TyChar
            (NumBaseType
    intbase, SignSpec
    _, SizeMod
    NoSizeMod)  | NumBaseType -> NumBaseType -> Bool
    optBase NumBaseType
    BaseInt NumBaseType
    intbase ->
                IntType -> m (Either (FloatType, Bool) IntType)
    forall {a} {a}. a -> m (Either a a)
    intType(IntType -> m (Either (FloatType, Bool) IntType))
    -> IntType -> m (Either (FloatType, Bool) IntType)
    forall a b. (a -> b) -> a -> b
    $ case SignSpec
    sgn of
                                SignSpec
    Unsigned -> IntType
    TyUInt
                                SignSpec
    _        -> IntType
    TyInt
            (NumBaseType
    intbase, SignSpec
    _, SizeMod
    NoSizeMod)  | NumBaseType -> NumBaseType -> Bool
    optBase NumBaseType
    BaseInt128 NumBaseType
    intbase ->
                IntType -> m (Either (FloatType, Bool) IntType)
    forall {a} {a}. a -> m (Either a a)
    intType(IntType -> m (Either (FloatType, Bool) IntType))
    -> IntType -> m (Either (FloatType, Bool) IntType)
    forall a b. (a -> b) -> a -> b
    $ case SignSpec
    sgn of
                                SignSpec
    Unsigned -> IntType
    TyUInt128
                                SignSpec
    _        -> IntType
    TyInt128
            (NumBaseType
    intbase, SignSpec
    signed, SizeMod
    sizemod)    | NumBaseType -> NumBaseType -> Bool
    optBase NumBaseType
    BaseInt NumBaseType
    intbase, SignSpec -> SignSpec -> Bool
    optSign SignSpec
    Signed SignSpec
    signed ->
                IntType -> m (Either (FloatType, Bool) IntType)
    forall {a} {a}. a -> m (Either a a)
    intType(IntType -> m (Either (FloatType, Bool) IntType))
    -> IntType -> m (Either (FloatType, Bool) IntType)
    forall a b. (a -> b) -> a -> b
    $ case SizeMod
    sizemod of SizeMod
    ShortMod    -> IntType
    TyShort
                                         SizeMod
    LongMod     -> IntType
    TyLong
                                         SizeMod
    LongLongMod -> IntType
    TyLLong
                                         SizeMod
    _ -> String -> IntType
    forall a. String -> a
    internalErr String
    "numTypeMapping: unexpected pattern matching error"
            (NumBaseType
    intbase, SignSpec
    Unsigned, SizeMod
    sizemod) | NumBaseType -> NumBaseType -> Bool
    optBase NumBaseType
    BaseInt NumBaseType
    intbase ->
                IntType -> m (Either (FloatType, Bool) IntType)
    forall {a} {a}. a -> m (Either a a)
    intType(IntType -> m (Either (FloatType, Bool) IntType))
    -> IntType -> m (Either (FloatType, Bool) IntType)
    forall a b. (a -> b) -> a -> b
    $ case SizeMod
    sizemod of SizeMod
    ShortMod    -> IntType
    TyUShort
                                         SizeMod
    LongMod     -> IntType
    TyULong
                                         SizeMod
    LongLongMod -> IntType
    TyULLong
                                         SizeMod
    _ -> String -> IntType
    forall a. String -> a
    internalErr String
    "numTypeMapping: unexpected pattern matching error"
            (NumBaseType
    BaseFloat, SignSpec
    NoSignSpec, SizeMod
    NoSizeMod)  -> FloatType -> m (Either (FloatType, Bool) IntType)
    forall {m :: * -> *} {a} {b}.
    Monad m =>
    a -> m (Either (a, Bool) b)
    floatType FloatType
    TyFloat
            (NumBaseType
    BaseDouble, SignSpec
    NoSignSpec, SizeMod
    NoSizeMod) -> FloatType -> m (Either (FloatType, Bool) IntType)
    forall {m :: * -> *} {a} {b}.
    Monad m =>
    a -> m (Either (a, Bool) b)
    floatType FloatType
    TyDouble
            (NumBaseType
    BaseDouble, SignSpec
    NoSignSpec, SizeMod
    LongMod)   -> FloatType -> m (Either (FloatType, Bool) IntType)
    forall {m :: * -> *} {a} {b}.
    Monad m =>
    a -> m (Either (a, Bool) b)
    floatType FloatType
    TyLDouble
            (NumBaseType
    BaseBFloat16, SignSpec
    NoSignSpec, SizeMod
    NoSizeMod)   -> FloatType -> m (Either (FloatType, Bool) IntType)
    forall {m :: * -> *} {a} {b}.
    Monad m =>
    a -> m (Either (a, Bool) b)
    floatType FloatType
    TyBFloat16
            (BaseFloatN Int
    n Bool
    x, SignSpec
    NoSignSpec, SizeMod
    NoSizeMod) -> FloatType -> m (Either (FloatType, Bool) IntType)
    forall {m :: * -> *} {a} {b}.
    Monad m =>
    a -> m (Either (a, Bool) b)
    floatType (Int -> Bool -> FloatType
    TyFloatN Int
    n Bool
    x)
            -- TODO: error analysis
            (NumBaseType
    _,SignSpec
    _,SizeMod
    _)   -> String -> m (Either (FloatType, Bool) IntType)
    forall a. HasCallStack => String -> a
    error String
    "Bad AST analysis"
        where
        optBase :: NumBaseType -> NumBaseType -> Bool
    optBase NumBaseType
    _ NumBaseType
    NoBaseType = Bool
    True
        optBase NumBaseType
    expect NumBaseType
    baseTy = NumBaseType
    expect NumBaseType -> NumBaseType -> Bool
    forall a. Eq a => a -> a -> Bool
    == NumBaseType
    baseTy
        optSign :: SignSpec -> SignSpec -> Bool
    optSign SignSpec
    _ SignSpec
    NoSignSpec = Bool
    True
        optSign SignSpec
    expect SignSpec
    sign = SignSpec
    expect SignSpec -> SignSpec -> Bool
    forall a. Eq a => a -> a -> Bool
    == SignSpec
    sign
        intType :: a -> m (Either a a)
    intType = Either a a -> m (Either a a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either a a -> m (Either a a))
    -> (a -> Either a a) -> a -> m (Either a a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Either a a
    forall a b. b -> Either a b
    Right
        floatType :: a -> m (Either (a, Bool) b)
    floatType a
    ft = Either (a, Bool) b -> m (Either (a, Bool) b)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((a, Bool) -> Either (a, Bool) b
    forall a b. a -> Either a b
    Left (a
    ft,Bool
    iscomplex))

    -- TODO: currently bogus
    tArraySize :: (MonadTrav m) => CArrSize -> m ArraySize
    tArraySize :: forall (m :: * -> *).
    MonadTrav m =>
    CArraySize NodeInfo -> m ArraySize
    tArraySize (CNoArrSize Bool
    False) = ArraySize -> m ArraySize
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> ArraySize
    UnknownArraySize Bool
    False)
    tArraySize (CNoArrSize Bool
    True) = ArraySize -> m ArraySize
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> ArraySize
    UnknownArraySize Bool
    True)
    tArraySize (CArrSize Bool
    static CExpression NodeInfo
    szexpr) = (CExpression NodeInfo -> ArraySize)
    -> m (CExpression NodeInfo) -> m ArraySize
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (Bool -> CExpression NodeInfo -> ArraySize
    ArraySize Bool
    static) (CExpression NodeInfo -> m (CExpression NodeInfo)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CExpression NodeInfo
    szexpr)

    tTypeQuals :: (MonadTrav m) => [CTypeQual] -> m (TypeQuals,Attributes)
    tTypeQuals :: forall (m :: * -> *).
    MonadTrav m =>
    [CTypeQualifier NodeInfo] -> m (TypeQuals, Attributes)
    tTypeQuals = (CTypeQualifier NodeInfo
     -> (TypeQuals, Attributes) -> m (TypeQuals, Attributes))
    -> (TypeQuals, Attributes)
    -> [CTypeQualifier NodeInfo]
    -> m (TypeQuals, Attributes)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> b -> m b) -> b -> t a -> m b
    foldrM CTypeQualifier NodeInfo
    -> (TypeQuals, Attributes) -> m (TypeQuals, Attributes)
    forall {m :: * -> *}.
    (MonadCError m, MonadSymtab m) =>
    CTypeQualifier NodeInfo
    -> (TypeQuals, Attributes) -> m (TypeQuals, Attributes)
    go (TypeQuals
    noTypeQuals,[]) where
        go :: CTypeQualifier NodeInfo
    -> (TypeQuals, Attributes) -> m (TypeQuals, Attributes)
    go (CConstQual NodeInfo
    _) (TypeQuals
    tq,Attributes
    attrs) = (TypeQuals, Attributes) -> m (TypeQuals, Attributes)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TypeQuals
    tq { constant = True },Attributes
    attrs)
        go (CVolatQual NodeInfo
    _) (TypeQuals
    tq,Attributes
    attrs) = (TypeQuals, Attributes) -> m (TypeQuals, Attributes)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TypeQuals
    tq { volatile = True },Attributes
    attrs)
        go (CRestrQual NodeInfo
    _) (TypeQuals
    tq,Attributes
    attrs) = (TypeQuals, Attributes) -> m (TypeQuals, Attributes)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TypeQuals
    tq { restrict = True },Attributes
    attrs)
        go (CAtomicQual NodeInfo
    _) (TypeQuals
    tq,Attributes
    attrs) = (TypeQuals, Attributes) -> m (TypeQuals, Attributes)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TypeQuals
    tq { atomic = True },Attributes
    attrs)
        go (CAttrQual CAttribute NodeInfo
    attr) (TypeQuals
    tq,Attributes
    attrs) = (Attr -> (TypeQuals, Attributes))
    -> m Attr -> m (TypeQuals, Attributes)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (\Attr
    attr' -> (TypeQuals
    tq,Attr
    attr'Attr -> Attributes -> Attributes
    forall a. a -> [a] -> [a]
    :Attributes
    attrs)) (CAttribute NodeInfo -> m Attr
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    CAttribute NodeInfo -> m Attr
    tAttr CAttribute NodeInfo
    attr)
        go (CNullableQual NodeInfo
    _) (TypeQuals
    tq,Attributes
    attrs) = (TypeQuals, Attributes) -> m (TypeQuals, Attributes)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TypeQuals
    tq { nullable = True }, Attributes
    attrs)
        go (CNonnullQual NodeInfo
    _) (TypeQuals
    tq,Attributes
    attrs) = (TypeQuals, Attributes) -> m (TypeQuals, Attributes)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TypeQuals
    tq { nonnull = True }, Attributes
    attrs)
        go (CClRdOnlyQual NodeInfo
    _) (TypeQuals
    tq,Attributes
    attrs) = (TypeQuals, Attributes) -> m (TypeQuals, Attributes)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TypeQuals
    tq { clrdonly = True },Attributes
    attrs)
        go (CClWrOnlyQual NodeInfo
    _) (TypeQuals
    tq,Attributes
    attrs) = (TypeQuals, Attributes) -> m (TypeQuals, Attributes)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TypeQuals
    tq { clwronly = True },Attributes
    attrs)

    -- * analysis

    {-
    To canoicalize type specifiers, we define a canonical form:
    void | bool | (char|int|int128|float|double|floatNx)? (signed|unsigned)? (long long?)? complex? | othertype
    -}
    data NumBaseType = NoBaseType | BaseChar | BaseInt | BaseInt128 | BaseFloat | BaseBFloat16 |
                       BaseFloatN Int Bool | BaseDouble deriving (NumBaseType -> NumBaseType -> Bool
    (NumBaseType -> NumBaseType -> Bool)
    -> (NumBaseType -> NumBaseType -> Bool) -> Eq NumBaseType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: NumBaseType -> NumBaseType -> Bool
    == :: NumBaseType -> NumBaseType -> Bool
    $c/= :: NumBaseType -> NumBaseType -> Bool
    /= :: NumBaseType -> NumBaseType -> Bool
    Eq,Eq NumBaseType
    Eq NumBaseType =>
    (NumBaseType -> NumBaseType -> Ordering)
    -> (NumBaseType -> NumBaseType -> Bool)
    -> (NumBaseType -> NumBaseType -> Bool)
    -> (NumBaseType -> NumBaseType -> Bool)
    -> (NumBaseType -> NumBaseType -> Bool)
    -> (NumBaseType -> NumBaseType -> NumBaseType)
    -> (NumBaseType -> NumBaseType -> NumBaseType)
    -> Ord NumBaseType
    NumBaseType -> NumBaseType -> Bool
    NumBaseType -> NumBaseType -> Ordering
    NumBaseType -> NumBaseType -> NumBaseType
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: NumBaseType -> NumBaseType -> Ordering
    compare :: NumBaseType -> NumBaseType -> Ordering
    $c< :: NumBaseType -> NumBaseType -> Bool
    < :: NumBaseType -> NumBaseType -> Bool
    $c<= :: NumBaseType -> NumBaseType -> Bool
    <= :: NumBaseType -> NumBaseType -> Bool
    $c> :: NumBaseType -> NumBaseType -> Bool
    > :: NumBaseType -> NumBaseType -> Bool
    $c>= :: NumBaseType -> NumBaseType -> Bool
    >= :: NumBaseType -> NumBaseType -> Bool
    $cmax :: NumBaseType -> NumBaseType -> NumBaseType
    max :: NumBaseType -> NumBaseType -> NumBaseType
    $cmin :: NumBaseType -> NumBaseType -> NumBaseType
    min :: NumBaseType -> NumBaseType -> NumBaseType
    Ord)
    data SignSpec    = NoSignSpec | Signed | Unsigned deriving (SignSpec -> SignSpec -> Bool
    (SignSpec -> SignSpec -> Bool)
    -> (SignSpec -> SignSpec -> Bool) -> Eq SignSpec
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SignSpec -> SignSpec -> Bool
    == :: SignSpec -> SignSpec -> Bool
    $c/= :: SignSpec -> SignSpec -> Bool
    /= :: SignSpec -> SignSpec -> Bool
    Eq,Eq SignSpec
    Eq SignSpec =>
    (SignSpec -> SignSpec -> Ordering)
    -> (SignSpec -> SignSpec -> Bool)
    -> (SignSpec -> SignSpec -> Bool)
    -> (SignSpec -> SignSpec -> Bool)
    -> (SignSpec -> SignSpec -> Bool)
    -> (SignSpec -> SignSpec -> SignSpec)
    -> (SignSpec -> SignSpec -> SignSpec)
    -> Ord SignSpec
    SignSpec -> SignSpec -> Bool
    SignSpec -> SignSpec -> Ordering
    SignSpec -> SignSpec -> SignSpec
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: SignSpec -> SignSpec -> Ordering
    compare :: SignSpec -> SignSpec -> Ordering
    $c< :: SignSpec -> SignSpec -> Bool
    < :: SignSpec -> SignSpec -> Bool
    $c<= :: SignSpec -> SignSpec -> Bool
    <= :: SignSpec -> SignSpec -> Bool
    $c> :: SignSpec -> SignSpec -> Bool
    > :: SignSpec -> SignSpec -> Bool
    $c>= :: SignSpec -> SignSpec -> Bool
    >= :: SignSpec -> SignSpec -> Bool
    $cmax :: SignSpec -> SignSpec -> SignSpec
    max :: SignSpec -> SignSpec -> SignSpec
    $cmin :: SignSpec -> SignSpec -> SignSpec
    min :: SignSpec -> SignSpec -> SignSpec
    Ord)
    data SizeMod     = NoSizeMod | ShortMod | LongMod | LongLongMod deriving (SizeMod -> SizeMod -> Bool
    (SizeMod -> SizeMod -> Bool)
    -> (SizeMod -> SizeMod -> Bool) -> Eq SizeMod
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SizeMod -> SizeMod -> Bool
    == :: SizeMod -> SizeMod -> Bool
    $c/= :: SizeMod -> SizeMod -> Bool
    /= :: SizeMod -> SizeMod -> Bool
    Eq,Eq SizeMod
    Eq SizeMod =>
    (SizeMod -> SizeMod -> Ordering)
    -> (SizeMod -> SizeMod -> Bool)
    -> (SizeMod -> SizeMod -> Bool)
    -> (SizeMod -> SizeMod -> Bool)
    -> (SizeMod -> SizeMod -> Bool)
    -> (SizeMod -> SizeMod -> SizeMod)
    -> (SizeMod -> SizeMod -> SizeMod)
    -> Ord SizeMod
    SizeMod -> SizeMod -> Bool
    SizeMod -> SizeMod -> Ordering
    SizeMod -> SizeMod -> SizeMod
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: SizeMod -> SizeMod -> Ordering
    compare :: SizeMod -> SizeMod -> Ordering
    $c< :: SizeMod -> SizeMod -> Bool
    < :: SizeMod -> SizeMod -> Bool
    $c<= :: SizeMod -> SizeMod -> Bool
    <= :: SizeMod -> SizeMod -> Bool
    $c> :: SizeMod -> SizeMod -> Bool
    > :: SizeMod -> SizeMod -> Bool
    $c>= :: SizeMod -> SizeMod -> Bool
    >= :: SizeMod -> SizeMod -> Bool
    $cmax :: SizeMod -> SizeMod -> SizeMod
    max :: SizeMod -> SizeMod -> SizeMod
    $cmin :: SizeMod -> SizeMod -> SizeMod
    min :: SizeMod -> SizeMod -> SizeMod
    Ord)
    data NumTypeSpec = NumTypeSpec { NumTypeSpec -> NumBaseType
    base :: NumBaseType, NumTypeSpec -> SignSpec
    signSpec :: SignSpec, NumTypeSpec -> SizeMod
    sizeMod :: SizeMod, NumTypeSpec -> Bool
    isComplex :: Bool  }
    emptyNumTypeSpec :: NumTypeSpec
    emptyNumTypeSpec :: NumTypeSpec
    emptyNumTypeSpec = NumTypeSpec { base :: NumBaseType
    base = NumBaseType
    NoBaseType, signSpec :: SignSpec
    signSpec = SignSpec
    NoSignSpec, sizeMod :: SizeMod
    sizeMod = SizeMod
    NoSizeMod, isComplex :: Bool
    isComplex = Bool
    False }
    data TypeSpecAnalysis =
      TSNone | TSVoid | TSBool | TSNum NumTypeSpec |
      TSTypeDef TypeDefRef | TSType Type | TSNonBasic CTypeSpec

    canonicalTypeSpec :: (MonadTrav m) => [CTypeSpec] -> m TypeSpecAnalysis
    canonicalTypeSpec :: forall (m :: * -> *).
    MonadTrav m =>
    [CTypeSpecifier NodeInfo] -> m TypeSpecAnalysis
    canonicalTypeSpec = (CTypeSpecifier NodeInfo -> TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis
    -> [CTypeSpecifier NodeInfo]
    -> m TypeSpecAnalysis
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> b -> m b) -> b -> t a -> m b
    foldrM CTypeSpecifier NodeInfo -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall (m :: * -> *).
    MonadTrav m =>
    CTypeSpecifier NodeInfo -> TypeSpecAnalysis -> m TypeSpecAnalysis
    go TypeSpecAnalysis
    TSNone where
        getNTS :: TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    TSNone = NumTypeSpec -> Maybe NumTypeSpec
    forall a. a -> Maybe a
    Just NumTypeSpec
    emptyNumTypeSpec
        getNTS (TSNum NumTypeSpec
    nts) = NumTypeSpec -> Maybe NumTypeSpec
    forall a. a -> Maybe a
    Just NumTypeSpec
    nts
        getNTS TypeSpecAnalysis
    _ = Maybe NumTypeSpec
    forall a. Maybe a
    Nothing
        updLongMod :: SizeMod -> Maybe SizeMod
    updLongMod SizeMod
    NoSizeMod = SizeMod -> Maybe SizeMod
    forall a. a -> Maybe a
    Just SizeMod
    LongMod
        updLongMod SizeMod
    LongMod   = SizeMod -> Maybe SizeMod
    forall a. a -> Maybe a
    Just SizeMod
    LongLongMod
        updLongMod SizeMod
    _         = Maybe SizeMod
    forall a. Maybe a
    Nothing
        go :: (MonadTrav m) => CTypeSpec -> TypeSpecAnalysis -> m TypeSpecAnalysis
        go :: forall (m :: * -> *).
    MonadTrav m =>
    CTypeSpecifier NodeInfo -> TypeSpecAnalysis -> m TypeSpecAnalysis
    go (CVoidType NodeInfo
    _)    TypeSpecAnalysis
    TSNone = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TypeSpecAnalysis
    TSVoid
        go (CBoolType NodeInfo
    _)    TypeSpecAnalysis
    TSNone = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TypeSpecAnalysis
    TSBool
        go (CCharType NodeInfo
    _)    TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { base :: NumTypeSpec -> NumBaseType
    base = NumBaseType
    NoBaseType })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NumTypeSpec
    nts { base = BaseChar }
        go (CIntType NodeInfo
    _)     TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { base :: NumTypeSpec -> NumBaseType
    base = NumBaseType
    NoBaseType })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NumTypeSpec
    nts { base = BaseInt }
        go (CInt128Type NodeInfo
    _)  TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { base :: NumTypeSpec -> NumBaseType
    base = NumBaseType
    NoBaseType })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NumTypeSpec
    nts { base = BaseInt128 }
        go (CFloatType NodeInfo
    _)   TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { base :: NumTypeSpec -> NumBaseType
    base = NumBaseType
    NoBaseType })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NumTypeSpec
    nts { base = BaseFloat }
        go (CBFloat16Type NodeInfo
    _) TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { base :: NumTypeSpec -> NumBaseType
    base = NumBaseType
    NoBaseType })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NumTypeSpec
    nts { base = BaseBFloat16 }
        go (CFloatNType Int
    n Bool
    x NodeInfo
    _) TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { base :: NumTypeSpec -> NumBaseType
    base = NumBaseType
    NoBaseType })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NumTypeSpec
    nts { base = BaseFloatN n x }
        go (CDoubleType NodeInfo
    _)  TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { base :: NumTypeSpec -> NumBaseType
    base = NumBaseType
    NoBaseType })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NumTypeSpec
    nts { base = BaseDouble }
        go (CShortType NodeInfo
    _)   TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { sizeMod :: NumTypeSpec -> SizeMod
    sizeMod = SizeMod
    NoSizeMod })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $NumTypeSpec
    nts { sizeMod = ShortMod }
        go (CLongType NodeInfo
    _)    TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { sizeMod :: NumTypeSpec -> SizeMod
    sizeMod = SizeMod
    szMod })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa,
                                  (Just SizeMod
    szMod') <- SizeMod -> Maybe SizeMod
    updLongMod SizeMod
    szMod
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NumTypeSpec
    nts { sizeMod = szMod' }
        go (CSignedType NodeInfo
    _)  TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { signSpec :: NumTypeSpec -> SignSpec
    signSpec = SignSpec
    NoSignSpec })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NumTypeSpec
    nts { signSpec = Signed }
        go (CUnsigType NodeInfo
    _)   TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { signSpec :: NumTypeSpec -> SignSpec
    signSpec = SignSpec
    NoSignSpec })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NumTypeSpec
    nts { signSpec = Unsigned }
        go (CComplexType NodeInfo
    _) TypeSpecAnalysis
    tsa | (Just nts :: NumTypeSpec
    nts@(NumTypeSpec { isComplex :: NumTypeSpec -> Bool
    isComplex = Bool
    False })) <- TypeSpecAnalysis -> Maybe NumTypeSpec
    getNTS TypeSpecAnalysis
    tsa
                                = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  NumTypeSpec -> TypeSpecAnalysis
    TSNum(NumTypeSpec -> TypeSpecAnalysis)
    -> NumTypeSpec -> TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NumTypeSpec
    nts { isComplex = True }
        go (CTypeDef Ident
    i NodeInfo
    ni) TypeSpecAnalysis
    TSNone = (TypeDefRef -> TypeSpecAnalysis)
    -> m TypeDefRef -> m TypeSpecAnalysis
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM TypeDefRef -> TypeSpecAnalysis
    TSTypeDef (m TypeDefRef -> m TypeSpecAnalysis)
    -> m TypeDefRef -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ NodeInfo -> Ident -> m TypeDefRef
    forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo -> Ident -> m TypeDefRef
    typeDefRef NodeInfo
    ni Ident
    i
        go (CTypeOfType CDecl
    d NodeInfo
    _ni) TypeSpecAnalysis
    TSNone = (Type -> TypeSpecAnalysis) -> m Type -> m TypeSpecAnalysis
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Type -> TypeSpecAnalysis
    TSType (m Type -> m TypeSpecAnalysis) -> m Type -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ CDecl -> m Type
    forall (m :: * -> *). MonadTrav m => CDecl -> m Type
    analyseTypeDecl CDecl
    d
        go (CTypeOfExpr CExpression NodeInfo
    e NodeInfo
    _) TypeSpecAnalysis
    TSNone = (Type -> TypeSpecAnalysis) -> m Type -> m TypeSpecAnalysis
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Type -> TypeSpecAnalysis
    TSType (m Type -> m TypeSpecAnalysis) -> m Type -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpression NodeInfo -> m Type
    tExpr [] ExprSide
    RValue CExpression NodeInfo
    e
        -- todo: atomic qualifier discarded
        go (CAtomicType CDecl
    d NodeInfo
    _ni) TypeSpecAnalysis
    TSNone = (Type -> TypeSpecAnalysis) -> m Type -> m TypeSpecAnalysis
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Type -> TypeSpecAnalysis
    TSType (m Type -> m TypeSpecAnalysis) -> m Type -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $ CDecl -> m Type
    forall (m :: * -> *). MonadTrav m => CDecl -> m Type
    analyseTypeDecl CDecl
    d
        go CTypeSpecifier NodeInfo
    otherType  TypeSpecAnalysis
    TSNone    = TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(TypeSpecAnalysis -> m TypeSpecAnalysis)
    -> TypeSpecAnalysis -> m TypeSpecAnalysis
    forall a b. (a -> b) -> a -> b
    $  CTypeSpecifier NodeInfo -> TypeSpecAnalysis
    TSNonBasic CTypeSpecifier NodeInfo
    otherType
        go CTypeSpecifier NodeInfo
    ty TypeSpecAnalysis
    _ts = NodeInfo -> String -> m TypeSpecAnalysis
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError (CTypeSpecifier NodeInfo -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CTypeSpecifier NodeInfo
    ty) String
    "Invalid type specifier"

    -- compute storage given storage specifiers
    canonicalStorageSpec :: (MonadCError m) =>[CStorageSpec] -> m StorageSpec
    canonicalStorageSpec :: forall (m :: * -> *).
    MonadCError m =>
    [CStorageSpecifier NodeInfo] -> m StorageSpec
    canonicalStorageSpec [CStorageSpecifier NodeInfo]
    storagespecs = (StorageSpec -> StorageSpec) -> m StorageSpec -> m StorageSpec
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM StorageSpec -> StorageSpec
    elideAuto (m StorageSpec -> m StorageSpec) -> m StorageSpec -> m StorageSpec
    forall a b. (a -> b) -> a -> b
    $ (CStorageSpecifier NodeInfo -> StorageSpec -> m StorageSpec)
    -> StorageSpec -> [CStorageSpecifier NodeInfo] -> m StorageSpec
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> b -> m b) -> b -> t a -> m b
    foldrM CStorageSpecifier NodeInfo -> StorageSpec -> m StorageSpec
    forall {m :: * -> *} {a}.
    (MonadCError m, CNode a, Pretty (CStorageSpecifier a)) =>
    CStorageSpecifier a -> StorageSpec -> m StorageSpec
    updStorage StorageSpec
    NoStorageSpec [CStorageSpecifier NodeInfo]
    storagespecs where
            updStorage :: CStorageSpecifier a -> StorageSpec -> m StorageSpec
    updStorage (CAuto a
    _) StorageSpec
    NoStorageSpec     = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return StorageSpec
    AutoSpec
            updStorage (CRegister a
    _) StorageSpec
    NoStorageSpec = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return StorageSpec
    RegSpec
            updStorage (CThread a
    _) StorageSpec
    NoStorageSpec   = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return StorageSpec
    ThreadSpec
            updStorage (CClKernel a
    _) StorageSpec
    NoStorageSpec = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return StorageSpec
    ClKernelSpec
            updStorage (CClGlobal a
    _) StorageSpec
    NoStorageSpec = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return StorageSpec
    ClGlobalSpec
            updStorage (CClLocal  a
    _) StorageSpec
    NoStorageSpec = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return StorageSpec
    ClLocalSpec
            updStorage (CThread a
    _) (StaticSpec Bool
    _)  = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(StorageSpec -> m StorageSpec) -> StorageSpec -> m StorageSpec
    forall a b. (a -> b) -> a -> b
    $ Bool -> StorageSpec
    StaticSpec Bool
    True
            updStorage (CThread a
    _) (ExternSpec Bool
    _)  = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(StorageSpec -> m StorageSpec) -> StorageSpec -> m StorageSpec
    forall a b. (a -> b) -> a -> b
    $ Bool -> StorageSpec
    ExternSpec Bool
    True
            updStorage (CStatic a
    _) StorageSpec
    NoStorageSpec   = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(StorageSpec -> m StorageSpec) -> StorageSpec -> m StorageSpec
    forall a b. (a -> b) -> a -> b
    $ Bool -> StorageSpec
    StaticSpec Bool
    False
            updStorage (CExtern a
    _) StorageSpec
    NoStorageSpec   = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(StorageSpec -> m StorageSpec) -> StorageSpec -> m StorageSpec
    forall a b. (a -> b) -> a -> b
    $ Bool -> StorageSpec
    ExternSpec Bool
    False
            updStorage (CStatic a
    _) StorageSpec
    ThreadSpec      = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(StorageSpec -> m StorageSpec) -> StorageSpec -> m StorageSpec
    forall a b. (a -> b) -> a -> b
    $ Bool -> StorageSpec
    StaticSpec Bool
    True
            updStorage (CExtern a
    _) StorageSpec
    ThreadSpec      = StorageSpec -> m StorageSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(StorageSpec -> m StorageSpec) -> StorageSpec -> m StorageSpec
    forall a b. (a -> b) -> a -> b
    $ Bool -> StorageSpec
    ExternSpec Bool
    True
            updStorage CStorageSpecifier a
    badSpec StorageSpec
    old
                = NodeInfo -> String -> m StorageSpec
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError (CStorageSpecifier a -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CStorageSpecifier a
    badSpec) (String -> m StorageSpec) -> String -> m StorageSpec
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid storage specifier "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Doc -> String
    render (CStorageSpecifier a -> Doc
    forall p. Pretty p => p -> Doc
    pretty CStorageSpecifier a
    badSpec)String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    " in combination with "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++StorageSpec -> String
    forall a. Show a => a -> String
    show StorageSpec
    old
            elideAuto :: StorageSpec -> StorageSpec
    elideAuto StorageSpec
    AutoSpec = StorageSpec
    NoStorageSpec
            elideAuto StorageSpec
    spec = StorageSpec
    spec

    -- | convert old style parameters
    --
    -- This requires matching parameter names and declarations, as in the following example:
    --
    -- > int f(d,c,a,b)
    -- > char a,*b;
    -- > int c;
    -- > { }
    --
    -- is converted to
    --
    -- > int f(int d, int c, char a, char* b)
    --
    -- TODO: This could be moved to syntax, as it operates on the AST only
    mergeOldStyle :: (MonadCError m) => NodeInfo -> [CDecl] -> [CDerivedDeclr] -> m [CDerivedDeclr]
    mergeOldStyle :: forall (m :: * -> *).
    MonadCError m =>
    NodeInfo -> [CDecl] -> [CDerivedDeclr] -> m [CDerivedDeclr]
    mergeOldStyle NodeInfo
    _node [] [CDerivedDeclr]
    declrs = [CDerivedDeclr] -> m [CDerivedDeclr]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [CDerivedDeclr]
    declrs
    mergeOldStyle NodeInfo
    node [CDecl]
    oldstyle_params (CFunDeclr Either [Ident] ([CDecl], Bool)
    params [CAttribute NodeInfo]
    attrs NodeInfo
    fdnode : [CDerivedDeclr]
    dds) =
        case Either [Ident] ([CDecl], Bool)
    params of
            Left [Ident]
    list -> do
                -- FIXME: This translation doesn't work in the following example
                -- [| int f(b,a) struct x { }; int b,a; { struct x local; return local.x } |]
                oldstyle_params' <- ([[CDecl]] -> [CDecl]) -> m [[CDecl]] -> m [CDecl]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM [[CDecl]] -> [CDecl]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (m [[CDecl]] -> m [CDecl]) -> m [[CDecl]] -> m [CDecl]
    forall a b. (a -> b) -> a -> b
    $ (CDecl -> m [CDecl]) -> [CDecl] -> m [[CDecl]]
    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 CDecl -> m [CDecl]
    forall (m :: * -> *). MonadCError m => CDecl -> m [CDecl]
    splitCDecl [CDecl]
    oldstyle_params
                param_map <- liftM Map.fromList $ mapM attachNameOfDecl oldstyle_params'
                (newstyle_params,param_map') <- foldrM insertParamDecl ([],param_map) list
                unless (Map.null param_map') $
                  astError node $ "declarations for parameter(s) "++ showParamMap param_map' ++" but no such parameter"
                return (CFunDeclr (Right (newstyle_params, False)) attrs fdnode : dds)
            Right ([CDecl], Bool)
    _newstyle -> NodeInfo -> String -> m [CDerivedDeclr]
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "oldstyle parameter list, but newstyle function declaration"
        where
            attachNameOfDecl :: CDecl -> m (Ident, CDecl)
    attachNameOfDecl CDecl
    decl = CDecl -> m Ident
    forall (m :: * -> *). MonadCError m => CDecl -> m Ident
    nameOfDecl CDecl
    decl m Ident -> (Ident -> m (Ident, CDecl)) -> m (Ident, CDecl)
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Ident
    n -> (Ident, CDecl) -> m (Ident, CDecl)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ident
    n,CDecl
    decl)
            insertParamDecl :: Ident -> ([CDecl], Map Ident CDecl) -> m ([CDecl], Map Ident CDecl)
    insertParamDecl Ident
    param_name ([CDecl]
    ps, Map Ident CDecl
    param_map)
                = case Ident -> Map Ident CDecl -> Maybe CDecl
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Ident
    param_name Map Ident CDecl
    param_map of
                    Just CDecl
    p -> ([CDecl], Map Ident CDecl) -> m ([CDecl], Map Ident CDecl)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CDecl
    pCDecl -> [CDecl] -> [CDecl]
    forall a. a -> [a] -> [a]
    :[CDecl]
    ps, Ident -> Map Ident CDecl -> Map Ident CDecl
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete Ident
    param_name Map Ident CDecl
    param_map)
                    Maybe CDecl
    Nothing -> ([CDecl], Map Ident CDecl) -> m ([CDecl], Map Ident CDecl)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ident -> CDecl
    implicitIntParam Ident
    param_name CDecl -> [CDecl] -> [CDecl]
    forall a. a -> [a] -> [a]
    : [CDecl]
    ps, Map Ident CDecl
    param_map)
            implicitIntParam :: Ident -> CDecl
    implicitIntParam Ident
    param_name =
                let nInfo :: NodeInfo
    nInfo = Ident -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo Ident
    param_name in
                [CDeclarationSpecifier NodeInfo]
    -> [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
         Maybe (CExpression NodeInfo))]
    -> NodeInfo
    -> CDecl
    forall a.
    [CDeclarationSpecifier a]
    -> [(Maybe (CDeclarator a), Maybe (CInitializer a),
         Maybe (CExpression a))]
    -> a
    -> CDeclaration a
    CDecl [CTypeSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo
    forall a. CTypeSpecifier a -> CDeclarationSpecifier a
    CTypeSpec (NodeInfo -> CTypeSpecifier NodeInfo
    forall a. a -> CTypeSpecifier a
    CIntType NodeInfo
    nInfo)] [(CDeclarator NodeInfo -> Maybe (CDeclarator NodeInfo)
    forall a. a -> Maybe a
    Just (Maybe Ident
    -> [CDerivedDeclr]
    -> Maybe (CStringLiteral NodeInfo)
    -> [CAttribute NodeInfo]
    -> NodeInfo
    -> CDeclarator NodeInfo
    forall a.
    Maybe Ident
    -> [CDerivedDeclarator a]
    -> Maybe (CStringLiteral a)
    -> [CAttribute a]
    -> a
    -> CDeclarator a
    CDeclr (Ident -> Maybe Ident
    forall a. a -> Maybe a
    Just Ident
    param_name) [] Maybe (CStringLiteral NodeInfo)
    forall a. Maybe a
    Nothing [] NodeInfo
    nInfo),Maybe (CInitializer NodeInfo)
    forall a. Maybe a
    Nothing,Maybe (CExpression NodeInfo)
    forall a. Maybe a
    Nothing)] NodeInfo
    nInfo
            showParamMap :: Map Ident a -> String
    showParamMap = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " ([String] -> String)
    -> (Map Ident a -> [String]) -> Map Ident a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Ident -> String) -> [Ident] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Ident -> String
    identToString ([Ident] -> [String])
    -> (Map Ident a -> [Ident]) -> Map Ident a -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Ident a -> [Ident]
    forall k a. Map k a -> [k]
    Map.keys
    mergeOldStyle NodeInfo
    node [CDecl]
    _ [CDerivedDeclr]
    _ = NodeInfo -> String -> m [CDerivedDeclr]
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    node String
    "oldstyle parameter list, but not function type"

    -- | split a CDecl into declarators, hereby eliding SUE defs from the second declarator on.
    --
    --   There are several reasons why this isn't the preferred way for handling multiple-declarator declarations,
    --   but it can be convinient some times.
    --
    -- > splitCDecl [d| struct x { int z; } a,*b; |]
    -- > [ [d| struct x { int z; } a, struct x *b; |] ]
    --
    -- /TODO/: This could be moved to syntax, as it operates on the AST only
    splitCDecl :: (MonadCError m) => CDecl -> m [CDecl]
    splitCDecl :: forall (m :: * -> *). MonadCError m => CDecl -> m [CDecl]
    splitCDecl decl :: CDecl
    decl@(CStaticAssert CExpression NodeInfo
    _ CStringLiteral NodeInfo
    _ NodeInfo
    _) = [CDecl] -> m [CDecl]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [CDecl
    decl]
    splitCDecl decl :: CDecl
    decl@(CDecl [CDeclarationSpecifier NodeInfo]
    declspecs [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    declrs NodeInfo
    node) =
        case [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    declrs of
            []      -> String -> m [CDecl]
    forall a. String -> a
    internalErr String
    "splitCDecl applied to empty declaration"
            -- single declarator, not need to split
            [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
     Maybe (CExpression NodeInfo))
    _declr] -> [CDecl] -> m [CDecl]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [CDecl
    decl]
            -- more than one declarator
            ((Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
     Maybe (CExpression NodeInfo))
    d1:[(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    ds) ->
                let declspecs' :: [CDeclarationSpecifier NodeInfo]
    declspecs' = (CDeclarationSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo)
    -> [CDeclarationSpecifier NodeInfo]
    -> [CDeclarationSpecifier NodeInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map CDeclarationSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo
    forall {a}. CDeclarationSpecifier a -> CDeclarationSpecifier a
    elideSUEDef [CDeclarationSpecifier NodeInfo]
    declspecs in
                [CDecl] -> m [CDecl]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return([CDecl] -> m [CDecl]) -> [CDecl] -> m [CDecl]
    forall a b. (a -> b) -> a -> b
    $ ([CDeclarationSpecifier NodeInfo]
    -> [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
         Maybe (CExpression NodeInfo))]
    -> NodeInfo
    -> CDecl
    forall a.
    [CDeclarationSpecifier a]
    -> [(Maybe (CDeclarator a), Maybe (CInitializer a),
         Maybe (CExpression a))]
    -> a
    -> CDeclaration a
    CDecl [CDeclarationSpecifier NodeInfo]
    declspecs [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
     Maybe (CExpression NodeInfo))
    d1] NodeInfo
    node) CDecl -> [CDecl] -> [CDecl]
    forall a. a -> [a] -> [a]
    : [ [CDeclarationSpecifier NodeInfo]
    -> [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
         Maybe (CExpression NodeInfo))]
    -> NodeInfo
    -> CDecl
    forall a.
    [CDeclarationSpecifier a]
    -> [(Maybe (CDeclarator a), Maybe (CInitializer a),
         Maybe (CExpression a))]
    -> a
    -> CDeclaration a
    CDecl [CDeclarationSpecifier NodeInfo]
    declspecs' [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
     Maybe (CExpression NodeInfo))
    declr] NodeInfo
    node | (Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
     Maybe (CExpression NodeInfo))
    declr <- [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    ds ]
        where
        elideSUEDef :: CDeclarationSpecifier a -> CDeclarationSpecifier a
    elideSUEDef declspec :: CDeclarationSpecifier a
    declspec@(CTypeSpec CTypeSpecifier a
    tyspec) =
            case CTypeSpecifier a
    tyspec of
                (CEnumType (CEnum Maybe Ident
    name Maybe [(Ident, Maybe (CExpression a))]
    _def [CAttribute a]
    _attrs a
    enum_node) a
    node_info) ->
                    CTypeSpecifier a -> CDeclarationSpecifier a
    forall a. CTypeSpecifier a -> CDeclarationSpecifier a
    CTypeSpec (CEnumeration a -> a -> CTypeSpecifier a
    forall a. CEnumeration a -> a -> CTypeSpecifier a
    CEnumType (Maybe Ident
    -> Maybe [(Ident, Maybe (CExpression a))]
    -> [CAttribute a]
    -> a
    -> CEnumeration a
    forall a.
    Maybe Ident
    -> Maybe [(Ident, Maybe (CExpression a))]
    -> [CAttribute a]
    -> a
    -> CEnumeration a
    CEnum Maybe Ident
    name Maybe [(Ident, Maybe (CExpression a))]
    forall a. Maybe a
    Nothing [] a
    enum_node) a
    node_info)
                (CSUType (CStruct CStructTag
    tag Maybe Ident
    name Maybe [CDeclaration a]
    _def [CAttribute a]
    _attrs a
    su_node) a
    node_info) ->
                    CTypeSpecifier a -> CDeclarationSpecifier a
    forall a. CTypeSpecifier a -> CDeclarationSpecifier a
    CTypeSpec (CStructureUnion a -> a -> CTypeSpecifier a
    forall a. CStructureUnion a -> a -> CTypeSpecifier a
    CSUType (CStructTag
    -> Maybe Ident
    -> Maybe [CDeclaration a]
    -> [CAttribute a]
    -> a
    -> CStructureUnion a
    forall a.
    CStructTag
    -> Maybe Ident
    -> Maybe [CDeclaration a]
    -> [CAttribute a]
    -> a
    -> CStructureUnion a
    CStruct CStructTag
    tag Maybe Ident
    name Maybe [CDeclaration a]
    forall a. Maybe a
    Nothing [] a
    su_node) a
    node_info)
                CTypeSpecifier a
    _ -> CDeclarationSpecifier a
    declspec
        elideSUEDef CDeclarationSpecifier a
    declspec = CDeclarationSpecifier a
    declspec

    -- | translate @__attribute__@ annotations
    -- TODO: This is a unwrap and wrap stub
    tAttr :: (MonadCError m, MonadSymtab m) => CAttr -> m Attr
    tAttr :: forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    CAttribute NodeInfo -> m Attr
    tAttr (CAttr Ident
    name [CExpression NodeInfo]
    cexpr NodeInfo
    node) = Attr -> m Attr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(Attr -> m Attr) -> Attr -> m Attr
    forall a b. (a -> b) -> a -> b
    $ Ident -> [CExpression NodeInfo] -> NodeInfo -> Attr
    Attr Ident
    name [CExpression NodeInfo]
    cexpr NodeInfo
    node

    -- | construct a name for a variable
    -- TODO: more or less bogus
    mkVarName :: (MonadCError m, MonadSymtab m) =>
                 NodeInfo -> Maybe Ident -> Maybe AsmName -> m VarName
    mkVarName :: forall (m :: * -> *).
    (MonadCError m, MonadSymtab m) =>
    NodeInfo
    -> Maybe Ident -> Maybe (CStringLiteral NodeInfo) -> m VarName
    mkVarName  NodeInfo
    _node Maybe Ident
    Nothing Maybe (CStringLiteral NodeInfo)
    _ = VarName -> m VarName
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return VarName
    NoName
    mkVarName  NodeInfo
    _node (Just Ident
    n) Maybe (CStringLiteral NodeInfo)
    asm = VarName -> m VarName
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (VarName -> m VarName) -> VarName -> m VarName
    forall a b. (a -> b) -> a -> b
    $ Ident -> Maybe (CStringLiteral NodeInfo) -> VarName
    VarName Ident
    n Maybe (CStringLiteral NodeInfo)
    asm

    -- helpers
    nameOfDecl :: (MonadCError m) => CDecl -> m Ident
    nameOfDecl :: forall (m :: * -> *). MonadCError m => CDecl -> m Ident
    nameOfDecl CDecl
    d = CDecl -> m (CDeclarator NodeInfo)
    forall (m :: * -> *).
    MonadCError m =>
    CDecl -> m (CDeclarator NodeInfo)
    getOnlyDeclr CDecl
    d m (CDeclarator NodeInfo)
    -> (CDeclarator NodeInfo -> m Ident) -> m Ident
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \CDeclarator NodeInfo
    declr ->
        case CDeclarator NodeInfo
    declr of
            (CDeclr (Just Ident
    name) [CDerivedDeclr]
    _ Maybe (CStringLiteral NodeInfo)
    _ [CAttribute NodeInfo]
    _ NodeInfo
    _node) -> Ident -> m Ident
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ident
    name
            (CDeclr Maybe Ident
    Nothing [CDerivedDeclr]
    _ Maybe (CStringLiteral NodeInfo)
    _ [CAttribute NodeInfo]
    _ NodeInfo
    _node)     -> String -> m Ident
    forall a. String -> a
    internalErr String
    "nameOfDecl: abstract declarator"
    emptyDeclr :: NodeInfo -> CDeclr
    emptyDeclr :: NodeInfo -> CDeclarator NodeInfo
    emptyDeclr NodeInfo
    node = Maybe Ident
    -> [CDerivedDeclr]
    -> Maybe (CStringLiteral NodeInfo)
    -> [CAttribute NodeInfo]
    -> NodeInfo
    -> CDeclarator NodeInfo
    forall a.
    Maybe Ident
    -> [CDerivedDeclarator a]
    -> Maybe (CStringLiteral a)
    -> [CAttribute a]
    -> a
    -> CDeclarator a
    CDeclr Maybe Ident
    forall a. Maybe a
    Nothing [] Maybe (CStringLiteral NodeInfo)
    forall a. Maybe a
    Nothing [] NodeInfo
    node
    getOnlyDeclr :: (MonadCError m) => CDecl -> m CDeclr
    getOnlyDeclr :: forall (m :: * -> *).
    MonadCError m =>
    CDecl -> m (CDeclarator NodeInfo)
    getOnlyDeclr (CDecl [CDeclarationSpecifier NodeInfo]
    _ [(Just CDeclarator NodeInfo
    declr,Maybe (CInitializer NodeInfo)
    _,Maybe (CExpression NodeInfo)
    _)] NodeInfo
    _) = CDeclarator NodeInfo -> m (CDeclarator NodeInfo)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CDeclarator NodeInfo
    declr
    getOnlyDeclr (CDecl [CDeclarationSpecifier NodeInfo]
    _ [(Maybe (CDeclarator NodeInfo), Maybe (CInitializer NodeInfo),
      Maybe (CExpression NodeInfo))]
    _ NodeInfo
    _node) = String -> m (CDeclarator NodeInfo)
    forall a. String -> a
    internalErr String
    "getOnlyDeclr: declaration doesn't have a unique declarator"
    getOnlyDeclr (CStaticAssert CExpression NodeInfo
    _ CStringLiteral NodeInfo
    _ NodeInfo
    _) = String -> m (CDeclarator NodeInfo)
    forall a. String -> a
    internalErr String
    "getOnlyDeclr: static assertion doesn't have a unique declarator"