    {-# LANGUAGE PatternGuards #-}
    -----------------------------------------------------------------------------
    -- |
    -- 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,
      -- * Helpers
      VarDeclInfo(..),
      tAttr,mkVarName,getOnlyDeclr,nameOfDecl,
    )
    where
    import Language.C.Data.Error
    import Language.C.Data.Node
    import Language.C.Data.Ident
    import Language.C.Syntax
    import Language.C.Analysis.DefTable (TagFwdDecl(..))
    import Language.C.Analysis.SemError
    import Language.C.Analysis.SemRep
    import Language.C.Analysis.TravMonad

    import Data.Foldable as F (foldrM)
    import qualified Data.Traversable as T
    import Control.Monad (liftM,when,ap)
    import Data.List (intersperse, mapAccumL)
    import Data.Map (Map)
    import qualified Data.Map as Map

    -- * handling declarations

    -- | analyse and translate a parameter declaration
    -- Should be called in either prototype or block scope
    tParamDecl :: (MonadTrav m) => CDecl -> m ParamDecl
    tParamDecl (CDecl declspecs declrs node) =
      do declr <- getParamDeclr
         -- analyse the variable declaration
         (VarDeclInfo name is_inline storage_spec attrs ty declr_node) <- analyseVarDecl True declspecs declr [] Nothing
         when (is_inline) $ throwTravError (badSpecifierError node "parameter declaration with inline specifier")
         -- compute storage of parameter (NoStorage, but might have a register specifier)
         storage <- throwOnLeft $ computeParamStorage node storage_spec
         let paramDecl = mkParamDecl name storage attrs ty declr_node
         handleParamDecl paramDecl
         return $ paramDecl
      where
      getParamDeclr =
          case declrs of
              [] -> return (emptyDeclr node)
              [(Just declr,Nothing,Nothing)] -> return declr
              _ -> astError node "bad parameter declaration: multiple decls / bitfield or initializer present"
      mkParamDecl name storage attrs ty declr_node =
        let vd = VarDecl name (DeclAttrs False storage attrs) ty in
        case name of
          NoName -> AbstractParamDecl vd declr_node
          _ -> ParamDecl vd declr_node
    -- | a parameter declaration has no linkage and either auto or register storage
    computeParamStorage :: NodeInfo -> StorageSpec -> Either BadSpecifierError Storage
    computeParamStorage _ NoStorageSpec = Right (Auto False)
    computeParamStorage _ RegSpec       = Right (Auto True)
    computeParamStorage node spec       = Left . badSpecifierError node $ "Bad storage specified for parameter: " ++ show spec

    -- | analyse and translate a member declaration
    tMemberDecls :: (MonadTrav m) => CDecl -> m [MemberDecl]
    tMemberDecls (CDecl declspecs declrs node) = mapM (uncurry tMemberDecl) (zip (True:repeat False) declrs)
        where
        tMemberDecl handle_sue_def (Just member_declr,Nothing,bit_field_size_opt) =
            do var_decl <- analyseVarDecl handle_sue_def declspecs member_declr [] Nothing
               let (VarDeclInfo name is_inline storage_spec attrs ty declr_node) = var_decl
               --
               checkValidMemberSpec is_inline storage_spec
               return $ MemberDecl (VarDecl name (DeclAttrs False NoStorage attrs) ty) bit_field_size_opt node
        tMemberDecl handle_sue_def (Nothing,Nothing,Just bit_field_size) =
            do let (storage_specs, _attrs, typequals, typespecs, is_inline) = partitionDeclSpecs declspecs
               storage_spec  <- canonicalStorageSpec storage_specs
               typ           <- tType handle_sue_def node typequals typespecs [] []
               --
               return $ AnonBitField typ bit_field_size node
        tMemberDecl _ _ = astError node "Bad member declaration"
        checkValidMemberSpec is_inline storage_spec =
            do  when (is_inline)                     $ astError node "member declaration with inline specifier"
                when (storage_spec /= NoStorageSpec) $ astError node "storage specifier for member"
                return ()

    data StorageSpec = NoStorageSpec | AutoSpec | RegSpec | ThreadSpec | StaticSpec Bool | ExternSpec Bool
                        deriving (Eq,Ord,Show,Read)

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

    data VarDeclInfo = VarDeclInfo VarName Bool {- is-inline? -} StorageSpec Attributes Type NodeInfo

    -- | analyse declarators
    analyseVarDecl :: (MonadTrav m) => Bool -> [CDeclSpec] -> CDeclr -> [CDecl] -> (Maybe CInit) -> m VarDeclInfo
    analyseVarDecl handle_sue_def declspecs
                   (CDeclr name_opt derived_declrs asmname_opt declr_attrs node)
                   oldstyle_params init_opt
        = do let (storage_specs, decl_attrs, typequals, typespecs, inline) = partitionDeclSpecs declspecs
             -- analyse the storage specifiers
             storage_spec  <- canonicalStorageSpec storage_specs
             -- translate the type into semantic representation
             typ          <- tType handle_sue_def node typequals typespecs 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 inline storage_spec attrs' typ node
        where
            isInlineSpec (CInlineQual _) = True
            isInlineSpec _ = False

    -- return @True@ if the declarations is a type def
    isTypeDef :: [CDeclSpec] -> Bool
    isTypeDef declspecs = not $ null [ n | (CStorageSpec (CTypedef n)) <- 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 (CDecl declspecs declrs node)
        | [] <- declrs = analyseTyDeclr (emptyDeclr node)
        | [(Just declr,Nothing,Nothing)] <- declrs = analyseTyDeclr declr
        | otherwise = astError node "Bad declarator for type declaration"
        where
        analyseTyDeclr (CDeclr Nothing derived_declrs Nothing attrs _declrnode)
            | (not (null storagespec) || inline) = astError node "storage specifier for type declaration"
            | otherwise                          = tType True node (map CAttrQual (attrs++attrs_decl) ++ typequals)
                                                         typespecs derived_declrs []
            where
            (storagespec, attrs_decl, typequals, typespecs, inline) = partitionDeclSpecs declspecs
        analyseTyDeclr _ = astError node "Non-abstract declarator in type declaration"

    -- | translate a type
    tType :: (MonadTrav m) => Bool -> NodeInfo -> [CTypeQual] -> [CTypeSpec] -> [CDerivedDeclr] -> [CDecl] -> m Type
    tType handle_sue_def top_node typequals typespecs derived_declrs oldstyle_params
        = mergeOldStyle top_node oldstyle_params derived_declrs >>= buildType
        where
        buildType [] = tDirectType handle_sue_def top_node typequals typespecs
        buildType (CPtrDeclr ptrquals node : dds) =
            buildType dds >>= buildPointerType ptrquals node
        buildType (CArrDeclr arrquals size node : dds)
            = buildType dds >>= buildArrayType arrquals size node
        buildType (CFunDeclr ~(Right (params, isVariadic)) attrs node : dds)
            = buildType dds >>= (liftM FunctionType . buildFunctionType params isVariadic attrs node)
        buildPointerType ptrquals _node inner_ty
            = liftM (\(quals,attrs) -> PtrType inner_ty quals attrs) (tTypeQuals ptrquals)
        buildArrayType arr_quals size _node inner_ty
            = do (quals,attrs) <- tTypeQuals 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 params is_variadic attrs _node return_ty
            = do enterPrototypeScope
                 params' <- mapM tParamDecl params
                 leavePrototypeScope
                 attrs'   <- mapM tAttr attrs
                 return $ case (map declType params',is_variadic) of
                   ([],False) -> FunTypeIncomplete return_ty attrs'  -- may be improved later on
                   ([DirectType TyVoid _],False) -> FunType return_ty [] False attrs'
                   _ -> FunType return_ty params' is_variadic attrs'

    -- | 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] -> [CTypeSpec] -> m Type
    tDirectType handle_sue_def node ty_quals ty_specs = do
        (quals,attrs) <- tTypeQuals ty_quals
        canonTySpec <- canonicalTypeSpec ty_specs
        let baseType ty_name = DirectType ty_name quals
        case canonTySpec of
            TSNone -> return$ baseType (TyIntegral TyInt)
            TSVoid -> return$ baseType TyVoid
            TSBool -> return$ baseType (TyIntegral TyBool)
            TSNum tsnum -> do
                numType <- tNumType tsnum
                return . baseType $
                    case numType of
                        Left (floatType,iscomplex) | iscomplex -> TyComplex floatType
                                                   | otherwise -> TyFloating floatType
                        Right intType  -> TyIntegral intType
            TSNonBasic (CSUType su _tnode)      -> liftM (baseType . TyComp) $ tCompTypeDecl handle_sue_def su
            TSNonBasic (CEnumType enum _tnode)   -> liftM (baseType . TyEnum) $ tEnumTypeDecl handle_sue_def enum
            TSNonBasic (CTypeDef name t_node)    -> liftM TypeDefType $ typeDefRef t_node name
            -- TODO: analyse type of expression
            TSNonBasic (CTypeOfExpr expr _tnode) -> return $ TypeOfExpr expr
            TSNonBasic (CTypeOfType decl t_node) ->  analyseTypeDecl decl >>= mergeTypeAttributes t_node quals attrs
            TSNonBasic _ -> astError node "Unexpected typespec"

    -- | Merge type attributes
    --
    -- This handles for example the form
    --
    -- > /* tyqual attr typeof(type) */
    -- > const typeof(char volatile) x;
    mergeTypeAttributes :: (MonadTrav m) => NodeInfo -> TypeQuals -> [Attr] -> Type -> m Type
    mergeTypeAttributes node_info quals attrs typ =
        case typ of
            DirectType ty_name quals' -> merge quals' [] $ mkDirect ty_name
            PtrType ty quals' attrs'  -> merge quals' attrs' $ PtrType ty
            ArrayType ty array_sz quals' attrs' -> merge quals' attrs' $ ArrayType ty array_sz
            FunctionType (FunType return_ty params inline attrs')
                | not (null attrs) -> astError node_info "type qualifiers for function type"
                | otherwise        -> return$ FunctionType (FunType return_ty params inline (attrs' ++ attrs))
        where
        mkDirect ty_name quals' attrs' | null attrs' = DirectType ty_name quals'
                                       | otherwise   = error "_attribute__ s for DirectType"
        merge quals' attrs' tyf = return $ tyf (mergeTypeQuals quals quals') (attrs' ++ attrs)

    typeDefRef :: (MonadTrav m) => NodeInfo -> Ident -> m TypeDefRef
    typeDefRef t_node name = lookupTypeDef name >>= \ty -> return (TypeDefRef name (Just ty) 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 handle_def (CStruct tag ident_opt member_decls_opt attrs node_info) = do
        -- create reference
        sue_ref <- createSUERef node_info ident_opt
        let tag' = tTag tag
        attrs' <- mapM tAttr attrs
        -- record tag name
        let decl = CompTypeRef sue_ref tag' node_info
        handleTagDecl (CompDecl decl)
        -- when handle_def is true, enter the definition
        when (handle_def) $ do
            maybeM member_decls_opt $ \decls ->
                    tCompType sue_ref tag' decls (attrs') node_info
                >>= (handleTagDef.CompDef)
        return decl

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

    tCompType :: (MonadTrav m) => SUERef -> CompTyKind -> [CDecl] -> Attributes -> NodeInfo -> m CompType
    tCompType tag sue_ref member_decls attrs node
        = return (CompType tag sue_ref) `ap`
            (concatMapM tMemberDecls member_decls) `ap`
            (return attrs) `ap`
            (return node)

    -- | translate a enum type decl
    --
    --  > enum my_enum
    --  > enum your_enum { x, y=3 }
    --
    tEnumTypeDecl :: (MonadTrav m) => Bool -> CEnum -> m EnumTypeRef
    tEnumTypeDecl handle_def (CEnum ident_opt enumerators_opt attrs node_info)
        | (Nothing, Nothing) <- (ident_opt, enumerators_opt) = astError node_info "both definition and name of enum missing"
        | Just [] <- enumerators_opt                         = astError node_info "empty enumerator list"
        | otherwise
            = do sue_ref <- createSUERef node_info ident_opt
                 attrs' <- mapM tAttr attrs
                 let decl = EnumTypeRef sue_ref node_info
                 when handle_def $ do
                     maybeM enumerators_opt $ \enumerators ->
                             tEnumType sue_ref enumerators attrs' node_info
                        >>=  (handleTagDef . EnumDef)
                 return decl

    -- | translate and analyse an enumeration type
    tEnumType :: (MonadTrav m) => SUERef -> [(Ident, Maybe CExpr)] -> Attributes -> NodeInfo -> m EnumType
    tEnumType sue_ref enumerators attrs node = do
        mapM_ handleEnumeratorDef enumerators'
        return ty
        where
        ty = EnumType sue_ref enumerators' attrs node
        (_,enumerators') = mapAccumL nextEnumerator (Left 0) enumerators
        nextEnumerator memo (ident,e) =
          let (memo',expr) = nextEnrExpr memo e in
          (memo', Enumerator ident expr ty (nodeInfo ident))
        nextEnrExpr :: (Either Integer (Expr,Integer)) -> Maybe CExpr -> (Either Integer (Expr,Integer), CExpr)
        nextEnrExpr (Left i) Nothing = (Left (succ i), intExpr i)
        nextEnrExpr (Right (e,offs)) Nothing = (Right (e, succ offs), offsExpr e offs)
        nextEnrExpr _ (Just e) = (Right (e,1), e)
        intExpr i = CConst (CIntConst (cInteger i) internalNode)
        offsExpr e offs = CBinary CAddOp e (intExpr offs) internalNode

    -- | Mapping from num type specs to C types (C99 6.7.2-2), ignoring the complex qualifier.
    tNumType :: (MonadTrav m) => NumTypeSpec -> m (Either (FloatType,Bool) IntType)
    tNumType (NumTypeSpec basetype sgn sz iscomplex) =
        case (basetype,sgn,sz) of
            (BaseChar,_,NoSizeMod)      | Signed <- sgn   -> intType TySChar
                                          | Unsigned <- sgn -> intType TyUChar
                                          | otherwise       -> intType TyChar
            (intbase, _, NoSizeMod)  | optBase BaseInt intbase ->
                intType$ case sgn of
                                Unsigned -> TyUInt
                                _        -> TyInt
            (intbase, signed, sizemod)    | optBase BaseInt intbase, optSign Signed signed ->
                intType$ case sizemod of ShortMod    -> TyShort
                                         LongMod     -> TyLong
                                         LongLongMod -> TyLLong
                                         _ -> internalErr "numTypeMapping: unexpected pattern matching error"
            (intbase, Unsigned, sizemod) | optBase BaseInt intbase ->
                intType$ case sizemod of ShortMod    -> TyUShort
                                         LongMod     -> TyULong
                                         LongLongMod -> TyULLong
                                         _ -> internalErr "numTypeMapping: unexpected pattern matching error"
            (BaseFloat, NoSignSpec, NoSizeMod)  -> floatType TyFloat
            (BaseDouble, NoSignSpec, NoSizeMod) -> floatType TyDouble
            (BaseDouble, NoSignSpec, LongMod)   -> floatType TyLDouble
            -- TODO: error analysis
            (_,_,_)   -> error "Bad AST analysis"
        where
        optBase _ NoBaseType = True
        optBase expect baseTy = expect == baseTy
        optSign _ NoSignSpec = True
        optSign expect sign = expect == sign
        intType = return . Right
        floatType ft = return (Left (ft,iscomplex))

    -- TODO: currently bogus
    tArraySize :: (MonadTrav m) => CArrSize -> m ArraySize
    tArraySize (CNoArrSize False) = return (UnknownArraySize False)
    tArraySize (CNoArrSize True) = return (UnknownArraySize True)
    tArraySize (CArrSize static szexpr) = liftM (ArraySize static) (return szexpr)

    tTypeQuals :: (MonadTrav m) => [CTypeQual] -> m (TypeQuals,Attributes)
    tTypeQuals = foldrM go (noTypeQuals,[]) where
        go (CConstQual _) (tq,attrs) = return$ (tq { constant = True },attrs)
        go (CVolatQual _) (tq,attrs) = return$ (tq { volatile = True },attrs)
        go (CRestrQual _) (tq,attrs) = return$ (tq { restrict = True },attrs)
        go (CAttrQual attr) (tq,attrs) = liftM (\attr' -> (tq,attr':attrs)) (tAttr attr)
        go (CInlineQual node) (_tq,_attrs) = astError node "unexpected inline qualifier"

    -- * analysis

    {-
    To canoicalize type specifiers, we define a canonical form:
    void | bool | (char|int|float|double) (signed|unsigned)? (long long?)? complex? | othertype
    -}
    data NumBaseType = NoBaseType | BaseChar | BaseInt | BaseFloat | BaseDouble deriving (Eq,Ord)
    data SignSpec    = NoSignSpec | Signed | Unsigned deriving (Eq,Ord)
    data SizeMod     = NoSizeMod | ShortMod | LongMod | LongLongMod deriving (Eq,Ord)
    data NumTypeSpec = NumTypeSpec { base :: NumBaseType, signSpec :: SignSpec, sizeMod :: SizeMod, isComplex :: Bool  }
    emptyNumTypeSpec :: NumTypeSpec
    emptyNumTypeSpec = NumTypeSpec { base = NoBaseType, signSpec = NoSignSpec, sizeMod = NoSizeMod, isComplex = False }
    data TypeSpecAnalysis = TSNone | TSVoid | TSBool | TSNum NumTypeSpec | TSNonBasic CTypeSpec

    canonicalTypeSpec :: (MonadTrav m) => [CTypeSpec] -> m TypeSpecAnalysis
    canonicalTypeSpec = foldrM go TSNone where
        getNTS TSNone = Just emptyNumTypeSpec
        getNTS (TSNum nts) = Just nts
        getNTS _ = Nothing
        updLongMod NoSizeMod = Just LongMod
        updLongMod LongMod   = Just LongLongMod
        updLongMod _         = Nothing
        go (CVoidType _)    TSNone = return$  TSVoid
        go (CBoolType _)    TSNone = return$  TSBool
        go (CCharType _)    tsa | (Just nts@(NumTypeSpec { base = NoBaseType })) <- getNTS tsa
                                = return$  TSNum$ nts { base = BaseChar }
        go (CIntType _)     tsa | (Just nts@(NumTypeSpec { base = NoBaseType })) <- getNTS tsa
                                = return$  TSNum$ nts { base = BaseInt }
        go (CFloatType _)   tsa | (Just nts@(NumTypeSpec { base = NoBaseType })) <- getNTS tsa
                                = return$  TSNum$ nts { base = BaseFloat }
        go (CDoubleType _)  tsa | (Just nts@(NumTypeSpec { base = NoBaseType })) <- getNTS tsa
                                = return$  TSNum$ nts { base = BaseDouble }
        go (CShortType _)   tsa | (Just nts@(NumTypeSpec { sizeMod = NoSizeMod })) <- getNTS tsa
                                = return$  TSNum$nts { sizeMod = ShortMod }
        go (CLongType _)    tsa | (Just nts@(NumTypeSpec { sizeMod = szMod })) <- getNTS tsa,
                                  (Just szMod') <- updLongMod szMod
                                = return$  TSNum$ nts { sizeMod = szMod' }
        go (CSignedType _)  tsa | (Just nts@(NumTypeSpec { signSpec = NoSignSpec })) <- getNTS tsa
                                = return$  TSNum$ nts { signSpec = Signed }
        go (CUnsigType _)   tsa | (Just nts@(NumTypeSpec { signSpec = NoSignSpec })) <- getNTS tsa
                                = return$  TSNum$ nts { signSpec = Unsigned }
        go (CComplexType _) tsa | (Just nts@(NumTypeSpec { isComplex = False })) <- getNTS tsa
                                = return$  TSNum$ nts { isComplex = True }
        go otherType  TSNone    = return$  TSNonBasic otherType
        go ty _ts = astError (nodeInfo ty) "Invalid type specifier"

    -- compute storage given storage specifiers
    canonicalStorageSpec :: (MonadTrav m) =>[CStorageSpec] -> m StorageSpec
    canonicalStorageSpec storagespecs = liftM elideAuto $ foldrM updStorage NoStorageSpec storagespecs where
            updStorage (CAuto _) NoStorageSpec     = return$ AutoSpec
            updStorage (CRegister _) NoStorageSpec = return$ RegSpec
            updStorage (CThread _) NoStorageSpec   = return$ ThreadSpec
            updStorage (CThread _) (StaticSpec _)  = return$ StaticSpec True
            updStorage (CThread _) (ExternSpec _)  = return$ ExternSpec True
            updStorage (CStatic _) NoStorageSpec   = return$ StaticSpec False
            updStorage (CExtern _) NoStorageSpec   = return$ ExternSpec False
            updStorage (CStatic _) ThreadSpec      = return$ StaticSpec True
            updStorage (CExtern _) ThreadSpec      = return$ ExternSpec True
            updStorage badSpec old
                = astError (nodeInfo badSpec) $ "Invalid storage specifier "++show badSpec++" in combination with "++show old
            elideAuto AutoSpec = NoStorageSpec
            elideAuto spec = 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 :: (MonadTrav m) => NodeInfo -> [CDecl] -> [CDerivedDeclr] -> m [CDerivedDeclr]
    mergeOldStyle _node [] declrs = return declrs
    mergeOldStyle node oldstyle_params (CFunDeclr params attrs fdnode : dds) =
        case params of
            Left 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' <- liftM concat $ mapM splitCDecl oldstyle_params
                param_map <- liftM Map.fromList $ mapM attachNameOfDecl oldstyle_params'
                (newstyle_params,param_map') <- foldrM insertParamDecl ([],param_map) list
                when (not $ 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 _newstyle -> astError node "oldstyle parameter list, but newstyle function declaration"
        where
            attachNameOfDecl decl = nameOfDecl decl >>= \n -> return (n,decl)
            insertParamDecl param_name (ps, param_map)
                = case Map.lookup param_name param_map of
                    Just p -> return (p:ps, Map.delete param_name param_map)
                    Nothing -> return (implicitIntParam param_name : ps, param_map)
            implicitIntParam param_name =
                let node = (nodeInfo param_name) in
                CDecl [CTypeSpec (CIntType node)] [(Just (CDeclr (Just param_name) [] Nothing [] node),Nothing,Nothing)] node
            showParamMap = concat . intersperse ", " . map identToString . Map.keys
    mergeOldStyle node _ _ = astError node "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 :: (MonadTrav m) => CDecl -> m [CDecl]
    splitCDecl decl@(CDecl declspecs declrs node) =
        case declrs of
            []      -> internalErr "splitCDecl applied to empty declaration"
            [declr] -> return [decl]
            (d1:ds) ->
                let declspecs' = map elideSUEDef declspecs in
                return$ (CDecl declspecs [d1] node) : [ CDecl declspecs' [declr] node | declr <- ds ]
        where
        elideSUEDef declspec@(CTypeSpec tyspec) =
            case tyspec of
                (CEnumType (CEnum name def attrs enum_node) node) ->
                    CTypeSpec (CEnumType (CEnum name Nothing [] enum_node) node)
                (CSUType (CStruct tag name def attrs su_node) node) ->
                    CTypeSpec (CSUType (CStruct tag name Nothing [] su_node) node)
                _ -> declspec
        elideSUEDef declspec = declspec

    -- | translate @__attribute__@ annotations
    -- TODO: This is a unwrap and wrap stub
    tAttr :: (MonadTrav m) => CAttr -> m Attr
    tAttr (CAttr name cexpr node) = return$ Attr name cexpr node

    -- | construct a name for a variable
    -- TODO: more or less bogus
    mkVarName :: (MonadTrav m) => NodeInfo -> Maybe Ident -> Maybe AsmName -> m VarName
    mkVarName  node Nothing _ = return NoName
    mkVarName  node (Just n) asm = return $ VarName n Nothing

    -- helpers
    nameOfDecl :: (MonadTrav m) => CDecl -> m Ident
    nameOfDecl d = getOnlyDeclr d >>= \declr ->
        case declr of
            (CDeclr (Just name) _ _ _ _) -> return name
            (CDeclr Nothing _ _ _ node) -> internalErr "nameOfDecl: abstract declarator"
    emptyDeclr :: NodeInfo -> CDeclr
    emptyDeclr node = CDeclr Nothing [] Nothing [] node
    getOnlyDeclr :: (MonadTrav m) => CDecl -> m CDeclr
    getOnlyDeclr (CDecl _ [(Just declr,_,_)] _) = return declr
    getOnlyDeclr (CDecl _ _ node) = internalErr "getOnlyDeclr: declaration doesn't have a unique declarator"