-----------------------------------------------------------------------------
-- |
-- Module      :  Language.C.Analysis.Export
-- Copyright   :  (c) 2008 Benedikt Huber
-- License     :  BSD-style
-- Maintainer  :  benedikt.huber@gmail.com
-- Stability   :  prototype
-- Portability :  ghc
--
-- /WARNING/ : This is just an implementation sketch and not very well tested.
--
-- Export 'SemRep' entities to 'AST' nodes.
-----------------------------------------------------------------------------
module Language.C.Analysis.Export (
exportDeclr,
exportType, exportTypeDecl, exportTypeSpec,
exportTypeDef,
exportCompType, exportCompTypeDecl, exportCompTypeRef,
exportEnumType, exportEnumTypeDecl, exportEnumTypeRef,
export,
)
where
import           Data.Functor               ((<$>))
import           Data.List
import qualified Data.Map                   as Map
import           Data.Maybe
import           Language.C.Analysis.SemRep
import           Language.C.Data.Ident
import           Language.C.Data.Name       (nameId)
import           Language.C.Data.Node
import           Language.C.Syntax.AST


-- | Export global declarations
-- TODO: This does not export tags and type defs yet
export :: GlobalDecls -> CTranslUnit
export :: GlobalDecls -> CTranslUnit
export (GlobalDecls Map Ident IdentDecl
objs Map SUERef TagDef
tags Map Ident TypeDef
typedefs) = [CExternalDeclaration NodeInfo] -> NodeInfo -> CTranslUnit
forall a. [CExternalDeclaration a] -> a -> CTranslationUnit a
CTranslUnit ([CExternalDeclaration NodeInfo]
declarations [CExternalDeclaration NodeInfo]
-> [CExternalDeclaration NodeInfo]
-> [CExternalDeclaration NodeInfo]
forall a. [a] -> [a] -> [a]
++ []) NodeInfo
undefNode
  where declarations :: [CExternalDeclaration NodeInfo]
declarations = ((Ident, IdentDecl) -> CExternalDeclaration NodeInfo)
-> [(Ident, IdentDecl)] -> [CExternalDeclaration NodeInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ident, IdentDecl) -> CExternalDeclaration NodeInfo
exportIdentDecl ([(Ident, IdentDecl)] -> [(Ident, IdentDecl)]
forall {b}. [(Ident, b)] -> [(Ident, b)]
filterBuiltins ([(Ident, IdentDecl)] -> [(Ident, IdentDecl)])
-> [(Ident, IdentDecl)] -> [(Ident, IdentDecl)]
forall a b. (a -> b) -> a -> b
$ Map Ident IdentDecl -> [(Ident, IdentDecl)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Ident IdentDecl
objs)
        filterBuiltins :: [(Ident, b)] -> [(Ident, b)]
filterBuiltins = ((Ident, b) -> Bool) -> [(Ident, b)] -> [(Ident, b)]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (Ident, b) -> Bool
forall {b}. (Ident, b) -> Bool
noBuiltIns
        noBuiltIns :: (Ident, b) -> Bool
noBuiltIns (Ident
idn, b
_) = let n :: String
n = Ident -> String
identToString Ident
idn
                              in Bool -> Bool
not (String
"__builtin" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
n) Bool -> Bool -> Bool
&&
                                  (String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"__FUNCTION__") Bool -> Bool -> Bool
&&
                                  (String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"__PRETTY_FUNCTION__") Bool -> Bool -> Bool
&&
                                  (String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"__func__" )


exportIdentDecl :: (Ident, IdentDecl) -> CExternalDeclaration NodeInfo
exportIdentDecl :: (Ident, IdentDecl) -> CExternalDeclaration NodeInfo
exportIdentDecl (Ident
_, Declaration Decl
decl)   = CDeclaration NodeInfo -> CExternalDeclaration NodeInfo
forall a. CDeclaration a -> CExternalDeclaration a
CDeclExt (CDeclaration NodeInfo -> CExternalDeclaration NodeInfo)
-> CDeclaration NodeInfo -> CExternalDeclaration NodeInfo
forall a b. (a -> b) -> a -> b
$ Decl -> CDeclaration NodeInfo
exportDeclaration Decl
decl
exportIdentDecl (Ident
_, FunctionDef FunDef
fundef) = CFunctionDef NodeInfo -> CExternalDeclaration NodeInfo
forall a. CFunctionDef a -> CExternalDeclaration a
CFDefExt (CFunctionDef NodeInfo -> CExternalDeclaration NodeInfo)
-> CFunctionDef NodeInfo -> CExternalDeclaration NodeInfo
forall a b. (a -> b) -> a -> b
$ FunDef -> CFunctionDef NodeInfo
exportFunDef FunDef
fundef
exportIdentDecl (Ident
_, ObjectDef ObjDef
objdef)   = CDeclaration NodeInfo -> CExternalDeclaration NodeInfo
forall a. CDeclaration a -> CExternalDeclaration a
CDeclExt (CDeclaration NodeInfo -> CExternalDeclaration NodeInfo)
-> CDeclaration NodeInfo -> CExternalDeclaration NodeInfo
forall a b. (a -> b) -> a -> b
$ ObjDef -> CDeclaration NodeInfo
exportObject ObjDef
objdef
exportIdentDecl (Ident
_, EnumeratorDef Enumerator
_)    = String -> CExternalDeclaration NodeInfo
forall a. HasCallStack => String -> a
error String
"not implemented: enumerator definition"

exportObject :: ObjDef -> CDeclaration NodeInfo
exportObject :: ObjDef -> CDeclaration NodeInfo
exportObject d :: ObjDef
d@(ObjDef VarDecl
_ Maybe Initializer
mInit NodeInfo
nInf) = [CDeclarationSpecifier NodeInfo]
-> [(Maybe (CDeclarator NodeInfo), Maybe Initializer,
     Maybe (CExpression NodeInfo))]
-> NodeInfo
-> CDeclaration NodeInfo
forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl [CDeclarationSpecifier NodeInfo]
specs' [(CDeclarator NodeInfo -> Maybe (CDeclarator NodeInfo)
forall a. a -> Maybe a
Just CDeclarator NodeInfo
decl, Maybe Initializer
mInit, Maybe (CExpression NodeInfo)
forall a. Maybe a
Nothing)] NodeInfo
nInf
  where
    (DeclAttrs FunctionAttrs
_ Storage
_ Attributes
attrs) = ObjDef -> DeclAttrs
forall n. Declaration n => n -> DeclAttrs
declAttrs ObjDef
d
    specs :: [CDeclarationSpecifier NodeInfo]
specs                 = DeclAttrs -> [CDeclarationSpecifier NodeInfo]
exportDeclarationSpecifiers (ObjDef -> DeclAttrs
forall n. Declaration n => n -> DeclAttrs
declAttrs ObjDef
d)
    ([CDeclarationSpecifier NodeInfo]
specs', CDeclarator NodeInfo
decl)        = [CDeclarationSpecifier NodeInfo]
-> Type
-> Attributes
-> VarName
-> ([CDeclarationSpecifier NodeInfo], CDeclarator NodeInfo)
exportDeclr [CDeclarationSpecifier NodeInfo]
specs (ObjDef -> Type
forall n. Declaration n => n -> Type
declType ObjDef
d) Attributes
attrs (ObjDef -> VarName
forall n. Declaration n => n -> VarName
declName ObjDef
d)


exportDeclaration :: Decl -> CDeclaration NodeInfo
exportDeclaration :: Decl -> CDeclaration NodeInfo
exportDeclaration Decl
d = [CDeclarationSpecifier NodeInfo]
-> [(Maybe (CDeclarator NodeInfo), Maybe Initializer,
     Maybe (CExpression NodeInfo))]
-> NodeInfo
-> CDeclaration NodeInfo
forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl [CDeclarationSpecifier NodeInfo]
specs' [(CDeclarator NodeInfo -> Maybe (CDeclarator NodeInfo)
forall a. a -> Maybe a
Just CDeclarator NodeInfo
decl, Maybe Initializer
forall a. Maybe a
Nothing, Maybe (CExpression NodeInfo)
forall a. Maybe a
Nothing)] NodeInfo
undefNode
  where
    (DeclAttrs FunctionAttrs
_ Storage
_ Attributes
attrs) = Decl -> DeclAttrs
forall n. Declaration n => n -> DeclAttrs
declAttrs Decl
d
    specs :: [CDeclarationSpecifier NodeInfo]
specs                 = DeclAttrs -> [CDeclarationSpecifier NodeInfo]
exportDeclarationSpecifiers (Decl -> DeclAttrs
forall n. Declaration n => n -> DeclAttrs
declAttrs Decl
d)
    ([CDeclarationSpecifier NodeInfo]
specs', CDeclarator NodeInfo
decl)        = [CDeclarationSpecifier NodeInfo]
-> Type
-> Attributes
-> VarName
-> ([CDeclarationSpecifier NodeInfo], CDeclarator NodeInfo)
exportDeclr [CDeclarationSpecifier NodeInfo]
specs (Decl -> Type
forall n. Declaration n => n -> Type
declType Decl
d) Attributes
attrs (Decl -> VarName
forall n. Declaration n => n -> VarName
declName Decl
d)


exportFunDef :: FunDef  -> CFunctionDef NodeInfo
exportFunDef :: FunDef -> CFunctionDef NodeInfo
exportFunDef d :: FunDef
d@(FunDef VarDecl
_ Stmt
stmt NodeInfo
_) = [CDeclarationSpecifier NodeInfo]
-> CDeclarator NodeInfo
-> [CDeclaration NodeInfo]
-> Stmt
-> NodeInfo
-> CFunctionDef NodeInfo
forall a.
[CDeclarationSpecifier a]
-> CDeclarator a
-> [CDeclaration a]
-> CStatement a
-> a
-> CFunctionDef a
CFunDef [CDeclarationSpecifier NodeInfo]
cDeclSpecs CDeclarator NodeInfo
cDecl [CDeclaration NodeInfo]
oldStyleParams Stmt
stmt NodeInfo
undefNode
  where
    ([CDeclarationSpecifier NodeInfo]
cDeclSpecs, CDeclarator NodeInfo
cDecl) = [CDeclarationSpecifier NodeInfo]
-> Type
-> Attributes
-> VarName
-> ([CDeclarationSpecifier NodeInfo], CDeclarator NodeInfo)
exportDeclr [CDeclarationSpecifier NodeInfo]
specs (FunDef -> Type
forall n. Declaration n => n -> Type
declType FunDef
d) ([] :: Attributes) (FunDef -> VarName
forall n. Declaration n => n -> VarName
declName FunDef
d)
    oldStyleParams :: [CDeclaration NodeInfo]
oldStyleParams= [] :: [CDeclaration NodeInfo] -- TODO:?
    specs :: [CDeclarationSpecifier NodeInfo]
specs = DeclAttrs -> [CDeclarationSpecifier NodeInfo]
exportDeclarationSpecifiers (FunDef -> DeclAttrs
forall n. Declaration n => n -> DeclAttrs
declAttrs FunDef
d):: [CDeclarationSpecifier NodeInfo]

exportDeclarationSpecifiers :: DeclAttrs -> [CDeclarationSpecifier NodeInfo]
exportDeclarationSpecifiers :: DeclAttrs -> [CDeclarationSpecifier NodeInfo]
exportDeclarationSpecifiers (DeclAttrs FunctionAttrs
funcAttrs Storage
storage Attributes
attrs ) = [CDeclarationSpecifier NodeInfo]
specifiers
  where specifiers :: [CDeclarationSpecifier NodeInfo]
specifiers = (CFunctionSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo
forall a. CFunctionSpecifier a -> CDeclarationSpecifier a
CFunSpec (CFunctionSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo)
-> [CFunctionSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FunctionAttrs -> [CFunctionSpecifier NodeInfo]
exportFunAttrs FunctionAttrs
funcAttrs) [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall a. [a] -> [a] -> [a]
++ (CStorageSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo
forall a. CStorageSpecifier a -> CDeclarationSpecifier a
CStorageSpec (CStorageSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo)
-> [CStorageSpecifier NodeInfo] -> [CDeclarationSpecifier NodeInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Storage -> [CStorageSpecifier NodeInfo]
exportStorage Storage
storage)


-- |Export Declarator
--
--  Synopsis: @exportDeclr other_specs type attributes variable-name@
exportDeclr :: [CDeclSpec] -> Type -> Attributes -> VarName -> ([CDeclSpec],CDeclr)
exportDeclr :: [CDeclarationSpecifier NodeInfo]
-> Type
-> Attributes
-> VarName
-> ([CDeclarationSpecifier NodeInfo], CDeclarator NodeInfo)
exportDeclr [CDeclarationSpecifier NodeInfo]
other_specs Type
ty Attributes
attrs VarName
name =
    ([CDeclarationSpecifier NodeInfo]
other_specs [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall a. [a] -> [a] -> [a]
++ [CDeclarationSpecifier NodeInfo]
specs, Maybe Ident
-> [CDerivedDeclarator NodeInfo]
-> 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
ident [CDerivedDeclarator NodeInfo]
derived Maybe (CStringLiteral NodeInfo)
asmname (Attributes -> [CAttribute NodeInfo]
exportAttrs Attributes
attrs) NodeInfo
ni)
    where
    ([CDeclarationSpecifier NodeInfo]
specs,[CDerivedDeclarator NodeInfo]
derived) = Type
-> ([CDeclarationSpecifier NodeInfo],
    [CDerivedDeclarator NodeInfo])
exportType Type
ty
    (Maybe Ident
ident,Maybe (CStringLiteral NodeInfo)
asmname) = case VarName
name of (VarName Ident
vident Maybe (CStringLiteral NodeInfo)
asmname_opt) -> (Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
vident, Maybe (CStringLiteral NodeInfo)
asmname_opt)
                                   VarName
_ -> (Maybe Ident
forall a. Maybe a
Nothing,Maybe (CStringLiteral NodeInfo)
forall a. Maybe a
Nothing)

exportTypeDecl :: Type -> CDecl
exportTypeDecl :: Type -> CDeclaration NodeInfo
exportTypeDecl Type
ty =
  [CDeclarationSpecifier NodeInfo]
-> [(Maybe (CDeclarator NodeInfo), Maybe Initializer,
     Maybe (CExpression NodeInfo))]
-> NodeInfo
-> CDeclaration NodeInfo
forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl [CDeclarationSpecifier NodeInfo]
declspecs [(Maybe (CDeclarator NodeInfo), Maybe Initializer,
  Maybe (CExpression NodeInfo))]
forall {a} {a}. [(Maybe (CDeclarator NodeInfo), Maybe a, Maybe a)]
declrs NodeInfo
ni
  where
  ([CDeclarationSpecifier NodeInfo]
declspecs,[CDerivedDeclarator NodeInfo]
derived) = Type
-> ([CDeclarationSpecifier NodeInfo],
    [CDerivedDeclarator NodeInfo])
exportType Type
ty
  declrs :: [(Maybe (CDeclarator NodeInfo), Maybe a, Maybe a)]
declrs | [CDerivedDeclarator NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CDerivedDeclarator NodeInfo]
derived = []
         | Bool
otherwise = [(CDeclarator NodeInfo -> Maybe (CDeclarator NodeInfo)
forall a. a -> Maybe a
Just (CDeclarator NodeInfo -> Maybe (CDeclarator NodeInfo))
-> CDeclarator NodeInfo -> Maybe (CDeclarator NodeInfo)
forall a b. (a -> b) -> a -> b
$ Maybe Ident
-> [CDerivedDeclarator NodeInfo]
-> 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 [CDerivedDeclarator NodeInfo]
derived Maybe (CStringLiteral NodeInfo)
forall a. Maybe a
Nothing [] NodeInfo
ni,Maybe a
forall a. Maybe a
Nothing,Maybe a
forall a. Maybe a
Nothing)]

exportTypeDef :: TypeDef -> CDecl
exportTypeDef :: TypeDef -> CDeclaration NodeInfo
exportTypeDef (TypeDef Ident
ident Type
ty Attributes
attrs NodeInfo
node_info) =
  [CDeclarationSpecifier NodeInfo]
-> [(Maybe (CDeclarator NodeInfo), Maybe Initializer,
     Maybe (CExpression NodeInfo))]
-> NodeInfo
-> CDeclaration NodeInfo
forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl (CStorageSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo
forall a. CStorageSpecifier a -> CDeclarationSpecifier a
CStorageSpec (NodeInfo -> CStorageSpecifier NodeInfo
forall a. a -> CStorageSpecifier a
CTypedef NodeInfo
ni) CDeclarationSpecifier NodeInfo
-> [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall a. a -> [a] -> [a]
: [CDeclarationSpecifier NodeInfo]
declspecs) [(Maybe (CDeclarator NodeInfo), Maybe Initializer,
 Maybe (CExpression NodeInfo))
forall {a} {a}. (Maybe (CDeclarator NodeInfo), Maybe a, Maybe a)
declr] NodeInfo
node_info
  where
  ([CDeclarationSpecifier NodeInfo]
declspecs,[CDerivedDeclarator NodeInfo]
derived) = Type
-> ([CDeclarationSpecifier NodeInfo],
    [CDerivedDeclarator NodeInfo])
exportType Type
ty
  declr :: (Maybe (CDeclarator NodeInfo), Maybe a, Maybe a)
declr = (CDeclarator NodeInfo -> Maybe (CDeclarator NodeInfo)
forall a. a -> Maybe a
Just (CDeclarator NodeInfo -> Maybe (CDeclarator NodeInfo))
-> CDeclarator NodeInfo -> Maybe (CDeclarator NodeInfo)
forall a b. (a -> b) -> a -> b
$ Maybe Ident
-> [CDerivedDeclarator NodeInfo]
-> 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
ident) [CDerivedDeclarator NodeInfo]
derived Maybe (CStringLiteral NodeInfo)
forall a. Maybe a
Nothing (Attributes -> [CAttribute NodeInfo]
exportAttrs Attributes
attrs) NodeInfo
ni, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)

-- |Export a type to syntax
exportType :: Type -> ([CDeclSpec],[CDerivedDeclr])
exportType :: Type
-> ([CDeclarationSpecifier NodeInfo],
    [CDerivedDeclarator NodeInfo])
exportType Type
ty = [CDerivedDeclarator NodeInfo]
-> Type
-> ([CDeclarationSpecifier NodeInfo],
    [CDerivedDeclarator NodeInfo])
exportTy [] Type
ty
  where
    exportTy :: [CDerivedDeclarator NodeInfo]
-> Type
-> ([CDeclarationSpecifier NodeInfo],
    [CDerivedDeclarator NodeInfo])
exportTy [CDerivedDeclarator NodeInfo]
dd (PtrType Type
ity TypeQuals
tyquals Attributes
attrs) =
        let ptr_declr :: CDerivedDeclarator NodeInfo
ptr_declr = [CTypeQualifier NodeInfo]
-> NodeInfo -> CDerivedDeclarator NodeInfo
forall a. [CTypeQualifier a] -> a -> CDerivedDeclarator a
CPtrDeclr (TypeQuals -> Attributes -> [CTypeQualifier NodeInfo]
exportTypeQualsAttrs TypeQuals
tyquals Attributes
attrs) NodeInfo
ni
        in  [CDerivedDeclarator NodeInfo]
-> Type
-> ([CDeclarationSpecifier NodeInfo],
    [CDerivedDeclarator NodeInfo])
exportTy (CDerivedDeclarator NodeInfo
ptr_declr CDerivedDeclarator NodeInfo
-> [CDerivedDeclarator NodeInfo] -> [CDerivedDeclarator NodeInfo]
forall a. a -> [a] -> [a]
: [CDerivedDeclarator NodeInfo]
dd) Type
ity
    exportTy [CDerivedDeclarator NodeInfo]
dd (ArrayType Type
ity ArraySize
array_sz TypeQuals
tyquals Attributes
attrs) =
        let arr_declr :: CDerivedDeclarator NodeInfo
arr_declr = [CTypeQualifier NodeInfo]
-> CArraySize NodeInfo -> NodeInfo -> CDerivedDeclarator NodeInfo
forall a.
[CTypeQualifier a] -> CArraySize a -> a -> CDerivedDeclarator a
CArrDeclr (TypeQuals -> Attributes -> [CTypeQualifier NodeInfo]
exportTypeQualsAttrs TypeQuals
tyquals Attributes
attrs) (ArraySize -> CArraySize NodeInfo
exportArraySize ArraySize
array_sz) NodeInfo
ni
        in  [CDerivedDeclarator NodeInfo]
-> Type
-> ([CDeclarationSpecifier NodeInfo],
    [CDerivedDeclarator NodeInfo])
exportTy (CDerivedDeclarator NodeInfo
arr_declr CDerivedDeclarator NodeInfo
-> [CDerivedDeclarator NodeInfo] -> [CDerivedDeclarator NodeInfo]
forall a. a -> [a] -> [a]
: [CDerivedDeclarator NodeInfo]
dd) Type
ity
    exportTy [CDerivedDeclarator NodeInfo]
dd (FunctionType (FunType Type
ity [ParamDecl]
params Bool
variadic) Attributes
attrs) =
        let fun_declr :: CDerivedDeclarator NodeInfo
fun_declr = Either [Ident] ([CDeclaration NodeInfo], Bool)
-> [CAttribute NodeInfo] -> NodeInfo -> CDerivedDeclarator NodeInfo
forall a.
Either [Ident] ([CDeclaration a], Bool)
-> [CAttribute a] -> a -> CDerivedDeclarator a
CFunDeclr (([CDeclaration NodeInfo], Bool)
-> Either [Ident] ([CDeclaration NodeInfo], Bool)
forall a b. b -> Either a b
Right ((ParamDecl -> CDeclaration NodeInfo)
-> [ParamDecl] -> [CDeclaration NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map ParamDecl -> CDeclaration NodeInfo
exportParamDecl [ParamDecl]
params,Bool
variadic)) (Attributes -> [CAttribute NodeInfo]
exportAttrs Attributes
attrs) NodeInfo
ni
        in  [CDerivedDeclarator NodeInfo]
-> Type
-> ([CDeclarationSpecifier NodeInfo],
    [CDerivedDeclarator NodeInfo])
exportTy (CDerivedDeclarator NodeInfo
fun_declr CDerivedDeclarator NodeInfo
-> [CDerivedDeclarator NodeInfo] -> [CDerivedDeclarator NodeInfo]
forall a. a -> [a] -> [a]
: [CDerivedDeclarator NodeInfo]
dd) Type
ity
    exportTy [CDerivedDeclarator NodeInfo]
dd (FunctionType (FunTypeIncomplete Type
ity) Attributes
attrs) =
        let fun_declr :: CDerivedDeclarator NodeInfo
fun_declr = Either [Ident] ([CDeclaration NodeInfo], Bool)
-> [CAttribute NodeInfo] -> NodeInfo -> CDerivedDeclarator NodeInfo
forall a.
Either [Ident] ([CDeclaration a], Bool)
-> [CAttribute a] -> a -> CDerivedDeclarator a
CFunDeclr (([CDeclaration NodeInfo], Bool)
-> Either [Ident] ([CDeclaration NodeInfo], Bool)
forall a b. b -> Either a b
Right ([],Bool
False)) (Attributes -> [CAttribute NodeInfo]
exportAttrs Attributes
attrs) NodeInfo
ni
        in  [CDerivedDeclarator NodeInfo]
-> Type
-> ([CDeclarationSpecifier NodeInfo],
    [CDerivedDeclarator NodeInfo])
exportTy (CDerivedDeclarator NodeInfo
fun_declr CDerivedDeclarator NodeInfo
-> [CDerivedDeclarator NodeInfo] -> [CDerivedDeclarator NodeInfo]
forall a. a -> [a] -> [a]
: [CDerivedDeclarator NodeInfo]
dd) Type
ity
    exportTy [CDerivedDeclarator NodeInfo]
dd (TypeDefType (TypeDefRef Ident
ty_ident Type
_ NodeInfo
node) TypeQuals
quals Attributes
attrs) =
        let declspecs :: [CDeclarationSpecifier NodeInfo]
declspecs =   CTypeSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo
forall a. CTypeSpecifier a -> CDeclarationSpecifier a
CTypeSpec (Ident -> NodeInfo -> CTypeSpecifier NodeInfo
forall a. Ident -> a -> CTypeSpecifier a
CTypeDef Ident
ty_ident NodeInfo
node)
                        CDeclarationSpecifier NodeInfo
-> [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall a. a -> [a] -> [a]
: (CTypeQualifier NodeInfo -> CDeclarationSpecifier NodeInfo)
-> [CTypeQualifier NodeInfo] -> [CDeclarationSpecifier NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map CTypeQualifier NodeInfo -> CDeclarationSpecifier NodeInfo
forall a. CTypeQualifier a -> CDeclarationSpecifier a
CTypeQual (TypeQuals -> Attributes -> [CTypeQualifier NodeInfo]
exportTypeQualsAttrs TypeQuals
quals Attributes
attrs)
        in ([CDeclarationSpecifier NodeInfo]
declspecs, [CDerivedDeclarator NodeInfo] -> [CDerivedDeclarator NodeInfo]
forall a. [a] -> [a]
reverse [CDerivedDeclarator NodeInfo]
dd)
    exportTy [CDerivedDeclarator NodeInfo]
dd (DirectType TypeName
ity TypeQuals
quals Attributes
attrs) =
        let declspecs :: [CDeclarationSpecifier NodeInfo]
declspecs =    (CTypeQualifier NodeInfo -> CDeclarationSpecifier NodeInfo)
-> [CTypeQualifier NodeInfo] -> [CDeclarationSpecifier NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map CTypeQualifier NodeInfo -> CDeclarationSpecifier NodeInfo
forall a. CTypeQualifier a -> CDeclarationSpecifier a
CTypeQual (TypeQuals -> Attributes -> [CTypeQualifier NodeInfo]
exportTypeQualsAttrs TypeQuals
quals Attributes
attrs)
                        [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall a. [a] -> [a] -> [a]
++ (CTypeSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo)
-> [CTypeSpecifier NodeInfo] -> [CDeclarationSpecifier NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map CTypeSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo
forall a. CTypeSpecifier a -> CDeclarationSpecifier a
CTypeSpec (TypeName -> [CTypeSpecifier NodeInfo]
exportTypeSpec TypeName
ity)
        in ([CDeclarationSpecifier NodeInfo]
declspecs, [CDerivedDeclarator NodeInfo] -> [CDerivedDeclarator NodeInfo]
forall a. [a] -> [a]
reverse [CDerivedDeclarator NodeInfo]
dd)

exportTypeQuals :: TypeQuals -> [CTypeQual]
exportTypeQuals :: TypeQuals -> [CTypeQualifier NodeInfo]
exportTypeQuals TypeQuals
quals = ((TypeQuals -> Bool, CTypeQualifier NodeInfo)
 -> Maybe (CTypeQualifier NodeInfo))
-> [(TypeQuals -> Bool, CTypeQualifier NodeInfo)]
-> [CTypeQualifier NodeInfo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TypeQuals -> Bool, CTypeQualifier NodeInfo)
-> Maybe (CTypeQualifier NodeInfo)
forall {a}. (TypeQuals -> Bool, a) -> Maybe a
select [(TypeQuals -> Bool
constant,NodeInfo -> CTypeQualifier NodeInfo
forall a. a -> CTypeQualifier a
CConstQual NodeInfo
ni),(TypeQuals -> Bool
volatile,NodeInfo -> CTypeQualifier NodeInfo
forall a. a -> CTypeQualifier a
CVolatQual NodeInfo
ni),(TypeQuals -> Bool
restrict,NodeInfo -> CTypeQualifier NodeInfo
forall a. a -> CTypeQualifier a
CRestrQual NodeInfo
ni)]
    where
    select :: (TypeQuals -> Bool, a) -> Maybe a
select (TypeQuals -> Bool
predicate,a
tyqual) | TypeQuals -> Bool
predicate TypeQuals
quals = a -> Maybe a
forall a. a -> Maybe a
Just a
tyqual
                              | Bool
otherwise       = Maybe a
forall a. Maybe a
Nothing

exportTypeQualsAttrs :: TypeQuals -> Attributes -> [CTypeQual]
exportTypeQualsAttrs :: TypeQuals -> Attributes -> [CTypeQualifier NodeInfo]
exportTypeQualsAttrs TypeQuals
tyqs Attributes
attrs = (TypeQuals -> [CTypeQualifier NodeInfo]
exportTypeQuals TypeQuals
tyqs [CTypeQualifier NodeInfo]
-> [CTypeQualifier NodeInfo] -> [CTypeQualifier NodeInfo]
forall a. [a] -> [a] -> [a]
++ (CAttribute NodeInfo -> CTypeQualifier NodeInfo)
-> [CAttribute NodeInfo] -> [CTypeQualifier NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map CAttribute NodeInfo -> CTypeQualifier NodeInfo
forall a. CAttribute a -> CTypeQualifier a
CAttrQual (Attributes -> [CAttribute NodeInfo]
exportAttrs Attributes
attrs))

exportArraySize :: ArraySize -> CArrSize
exportArraySize :: ArraySize -> CArraySize NodeInfo
exportArraySize (ArraySize Bool
static CExpression NodeInfo
e)        = Bool -> CExpression NodeInfo -> CArraySize NodeInfo
forall a. Bool -> CExpression a -> CArraySize a
CArrSize Bool
static CExpression NodeInfo
e
exportArraySize (UnknownArraySize Bool
complete) = Bool -> CArraySize NodeInfo
forall a. Bool -> CArraySize a
CNoArrSize Bool
complete

exportTypeSpec :: TypeName -> [CTypeSpec]
exportTypeSpec :: TypeName -> [CTypeSpecifier NodeInfo]
exportTypeSpec TypeName
tyname =
    case TypeName
tyname of
        TypeName
TyVoid             -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CVoidType NodeInfo
ni]
        TyIntegral IntType
ity     -> IntType -> [CTypeSpecifier NodeInfo]
exportIntType IntType
ity
        TyFloating FloatType
fty     -> FloatType -> [CTypeSpecifier NodeInfo]
exportFloatType FloatType
fty
        TyComplex FloatType
fty      -> FloatType -> [CTypeSpecifier NodeInfo]
exportComplexType FloatType
fty
        TyComp CompTypeRef
comp        -> CompTypeRef -> [CTypeSpecifier NodeInfo]
exportCompTypeDecl CompTypeRef
comp
        TyEnum EnumTypeRef
enum        -> EnumTypeRef -> [CTypeSpecifier NodeInfo]
exportEnumTypeDecl EnumTypeRef
enum
        TyBuiltin BuiltinType
TyVaList -> [Ident -> NodeInfo -> CTypeSpecifier NodeInfo
forall a. Ident -> a -> CTypeSpecifier a
CTypeDef (String -> Ident
internalIdent String
"va_list") NodeInfo
ni]
        TyBuiltin BuiltinType
TyAny    -> [Ident -> NodeInfo -> CTypeSpecifier NodeInfo
forall a. Ident -> a -> CTypeSpecifier a
CTypeDef (String -> Ident
internalIdent String
"__ty_any") NodeInfo
ni]

exportIntType :: IntType -> [CTypeSpec]
exportIntType :: IntType -> [CTypeSpecifier NodeInfo]
exportIntType IntType
ty =
    case IntType
ty of
      IntType
TyBool    -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CBoolType NodeInfo
ni]
      IntType
TyChar    -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CCharType NodeInfo
ni]
      IntType
TySChar   -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CSignedType NodeInfo
ni,NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CCharType NodeInfo
ni]
      IntType
TyUChar   -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CUnsigType NodeInfo
ni,NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CCharType NodeInfo
ni]
      IntType
TyShort   -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CShortType NodeInfo
ni]
      IntType
TyUShort  -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CUnsigType NodeInfo
ni, NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CShortType NodeInfo
ni]
      IntType
TyInt     -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CIntType NodeInfo
ni]
      IntType
TyUInt    -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CUnsigType NodeInfo
ni, NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CIntType NodeInfo
ni]
      IntType
TyInt128  -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CInt128Type NodeInfo
ni]
      IntType
TyUInt128 -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CUnsigType NodeInfo
ni, NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CInt128Type NodeInfo
ni]
      IntType
TyLong    -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CLongType NodeInfo
ni]
      IntType
TyULong   -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CUnsigType NodeInfo
ni,NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CLongType NodeInfo
ni]
      IntType
TyLLong   -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CLongType NodeInfo
ni, NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CLongType NodeInfo
ni]
      IntType
TyULLong  -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CUnsigType NodeInfo
ni, NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CLongType NodeInfo
ni, NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CLongType NodeInfo
ni]

exportFloatType :: FloatType -> [CTypeSpec]
exportFloatType :: FloatType -> [CTypeSpecifier NodeInfo]
exportFloatType FloatType
ty =
    case FloatType
ty of
      FloatType
TyFloat    -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CFloatType NodeInfo
ni]
      FloatType
TyDouble   -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CDoubleType NodeInfo
ni]
      FloatType
TyLDouble  -> [NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CLongType NodeInfo
ni, NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CDoubleType NodeInfo
ni]
      TyFloatN Int
n Bool
x -> [Int -> Bool -> NodeInfo -> CTypeSpecifier NodeInfo
forall a. Int -> Bool -> a -> CTypeSpecifier a
CFloatNType Int
n Bool
x NodeInfo
ni]

exportComplexType :: FloatType -> [CTypeSpec]
exportComplexType :: FloatType -> [CTypeSpecifier NodeInfo]
exportComplexType FloatType
ty = (NodeInfo -> CTypeSpecifier NodeInfo
forall a. a -> CTypeSpecifier a
CComplexType NodeInfo
ni) CTypeSpecifier NodeInfo
-> [CTypeSpecifier NodeInfo] -> [CTypeSpecifier NodeInfo]
forall a. a -> [a] -> [a]
: FloatType -> [CTypeSpecifier NodeInfo]
exportFloatType FloatType
ty

exportCompTypeDecl :: CompTypeRef -> [CTypeSpec]
exportCompTypeDecl :: CompTypeRef -> [CTypeSpecifier NodeInfo]
exportCompTypeDecl CompTypeRef
ty = [CStructureUnion NodeInfo -> NodeInfo -> CTypeSpecifier NodeInfo
forall a. CStructureUnion a -> a -> CTypeSpecifier a
CSUType (CompTypeRef -> CStructureUnion NodeInfo
exportComp CompTypeRef
ty) NodeInfo
ni]
    where
    exportComp :: CompTypeRef -> CStructureUnion NodeInfo
exportComp (CompTypeRef SUERef
sue_ref CompTyKind
comp_tag NodeInfo
_n) =
        CStructTag
-> Maybe Ident
-> Maybe [CDeclaration NodeInfo]
-> [CAttribute NodeInfo]
-> NodeInfo
-> CStructureUnion NodeInfo
forall a.
CStructTag
-> Maybe Ident
-> Maybe [CDeclaration a]
-> [CAttribute a]
-> a
-> CStructureUnion a
CStruct (if CompTyKind
comp_tag CompTyKind -> CompTyKind -> Bool
forall a. Eq a => a -> a -> Bool
== CompTyKind
StructTag then CStructTag
CStructTag else CStructTag
CUnionTag)
                (SUERef -> Maybe Ident
exportSUERef SUERef
sue_ref) Maybe [CDeclaration NodeInfo]
forall a. Maybe a
Nothing [] NodeInfo
ni

exportEnumTypeDecl :: EnumTypeRef -> [CTypeSpec]
exportEnumTypeDecl :: EnumTypeRef -> [CTypeSpecifier NodeInfo]
exportEnumTypeDecl EnumTypeRef
ty = [CEnumeration NodeInfo -> NodeInfo -> CTypeSpecifier NodeInfo
forall a. CEnumeration a -> a -> CTypeSpecifier a
CEnumType (EnumTypeRef -> CEnumeration NodeInfo
exportEnum EnumTypeRef
ty) NodeInfo
ni]
    where
    exportEnum :: EnumTypeRef -> CEnumeration NodeInfo
exportEnum (EnumTypeRef SUERef
sue_ref NodeInfo
_n) =
        Maybe Ident
-> Maybe [(Ident, Maybe (CExpression NodeInfo))]
-> [CAttribute NodeInfo]
-> NodeInfo
-> CEnumeration NodeInfo
forall a.
Maybe Ident
-> Maybe [(Ident, Maybe (CExpression a))]
-> [CAttribute a]
-> a
-> CEnumeration a
CEnum (SUERef -> Maybe Ident
exportSUERef SUERef
sue_ref) Maybe [(Ident, Maybe (CExpression NodeInfo))]
forall a. Maybe a
Nothing [] NodeInfo
ni

exportCompType :: CompType -> [CTypeSpec]
exportCompType :: CompType -> [CTypeSpecifier NodeInfo]
exportCompType (CompType SUERef
sue_ref CompTyKind
comp_tag [MemberDecl]
members Attributes
attrs NodeInfo
node_info) = [CStructureUnion NodeInfo -> NodeInfo -> CTypeSpecifier NodeInfo
forall a. CStructureUnion a -> a -> CTypeSpecifier a
CSUType CStructureUnion NodeInfo
comp NodeInfo
ni]
    where
    comp :: CStructureUnion NodeInfo
comp = CStructTag
-> Maybe Ident
-> Maybe [CDeclaration NodeInfo]
-> [CAttribute NodeInfo]
-> NodeInfo
-> CStructureUnion NodeInfo
forall a.
CStructTag
-> Maybe Ident
-> Maybe [CDeclaration a]
-> [CAttribute a]
-> a
-> CStructureUnion a
CStruct (if CompTyKind
comp_tag CompTyKind -> CompTyKind -> Bool
forall a. Eq a => a -> a -> Bool
== CompTyKind
StructTag then CStructTag
CStructTag else CStructTag
CUnionTag)
                   (SUERef -> Maybe Ident
exportSUERef SUERef
sue_ref)
                   ([CDeclaration NodeInfo] -> Maybe [CDeclaration NodeInfo]
forall a. a -> Maybe a
Just ((MemberDecl -> CDeclaration NodeInfo)
-> [MemberDecl] -> [CDeclaration NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map MemberDecl -> CDeclaration NodeInfo
exportMemberDecl [MemberDecl]
members))
                   (Attributes -> [CAttribute NodeInfo]
exportAttrs Attributes
attrs)
                   NodeInfo
node_info
exportCompTypeRef :: CompType -> [CTypeSpec]
exportCompTypeRef :: CompType -> [CTypeSpecifier NodeInfo]
exportCompTypeRef (CompType SUERef
sue_ref CompTyKind
com_tag  [MemberDecl]
_ Attributes
_ NodeInfo
node_info) = CompTypeRef -> [CTypeSpecifier NodeInfo]
exportCompTypeDecl (SUERef -> CompTyKind -> NodeInfo -> CompTypeRef
CompTypeRef SUERef
sue_ref CompTyKind
com_tag NodeInfo
node_info)

exportEnumType :: EnumType -> [CTypeSpec]
exportEnumType :: EnumType -> [CTypeSpecifier NodeInfo]
exportEnumType (EnumType SUERef
sue_ref [Enumerator]
enumerators Attributes
attrs NodeInfo
node_info) = [CEnumeration NodeInfo -> NodeInfo -> CTypeSpecifier NodeInfo
forall a. CEnumeration a -> a -> CTypeSpecifier a
CEnumType CEnumeration NodeInfo
enum NodeInfo
ni]
    where
    enum :: CEnumeration NodeInfo
enum = Maybe Ident
-> Maybe [(Ident, Maybe (CExpression NodeInfo))]
-> [CAttribute NodeInfo]
-> NodeInfo
-> CEnumeration NodeInfo
forall a.
Maybe Ident
-> Maybe [(Ident, Maybe (CExpression a))]
-> [CAttribute a]
-> a
-> CEnumeration a
CEnum (SUERef -> Maybe Ident
exportSUERef SUERef
sue_ref)
                 ([(Ident, Maybe (CExpression NodeInfo))]
-> Maybe [(Ident, Maybe (CExpression NodeInfo))]
forall a. a -> Maybe a
Just ((Enumerator -> (Ident, Maybe (CExpression NodeInfo)))
-> [Enumerator] -> [(Ident, Maybe (CExpression NodeInfo))]
forall a b. (a -> b) -> [a] -> [b]
map Enumerator -> (Ident, Maybe (CExpression NodeInfo))
exportEnumerator [Enumerator]
enumerators))
                 (Attributes -> [CAttribute NodeInfo]
exportAttrs Attributes
attrs)
                 NodeInfo
node_info
    exportEnumerator :: Enumerator -> (Ident, Maybe (CExpression NodeInfo))
exportEnumerator (Enumerator Ident
ident CExpression NodeInfo
val EnumType
_ty NodeInfo
_) = (Ident
ident,CExpression NodeInfo -> Maybe (CExpression NodeInfo)
forall a. a -> Maybe a
Just CExpression NodeInfo
val)

exportEnumTypeRef :: EnumType -> [CTypeSpec]
exportEnumTypeRef :: EnumType -> [CTypeSpecifier NodeInfo]
exportEnumTypeRef (EnumType SUERef
sue_ref [Enumerator]
_ Attributes
_ NodeInfo
node_info) = EnumTypeRef -> [CTypeSpecifier NodeInfo]
exportEnumTypeDecl (SUERef -> NodeInfo -> EnumTypeRef
EnumTypeRef SUERef
sue_ref NodeInfo
node_info)

-- XXX: relies on a the source program not having any $'s in it
exportSUERef :: SUERef -> Maybe Ident
exportSUERef :: SUERef -> Maybe Ident
exportSUERef (AnonymousRef Name
name) = Ident -> Maybe Ident
forall a. a -> Maybe a
Just (String -> Ident
internalIdent (String -> Ident) -> String -> Ident
forall a b. (a -> b) -> a -> b
$ String
"$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Name -> Int
nameId Name
name))
exportSUERef (NamedRef Ident
ident) = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
ident

exportMemberDecl :: MemberDecl -> CDecl
exportMemberDecl :: MemberDecl -> CDeclaration NodeInfo
exportMemberDecl (AnonBitField Type
ty CExpression NodeInfo
expr NodeInfo
node_info) =
    [CDeclarationSpecifier NodeInfo]
-> [(Maybe (CDeclarator NodeInfo), Maybe Initializer,
     Maybe (CExpression NodeInfo))]
-> NodeInfo
-> CDeclaration NodeInfo
forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl ((CTypeSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo)
-> [CTypeSpecifier NodeInfo] -> [CDeclarationSpecifier NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map CTypeSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo
forall a. CTypeSpecifier a -> CDeclarationSpecifier a
CTypeSpec ([CTypeSpecifier NodeInfo] -> [CDeclarationSpecifier NodeInfo])
-> [CTypeSpecifier NodeInfo] -> [CDeclarationSpecifier NodeInfo]
forall a b. (a -> b) -> a -> b
$ TypeName -> [CTypeSpecifier NodeInfo]
exportTypeSpec (TypeName -> [CTypeSpecifier NodeInfo])
-> TypeName -> [CTypeSpecifier NodeInfo]
forall a b. (a -> b) -> a -> b
$ Type -> TypeName
fromDirectType Type
ty) [(Maybe (CDeclarator NodeInfo)
forall a. Maybe a
Nothing,Maybe Initializer
forall a. Maybe a
Nothing,CExpression NodeInfo -> Maybe (CExpression NodeInfo)
forall a. a -> Maybe a
Just CExpression NodeInfo
expr)] NodeInfo
node_info
exportMemberDecl (MemberDecl VarDecl
vardecl Maybe (CExpression NodeInfo)
bitfieldsz NodeInfo
node_info) =
    let ([CDeclarationSpecifier NodeInfo]
specs,CDeclarator NodeInfo
declarator) = VarDecl -> ([CDeclarationSpecifier NodeInfo], CDeclarator NodeInfo)
exportVarDecl VarDecl
vardecl
    in  [CDeclarationSpecifier NodeInfo]
-> [(Maybe (CDeclarator NodeInfo), Maybe Initializer,
     Maybe (CExpression NodeInfo))]
-> NodeInfo
-> CDeclaration NodeInfo
forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl [CDeclarationSpecifier NodeInfo]
specs [(CDeclarator NodeInfo -> Maybe (CDeclarator NodeInfo)
forall a. a -> Maybe a
Just CDeclarator NodeInfo
declarator, Maybe Initializer
forall a. Maybe a
Nothing, Maybe (CExpression NodeInfo)
bitfieldsz)] NodeInfo
node_info
exportVarDecl :: VarDecl -> ([CDeclSpec],CDeclr)

-- NOTE: that there is an ambiguity between two possible places for __attributes__ s here
exportVarDecl :: VarDecl -> ([CDeclarationSpecifier NodeInfo], CDeclarator NodeInfo)
exportVarDecl (VarDecl VarName
name DeclAttrs
attrs Type
ty) = [CDeclarationSpecifier NodeInfo]
-> Type
-> Attributes
-> VarName
-> ([CDeclarationSpecifier NodeInfo], CDeclarator NodeInfo)
exportDeclr (DeclAttrs -> [CDeclarationSpecifier NodeInfo]
exportDeclAttrs DeclAttrs
attrs) Type
ty [] VarName
name
exportParamDecl :: ParamDecl -> CDecl
exportParamDecl :: ParamDecl -> CDeclaration NodeInfo
exportParamDecl ParamDecl
paramdecl =
    let ([CDeclarationSpecifier NodeInfo]
specs,CDeclarator NodeInfo
declr) = VarDecl -> ([CDeclarationSpecifier NodeInfo], CDeclarator NodeInfo)
exportVarDecl (ParamDecl -> VarDecl
forall n. Declaration n => n -> VarDecl
getVarDecl ParamDecl
paramdecl)
    in [CDeclarationSpecifier NodeInfo]
-> [(Maybe (CDeclarator NodeInfo), Maybe Initializer,
     Maybe (CExpression NodeInfo))]
-> NodeInfo
-> CDeclaration NodeInfo
forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl [CDeclarationSpecifier NodeInfo]
specs [(CDeclarator NodeInfo -> Maybe (CDeclarator NodeInfo)
forall a. a -> Maybe a
Just CDeclarator NodeInfo
declr, Maybe Initializer
forall a. Maybe a
Nothing , Maybe (CExpression NodeInfo)
forall a. Maybe a
Nothing) ] (ParamDecl -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo ParamDecl
paramdecl)

exportDeclAttrs :: DeclAttrs -> [CDeclSpec]
exportDeclAttrs :: DeclAttrs -> [CDeclarationSpecifier NodeInfo]
exportDeclAttrs (DeclAttrs FunctionAttrs
fun_attrs Storage
storage Attributes
attrs) =
       (CFunctionSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo)
-> [CFunctionSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map CFunctionSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo
forall a. CFunctionSpecifier a -> CDeclarationSpecifier a
CFunSpec (FunctionAttrs -> [CFunctionSpecifier NodeInfo]
exportFunAttrs FunctionAttrs
fun_attrs)
    [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall a. [a] -> [a] -> [a]
++ (CStorageSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo)
-> [CStorageSpecifier NodeInfo] -> [CDeclarationSpecifier NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map CStorageSpecifier NodeInfo -> CDeclarationSpecifier NodeInfo
forall a. CStorageSpecifier a -> CDeclarationSpecifier a
CStorageSpec (Storage -> [CStorageSpecifier NodeInfo]
exportStorage Storage
storage)
    [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
-> [CDeclarationSpecifier NodeInfo]
forall a. [a] -> [a] -> [a]
++ (CAttribute NodeInfo -> CDeclarationSpecifier NodeInfo)
-> [CAttribute NodeInfo] -> [CDeclarationSpecifier NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map (CTypeQualifier NodeInfo -> CDeclarationSpecifier NodeInfo
forall a. CTypeQualifier a -> CDeclarationSpecifier a
CTypeQual (CTypeQualifier NodeInfo -> CDeclarationSpecifier NodeInfo)
-> (CAttribute NodeInfo -> CTypeQualifier NodeInfo)
-> CAttribute NodeInfo
-> CDeclarationSpecifier NodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CAttribute NodeInfo -> CTypeQualifier NodeInfo
forall a. CAttribute a -> CTypeQualifier a
CAttrQual) (Attributes -> [CAttribute NodeInfo]
exportAttrs Attributes
attrs)

-- | export function attributes to C function specifiers
exportFunAttrs :: FunctionAttrs -> [CFunSpec]
exportFunAttrs :: FunctionAttrs -> [CFunctionSpecifier NodeInfo]
exportFunAttrs FunctionAttrs
fattrs = [Maybe (CFunctionSpecifier NodeInfo)]
-> [CFunctionSpecifier NodeInfo]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (CFunctionSpecifier NodeInfo)
inlQual, Maybe (CFunctionSpecifier NodeInfo)
noretQual]
  where
    inlQual :: Maybe (CFunctionSpecifier NodeInfo)
inlQual = if FunctionAttrs -> Bool
isInline FunctionAttrs
fattrs then CFunctionSpecifier NodeInfo -> Maybe (CFunctionSpecifier NodeInfo)
forall a. a -> Maybe a
Just (NodeInfo -> CFunctionSpecifier NodeInfo
forall a. a -> CFunctionSpecifier a
CInlineQual NodeInfo
ni) else Maybe (CFunctionSpecifier NodeInfo)
forall a. Maybe a
Nothing
    noretQual :: Maybe (CFunctionSpecifier NodeInfo)
noretQual = if FunctionAttrs -> Bool
isNoreturn FunctionAttrs
fattrs then CFunctionSpecifier NodeInfo -> Maybe (CFunctionSpecifier NodeInfo)
forall a. a -> Maybe a
Just (NodeInfo -> CFunctionSpecifier NodeInfo
forall a. a -> CFunctionSpecifier a
CNoreturnQual NodeInfo
ni) else Maybe (CFunctionSpecifier NodeInfo)
forall a. Maybe a
Nothing

-- | express storage in terms of storage specifiers.
--
-- This isn't always possible and depends on the context the identifier is declared.
-- Most importantly, if there is a /conflicting/ declaration in scope, export is impossible.
-- Furthermore, automatic storage is impossible in file scope.
-- If the storage can actually be specified, the export is correct.
exportStorage :: Storage -> [CStorageSpec]
exportStorage :: Storage -> [CStorageSpecifier NodeInfo]
exportStorage Storage
NoStorage = []
exportStorage (Auto Bool
reg) = if Bool
reg then [NodeInfo -> CStorageSpecifier NodeInfo
forall a. a -> CStorageSpecifier a
CRegister NodeInfo
ni] else []
exportStorage (Static Linkage
InternalLinkage Bool
thread_local) = Bool
-> [CStorageSpecifier NodeInfo] -> [CStorageSpecifier NodeInfo]
threadLocal Bool
thread_local [NodeInfo -> CStorageSpecifier NodeInfo
forall a. a -> CStorageSpecifier a
CStatic NodeInfo
ni]
exportStorage (Static Linkage
ExternalLinkage Bool
thread_local) = Bool
-> [CStorageSpecifier NodeInfo] -> [CStorageSpecifier NodeInfo]
threadLocal Bool
thread_local [NodeInfo -> CStorageSpecifier NodeInfo
forall a. a -> CStorageSpecifier a
CExtern NodeInfo
ni]
exportStorage (Static Linkage
NoLinkage Bool
_) = String -> [CStorageSpecifier NodeInfo]
forall a. HasCallStack => String -> a
error String
"impossible storage: static without linkage"
exportStorage (FunLinkage Linkage
InternalLinkage) = [NodeInfo -> CStorageSpecifier NodeInfo
forall a. a -> CStorageSpecifier a
CStatic NodeInfo
ni]
exportStorage (FunLinkage Linkage
ExternalLinkage) = []
exportStorage (FunLinkage Linkage
NoLinkage) = String -> [CStorageSpecifier NodeInfo]
forall a. HasCallStack => String -> a
error String
"impossible storage: function without linkage"

threadLocal :: Bool -> [CStorageSpec] -> [CStorageSpec]
threadLocal :: Bool
-> [CStorageSpecifier NodeInfo] -> [CStorageSpecifier NodeInfo]
threadLocal Bool
False = [CStorageSpecifier NodeInfo] -> [CStorageSpecifier NodeInfo]
forall a. a -> a
id
threadLocal Bool
True  = ((NodeInfo -> CStorageSpecifier NodeInfo
forall a. a -> CStorageSpecifier a
CThread NodeInfo
ni) CStorageSpecifier NodeInfo
-> [CStorageSpecifier NodeInfo] -> [CStorageSpecifier NodeInfo]
forall a. a -> [a] -> [a]
:)

exportAttrs :: [Attr] -> [CAttr]
exportAttrs :: Attributes -> [CAttribute NodeInfo]
exportAttrs = (Attr -> CAttribute NodeInfo)
-> Attributes -> [CAttribute NodeInfo]
forall a b. (a -> b) -> [a] -> [b]
map Attr -> CAttribute NodeInfo
exportAttr where
    exportAttr :: Attr -> CAttribute NodeInfo
exportAttr (Attr Ident
ident [CExpression NodeInfo]
es NodeInfo
n) = Ident -> [CExpression NodeInfo] -> NodeInfo -> CAttribute NodeInfo
forall a. Ident -> [CExpression a] -> a -> CAttribute a
CAttr Ident
ident [CExpression NodeInfo]
es NodeInfo
n

fromDirectType :: Type -> TypeName
fromDirectType :: Type -> TypeName
fromDirectType (DirectType TypeName
ty TypeQuals
_ Attributes
_)                   = TypeName
ty
fromDirectType (TypeDefType (TypeDefRef Ident
_ Type
ty NodeInfo
_) TypeQuals
_ Attributes
_) = Type -> TypeName
fromDirectType Type
ty
fromDirectType Type
_                                     = String -> TypeName
forall a. HasCallStack => String -> a
error String
"fromDirectType"

ni :: NodeInfo
ni :: NodeInfo
ni = NodeInfo
undefNode