-----------------------------------------------------------------------------
-- |
-- 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) = forall a. [CExternalDeclaration a] -> a -> CTranslationUnit a
CTranslUnit ([CExternalDeclaration NodeInfo]
declarations forall a. [a] -> [a] -> [a]
++ []) NodeInfo
undefNode
  where declarations :: [CExternalDeclaration NodeInfo]
declarations = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ident, IdentDecl) -> CExternalDeclaration NodeInfo
exportIdentDecl (forall {b}. [(Ident, b)] -> [(Ident, b)]
filterBuiltins forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map Ident IdentDecl
objs)
        filterBuiltins :: [(Ident, b)] -> [(Ident, b)]
filterBuiltins = forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter 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" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
n) Bool -> Bool -> Bool
&&
                                  (String
n forall a. Eq a => a -> a -> Bool
/= String
"__FUNCTION__") Bool -> Bool -> Bool
&&
                                  (String
n forall a. Eq a => a -> a -> Bool
/= String
"__PRETTY_FUNCTION__") Bool -> Bool -> Bool
&&
                                  (String
n forall a. Eq a => a -> a -> Bool
/= String
"__func__" )


exportIdentDecl :: (Ident, IdentDecl) -> CExternalDeclaration NodeInfo
exportIdentDecl :: (Ident, IdentDecl) -> CExternalDeclaration NodeInfo
exportIdentDecl (Ident
_, Declaration Decl
decl)   = forall a. CDeclaration a -> CExternalDeclaration a
CDeclExt forall a b. (a -> b) -> a -> b
$ Decl -> CDeclaration NodeInfo
exportDeclaration Decl
decl
exportIdentDecl (Ident
_, FunctionDef FunDef
fundef) = forall a. CFunctionDef a -> CExternalDeclaration a
CFDefExt forall a b. (a -> b) -> a -> b
$ FunDef -> CFunctionDef NodeInfo
exportFunDef FunDef
fundef
exportIdentDecl (Ident
_, ObjectDef ObjDef
objdef)   = forall a. CDeclaration a -> CExternalDeclaration a
CDeclExt forall a b. (a -> b) -> a -> b
$ ObjDef -> CDeclaration NodeInfo
exportObject ObjDef
objdef
exportIdentDecl (Ident
_, EnumeratorDef Enumerator
_)    = 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) = forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl [CDeclSpec]
specs' [(forall a. a -> Maybe a
Just CDeclarator NodeInfo
decl, Maybe Initializer
mInit, forall a. Maybe a
Nothing)] NodeInfo
nInf
  where
    (DeclAttrs FunctionAttrs
_ Storage
_ Attributes
attrs) = forall n. Declaration n => n -> DeclAttrs
declAttrs ObjDef
d
    specs :: [CDeclSpec]
specs                 = DeclAttrs -> [CDeclSpec]
exportDeclarationSpecifiers (forall n. Declaration n => n -> DeclAttrs
declAttrs ObjDef
d)
    ([CDeclSpec]
specs', CDeclarator NodeInfo
decl)        = [CDeclSpec]
-> Type
-> Attributes
-> VarName
-> ([CDeclSpec], CDeclarator NodeInfo)
exportDeclr [CDeclSpec]
specs (forall n. Declaration n => n -> Type
declType ObjDef
d) Attributes
attrs (forall n. Declaration n => n -> VarName
declName ObjDef
d)


exportDeclaration :: Decl -> CDeclaration NodeInfo
exportDeclaration :: Decl -> CDeclaration NodeInfo
exportDeclaration Decl
d = forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl [CDeclSpec]
specs' [(forall a. a -> Maybe a
Just CDeclarator NodeInfo
decl, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)] NodeInfo
undefNode
  where
    (DeclAttrs FunctionAttrs
_ Storage
_ Attributes
attrs) = forall n. Declaration n => n -> DeclAttrs
declAttrs Decl
d
    specs :: [CDeclSpec]
specs                 = DeclAttrs -> [CDeclSpec]
exportDeclarationSpecifiers (forall n. Declaration n => n -> DeclAttrs
declAttrs Decl
d)
    ([CDeclSpec]
specs', CDeclarator NodeInfo
decl)        = [CDeclSpec]
-> Type
-> Attributes
-> VarName
-> ([CDeclSpec], CDeclarator NodeInfo)
exportDeclr [CDeclSpec]
specs (forall n. Declaration n => n -> Type
declType Decl
d) Attributes
attrs (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
_) = forall a.
[CDeclarationSpecifier a]
-> CDeclarator a
-> [CDeclaration a]
-> CStatement a
-> a
-> CFunctionDef a
CFunDef [CDeclSpec]
cDeclSpecs CDeclarator NodeInfo
cDecl [CDeclaration NodeInfo]
oldStyleParams Stmt
stmt NodeInfo
undefNode
  where
    ([CDeclSpec]
cDeclSpecs, CDeclarator NodeInfo
cDecl) = [CDeclSpec]
-> Type
-> Attributes
-> VarName
-> ([CDeclSpec], CDeclarator NodeInfo)
exportDeclr [CDeclSpec]
specs (forall n. Declaration n => n -> Type
declType FunDef
d) ([] :: Attributes) (forall n. Declaration n => n -> VarName
declName FunDef
d)
    oldStyleParams :: [CDeclaration NodeInfo]
oldStyleParams= [] :: [CDeclaration NodeInfo] -- TODO:?
    specs :: [CDeclSpec]
specs = DeclAttrs -> [CDeclSpec]
exportDeclarationSpecifiers (forall n. Declaration n => n -> DeclAttrs
declAttrs FunDef
d):: [CDeclarationSpecifier NodeInfo]

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


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

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

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

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

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

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

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

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

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

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

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

exportCompTypeDecl :: CompTypeRef -> [CTypeSpec]
exportCompTypeDecl :: CompTypeRef -> [CTypeSpec]
exportCompTypeDecl CompTypeRef
ty = [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) =
        forall a.
CStructTag
-> Maybe Ident
-> Maybe [CDeclaration a]
-> [CAttribute a]
-> a
-> CStructureUnion a
CStruct (if CompTyKind
comp_tag forall a. Eq a => a -> a -> Bool
== CompTyKind
StructTag then CStructTag
CStructTag else CStructTag
CUnionTag)
                (SUERef -> Maybe Ident
exportSUERef SUERef
sue_ref) forall a. Maybe a
Nothing [] NodeInfo
ni

exportEnumTypeDecl :: EnumTypeRef -> [CTypeSpec]
exportEnumTypeDecl :: EnumTypeRef -> [CTypeSpec]
exportEnumTypeDecl EnumTypeRef
ty = [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) =
        forall a.
Maybe Ident
-> Maybe [(Ident, Maybe (CExpression a))]
-> [CAttribute a]
-> a
-> CEnumeration a
CEnum (SUERef -> Maybe Ident
exportSUERef SUERef
sue_ref) forall a. Maybe a
Nothing [] NodeInfo
ni

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

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

exportEnumTypeRef :: EnumType -> [CTypeSpec]
exportEnumTypeRef :: EnumType -> [CTypeSpec]
exportEnumTypeRef (EnumType SUERef
sue_ref [Enumerator]
_ Attributes
_ NodeInfo
node_info) = EnumTypeRef -> [CTypeSpec]
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) = forall a. a -> Maybe a
Just (String -> Ident
internalIdent forall a b. (a -> b) -> a -> b
$ String
"$" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Name -> Int
nameId Name
name))
exportSUERef (NamedRef Ident
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) =
    forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl (forall a b. (a -> b) -> [a] -> [b]
map forall a. CTypeSpecifier a -> CDeclarationSpecifier a
CTypeSpec forall a b. (a -> b) -> a -> b
$ TypeName -> [CTypeSpec]
exportTypeSpec forall a b. (a -> b) -> a -> b
$ Type -> TypeName
fromDirectType Type
ty) [(forall a. Maybe a
Nothing,forall a. Maybe a
Nothing,forall a. a -> Maybe a
Just CExpression NodeInfo
expr)] NodeInfo
node_info
exportMemberDecl (MemberDecl VarDecl
vardecl Maybe (CExpression NodeInfo)
bitfieldsz NodeInfo
node_info) =
    let ([CDeclSpec]
specs,CDeclarator NodeInfo
declarator) = VarDecl -> ([CDeclSpec], CDeclarator NodeInfo)
exportVarDecl VarDecl
vardecl
    in  forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl [CDeclSpec]
specs [(forall a. a -> Maybe a
Just CDeclarator NodeInfo
declarator, 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 -> ([CDeclSpec], CDeclarator NodeInfo)
exportVarDecl (VarDecl VarName
name DeclAttrs
attrs Type
ty) = [CDeclSpec]
-> Type
-> Attributes
-> VarName
-> ([CDeclSpec], CDeclarator NodeInfo)
exportDeclr (DeclAttrs -> [CDeclSpec]
exportDeclAttrs DeclAttrs
attrs) Type
ty [] VarName
name
exportParamDecl :: ParamDecl -> CDecl
exportParamDecl :: ParamDecl -> CDeclaration NodeInfo
exportParamDecl ParamDecl
paramdecl =
    let ([CDeclSpec]
specs,CDeclarator NodeInfo
declr) = VarDecl -> ([CDeclSpec], CDeclarator NodeInfo)
exportVarDecl (forall n. Declaration n => n -> VarDecl
getVarDecl ParamDecl
paramdecl)
    in forall a.
[CDeclarationSpecifier a]
-> [(Maybe (CDeclarator a), Maybe (CInitializer a),
     Maybe (CExpression a))]
-> a
-> CDeclaration a
CDecl [CDeclSpec]
specs [(forall a. a -> Maybe a
Just CDeclarator NodeInfo
declr, forall a. Maybe a
Nothing , forall a. Maybe a
Nothing) ] (forall a. CNode a => a -> NodeInfo
nodeInfo ParamDecl
paramdecl)

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

-- | export function attributes to C function specifiers
exportFunAttrs :: FunctionAttrs -> [CFunSpec]
exportFunAttrs :: FunctionAttrs -> [CFunSpec]
exportFunAttrs FunctionAttrs
fattrs = forall a. [Maybe a] -> [a]
catMaybes [Maybe CFunSpec
inlQual, Maybe CFunSpec
noretQual]
  where
    inlQual :: Maybe CFunSpec
inlQual = if FunctionAttrs -> Bool
isInline FunctionAttrs
fattrs then forall a. a -> Maybe a
Just (forall a. a -> CFunctionSpecifier a
CInlineQual NodeInfo
ni) else forall a. Maybe a
Nothing
    noretQual :: Maybe CFunSpec
noretQual = if FunctionAttrs -> Bool
isNoreturn FunctionAttrs
fattrs then forall a. a -> Maybe a
Just (forall a. a -> CFunctionSpecifier a
CNoreturnQual NodeInfo
ni) else 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 -> [CStorageSpec]
exportStorage Storage
NoStorage = []
exportStorage (Auto Bool
reg) = if Bool
reg then [forall a. a -> CStorageSpecifier a
CRegister NodeInfo
ni] else []
exportStorage (Static Linkage
InternalLinkage Bool
thread_local) = Bool -> [CStorageSpec] -> [CStorageSpec]
threadLocal Bool
thread_local [forall a. a -> CStorageSpecifier a
CStatic NodeInfo
ni]
exportStorage (Static Linkage
ExternalLinkage Bool
thread_local) = Bool -> [CStorageSpec] -> [CStorageSpec]
threadLocal Bool
thread_local [forall a. a -> CStorageSpecifier a
CExtern NodeInfo
ni]
exportStorage (Static Linkage
NoLinkage Bool
_) = forall a. HasCallStack => String -> a
error String
"impossible storage: static without linkage"
exportStorage (FunLinkage Linkage
InternalLinkage) = [forall a. a -> CStorageSpecifier a
CStatic NodeInfo
ni]
exportStorage (FunLinkage Linkage
ExternalLinkage) = []
exportStorage (FunLinkage Linkage
NoLinkage) = forall a. HasCallStack => String -> a
error String
"impossible storage: function without linkage"

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

exportAttrs :: [Attr] -> [CAttr]
exportAttrs :: Attributes -> [CAttr]
exportAttrs = forall a b. (a -> b) -> [a] -> [b]
map Attr -> CAttr
exportAttr where
    exportAttr :: Attr -> CAttr
exportAttr (Attr Ident
ident [CExpression NodeInfo]
es NodeInfo
n) = 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
_                                     = forall a. HasCallStack => String -> a
error String
"fromDirectType"

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