{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}

module FFICXX.Runtime.CodeGen.Cxx where

import Data.Functor.Identity (Identity)
import Data.Hashable  ( Hashable )
import Data.List      ( intercalate )
import Data.Semigroup ( (<>) )
import Data.String    ( IsString(..) )


newtype HeaderName =
  HdrName { HeaderName -> String
unHdrName :: String }
  deriving (Eq HeaderName
Eq HeaderName
-> (Int -> HeaderName -> Int)
-> (HeaderName -> Int)
-> Hashable HeaderName
Int -> HeaderName -> Int
HeaderName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: HeaderName -> Int
$chash :: HeaderName -> Int
hashWithSalt :: Int -> HeaderName -> Int
$chashWithSalt :: Int -> HeaderName -> Int
$cp1Hashable :: Eq HeaderName
Hashable, Int -> HeaderName -> ShowS
[HeaderName] -> ShowS
HeaderName -> String
(Int -> HeaderName -> ShowS)
-> (HeaderName -> String)
-> ([HeaderName] -> ShowS)
-> Show HeaderName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderName] -> ShowS
$cshowList :: [HeaderName] -> ShowS
show :: HeaderName -> String
$cshow :: HeaderName -> String
showsPrec :: Int -> HeaderName -> ShowS
$cshowsPrec :: Int -> HeaderName -> ShowS
Show, HeaderName -> HeaderName -> Bool
(HeaderName -> HeaderName -> Bool)
-> (HeaderName -> HeaderName -> Bool) -> Eq HeaderName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderName -> HeaderName -> Bool
$c/= :: HeaderName -> HeaderName -> Bool
== :: HeaderName -> HeaderName -> Bool
$c== :: HeaderName -> HeaderName -> Bool
Eq, Eq HeaderName
Eq HeaderName
-> (HeaderName -> HeaderName -> Ordering)
-> (HeaderName -> HeaderName -> Bool)
-> (HeaderName -> HeaderName -> Bool)
-> (HeaderName -> HeaderName -> Bool)
-> (HeaderName -> HeaderName -> Bool)
-> (HeaderName -> HeaderName -> HeaderName)
-> (HeaderName -> HeaderName -> HeaderName)
-> Ord HeaderName
HeaderName -> HeaderName -> Bool
HeaderName -> HeaderName -> Ordering
HeaderName -> HeaderName -> HeaderName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HeaderName -> HeaderName -> HeaderName
$cmin :: HeaderName -> HeaderName -> HeaderName
max :: HeaderName -> HeaderName -> HeaderName
$cmax :: HeaderName -> HeaderName -> HeaderName
>= :: HeaderName -> HeaderName -> Bool
$c>= :: HeaderName -> HeaderName -> Bool
> :: HeaderName -> HeaderName -> Bool
$c> :: HeaderName -> HeaderName -> Bool
<= :: HeaderName -> HeaderName -> Bool
$c<= :: HeaderName -> HeaderName -> Bool
< :: HeaderName -> HeaderName -> Bool
$c< :: HeaderName -> HeaderName -> Bool
compare :: HeaderName -> HeaderName -> Ordering
$ccompare :: HeaderName -> HeaderName -> Ordering
$cp1Ord :: Eq HeaderName
Ord)


instance IsString HeaderName where
  fromString :: String -> HeaderName
fromString = String -> HeaderName
HdrName

newtype Namespace =
  NS { Namespace -> String
unNamespace :: String }
  deriving (Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Namespace] -> ShowS
$cshowList :: [Namespace] -> ShowS
show :: Namespace -> String
$cshow :: Namespace -> String
showsPrec :: Int -> Namespace -> ShowS
$cshowsPrec :: Int -> Namespace -> ShowS
Show,Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c== :: Namespace -> Namespace -> Bool
Eq,Eq Namespace
Eq Namespace
-> (Namespace -> Namespace -> Ordering)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Namespace)
-> (Namespace -> Namespace -> Namespace)
-> Ord Namespace
Namespace -> Namespace -> Bool
Namespace -> Namespace -> Ordering
Namespace -> Namespace -> Namespace
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmax :: Namespace -> Namespace -> Namespace
>= :: Namespace -> Namespace -> Bool
$c>= :: Namespace -> Namespace -> Bool
> :: Namespace -> Namespace -> Bool
$c> :: Namespace -> Namespace -> Bool
<= :: Namespace -> Namespace -> Bool
$c<= :: Namespace -> Namespace -> Bool
< :: Namespace -> Namespace -> Bool
$c< :: Namespace -> Namespace -> Bool
compare :: Namespace -> Namespace -> Ordering
$ccompare :: Namespace -> Namespace -> Ordering
$cp1Ord :: Eq Namespace
Ord)

instance IsString Namespace where
  fromString :: String -> Namespace
fromString = String -> Namespace
NS

data PragmaParam = Once

-- | parts for interpolation
newtype NamePart (f :: * -> *) = NamePart String

newtype CName (f :: * -> *) = CName [NamePart f]

sname :: String -> CName Identity
sname :: String -> CName Identity
sname String
s = [NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
CName [String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
NamePart String
s]

renderCName :: CName Identity -> String
renderCName :: CName Identity -> String
renderCName (CName [NamePart Identity]
ps) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"##" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (NamePart Identity -> String) -> [NamePart Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(NamePart String
p) -> String
p) [NamePart Identity]
ps

-- | Types
data CType (f :: * -> *) =
    CTVoid
  | CTSimple (CName f)
  | CTStar (CType f)
  | CTAuto
  | CTTApp        -- template type T<t1,t2,..>
      (CName f)   -- ^ template type name
      [ CType f ] -- ^ template parameters
  | CTConst (CType f)
  | CTScoped (CType f) (CType f) -- some_class::inner_class
                                 -- TODO: refine this by restriction
  | CTVerbatim String

-- | Operators
data COp = CArrow | CAssign

renderCOp :: COp -> String
renderCOp :: COp -> String
renderCOp COp
CArrow  = String
"->"
renderCOp COp
CAssign = String
"="

data CExp (f :: * -> *) =
    CVar  (CName f)                     -- ^ variable
  | CApp  (CExp  f) [CExp f]            -- ^ C function app:  f(a1,a2,..)
  | CTApp (CName f) [CType f] [CExp f]  -- ^ template app  :  f<T1,T2,..>(a1,a2,..)
  | CBinOp COp (CExp f) (CExp f)        -- ^ binary operator: x `op` y
  | CCast (CType f) (CExp f)            -- ^ (type)exp
  | CAddr (CExp f)                      -- ^ &(exp)
  | CStar (CExp f)                      -- ^ *(exp)
  | CNew (CName f)  [CExp f]            -- ^ new operator: new Cstr(a1,a2,...)
  | CTNew (CName f) [CType f] [CExp f]  -- ^ new operator for template class: new Cstr<T1,T2,..>(a1,a2,..)
  | CTNewI (CName f) (CName f) [CType f] [CExp f] -- ^ new operator for inner class of template class: new Cstr<T1,T2,..>::inner(a1,a2,..) -- TODO: make a generalization
  | CEMacroApp (CName f) [CName f]      -- ^ macro function at expression level
  | CEVerbatim String                   -- ^ verbatim
  | CNull                               -- ^ empty C expression. (for convenience)

data CFunDecl (f :: * -> *) =
  CFunDecl (CType f) (CName f) [(CType f,CName f)] -- ^ type func( type1 arg1, type2 arg2, ... )

data CVarDecl (f :: * -> *) =
  CVarDecl
    (CType f)  -- ^ type
    (CName f)  -- ^ variable name

data CQual = Inline

data CStatement (f :: * -> *) =
    UsingNamespace Namespace                -- ^ using namespace <namespace>;
  | TypeDef (CType f) (CName f)             -- ^ typedef origtype newname;
  | CExpSA (CExp f)                         -- ^ C expression standalone;
  | CDeclaration (CFunDecl f)               -- ^ function declaration;
  | CDefinition (Maybe CQual) (CFunDecl f) [CStatement f]
                                            -- ^ function definition;
  | CInit (CVarDecl f) (CExp f)             -- ^ variable initialization;
  | CReturn (CExp f)                        -- ^ return statement;
  | CDelete (CExp f)                        -- ^ delete statement;
  | CMacroApp (CName f) [CName f]           -- ^ C Macro application at statement level (temporary)
  | CExtern [CStatement f]                  -- ^ extern "C" {..}
  | Comment String                          -- ^ comment
  | CEmptyLine                              -- ^ for convenience
  | CVerbatim String                        -- ^ temporary verbatim

data CMacro (f :: * -> *) =
    CRegular (CStatement f)                   -- ^ regular C++ statement
  | Include HeaderName                        -- ^ #include "<header>"
  | Pragma PragmaParam                        -- ^ #pragma
  | Undef (CName f)                           -- ^ #undef name
  | Define (CName f) [CName f] [CStatement f] -- ^ #define macro (type) definition
  | EmptyLine                                 -- ^ just for convenience
  | Verbatim String                           -- ^ temporary verbatim

data CBlock (f :: * -> *) = ExternC [CMacro f] -- extern "C" with #ifdef __cplusplus guard.

renderPragmaParam :: PragmaParam -> String
renderPragmaParam :: PragmaParam -> String
renderPragmaParam PragmaParam
Once = String
"once"

renderCType :: CType Identity -> String
renderCType :: CType Identity -> String
renderCType CType Identity
CTVoid         = String
"void"
renderCType (CTSimple CName Identity
n)   = CName Identity -> String
renderCName CName Identity
n
renderCType (CTStar CType Identity
t)     = CType Identity -> String
renderCType CType Identity
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"*"
renderCType CType Identity
CTAuto         = String
"auto"
renderCType (CTTApp CName Identity
n [CType Identity]
ts)  = CName Identity -> String
renderCName CName Identity
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"<" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CType Identity -> String) -> [CType Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CType Identity -> String
renderCType [CType Identity]
ts) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
">"
renderCType (CTConst CType Identity
t)    = String
"const " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CType Identity -> String
renderCType CType Identity
t
renderCType (CTScoped CType Identity
t CType Identity
i) = CType Identity -> String
renderCType CType Identity
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"::" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CType Identity -> String
renderCType CType Identity
i
renderCType (CTVerbatim String
t) = String
t

renderCExp :: CExp Identity -> String
renderCExp :: CExp Identity -> String
renderCExp (CVar CName Identity
n)        = CName Identity -> String
renderCName CName Identity
n
renderCExp (CApp CExp Identity
f [CExp Identity]
es)     =    (case CExp Identity
f of
                                   CVar CName Identity
_ -> CExp Identity -> String
renderCExp CExp Identity
f
                                   CExp Identity
_      -> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CExp Identity -> String
renderCExp CExp Identity
f String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")" -- compound expression like (*p)
                                )
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"("
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CExp Identity -> String) -> [CExp Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CExp Identity -> String
renderCExp [CExp Identity]
es)  -- arguments
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
renderCExp (CTApp CName Identity
f [CType Identity]
ts [CExp Identity]
es) =    CName Identity -> String
renderCName CName Identity
f
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"<"
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CType Identity -> String) -> [CType Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CType Identity -> String
renderCType [CType Identity]
ts) -- type arguments
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
">"
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"("
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CExp Identity -> String) -> [CExp Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CExp Identity -> String
renderCExp [CExp Identity]
es)  -- arguments
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
renderCExp (CBinOp COp
o CExp Identity
x CExp Identity
y)  =    (case CExp Identity
x of
                                   CVar CName Identity
_ -> CExp Identity -> String
renderCExp CExp Identity
x
                                   CExp Identity
_      -> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CExp Identity -> String
renderCExp CExp Identity
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")" -- compound expression like (*p)
                                )
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> COp -> String
renderCOp COp
o
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CExp Identity -> String
renderCExp CExp Identity
y
renderCExp (CCast CType Identity
t CExp Identity
e)     = String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CType Identity -> String
renderCType CType Identity
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CExp Identity -> String
renderCExp CExp Identity
e
renderCExp (CAddr CExp Identity
e)       = String
"&(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CExp Identity -> String
renderCExp CExp Identity
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
renderCExp (CStar CExp Identity
e)       = String
"*(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CExp Identity -> String
renderCExp CExp Identity
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
renderCExp (CNew CName Identity
n [CExp Identity]
es)     =    String
"new "
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CName Identity -> String
renderCName CName Identity
n                         -- constructor name
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"("
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CExp Identity -> String) -> [CExp Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CExp Identity -> String
renderCExp [CExp Identity]
es)  -- arguments
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
renderCExp (CTNew CName Identity
n [CType Identity]
ts [CExp Identity]
es) =    String
"new "
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CName Identity -> String
renderCName CName Identity
n                         -- constructor name
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"<"
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CType Identity -> String) -> [CType Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CType Identity -> String
renderCType [CType Identity]
ts) -- type arguments
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
">"
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"("
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CExp Identity -> String) -> [CExp Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CExp Identity -> String
renderCExp [CExp Identity]
es)  -- arguments
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
renderCExp (CTNewI CName Identity
n CName Identity
i [CType Identity]
ts [CExp Identity]
es) =    String
"new "
                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CName Identity -> String
renderCName CName Identity
n                         -- constructor name
                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"<"
                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CType Identity -> String) -> [CType Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CType Identity -> String
renderCType [CType Identity]
ts) -- type arguments
                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
">::"
                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CName Identity -> String
renderCName CName Identity
i                         -- inner class name
                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"("
                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CExp Identity -> String) -> [CExp Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CExp Identity -> String
renderCExp [CExp Identity]
es)  -- arguments
                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
renderCExp (CEMacroApp CName Identity
n [CName Identity]
as) =  CName Identity -> String
renderCName CName Identity
n
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"("
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CName Identity -> String) -> [CName Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CName Identity -> String
renderCName [CName Identity]
as)
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")" -- NOTE: no semicolon.
renderCExp (CEVerbatim String
e)  = String
e
renderCExp CExp Identity
CNull           = String
""

renderCQual :: CQual -> String
renderCQual :: CQual -> String
renderCQual CQual
Inline = String
"inline"

renderCFDecl :: CFunDecl Identity -> String
renderCFDecl :: CFunDecl Identity -> String
renderCFDecl (CFunDecl CType Identity
typ CName Identity
fname [(CType Identity, CName Identity)]
args) =
    CType Identity -> String
renderCType CType Identity
typ String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CName Identity -> String
renderCName CName Identity
fname String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ( " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (((CType Identity, CName Identity) -> String)
-> [(CType Identity, CName Identity)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (CType Identity, CName Identity) -> String
mkArgStr [(CType Identity, CName Identity)]
args) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" )"
  where
    mkArgStr :: (CType Identity, CName Identity) -> String
mkArgStr (CType Identity
t, CName Identity
a) = CType Identity -> String
renderCType CType Identity
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CName Identity -> String
renderCName CName Identity
a

renderCVDecl :: CVarDecl Identity -> String
renderCVDecl :: CVarDecl Identity -> String
renderCVDecl (CVarDecl CType Identity
typ CName Identity
vname) = CType Identity -> String
renderCType CType Identity
typ String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CName Identity -> String
renderCName CName Identity
vname

-- | render CStatement in a regular environment
renderCStmt :: CStatement Identity -> String
renderCStmt :: CStatement Identity -> String
renderCStmt (UsingNamespace (NS String
ns)) = String
"using namespace " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ns String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
";"
renderCStmt (TypeDef CType Identity
typ CName Identity
n)          = String
"typedef " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CType Identity -> String
renderCType CType Identity
typ String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CName Identity -> String
renderCName CName Identity
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
";"
renderCStmt (CExpSA CExp Identity
e)               = CExp Identity -> String
renderCExp CExp Identity
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
";"
renderCStmt (CDeclaration CFunDecl Identity
e)         = CFunDecl Identity -> String
renderCFDecl CFunDecl Identity
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
";"
renderCStmt (CDefinition Maybe CQual
mq CFunDecl Identity
d [CStatement Identity]
body)  =    String -> (CQual -> String) -> Maybe CQual -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\CQual
q -> CQual -> String
renderCQual CQual
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ") Maybe CQual
mq
                                       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CFunDecl Identity -> String
renderCFDecl CFunDecl Identity
d
                                       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" {\n"
                                       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (CStatement Identity -> String) -> [CStatement Identity] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CStatement Identity -> String
renderCStmt [CStatement Identity]
body
                                       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n}\n"
renderCStmt (CInit CVarDecl Identity
d CExp Identity
e)              = CVarDecl Identity -> String
renderCVDecl CVarDecl Identity
d String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CExp Identity -> String
renderCExp CExp Identity
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
";"
renderCStmt (CReturn CExp Identity
e)              = String
"return " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CExp Identity -> String
renderCExp CExp Identity
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
";"
renderCStmt (CDelete CExp Identity
e)              = String
"delete " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CExp Identity -> String
renderCExp CExp Identity
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
";"
renderCStmt (CMacroApp CName Identity
n [CName Identity]
as)         =    CName Identity -> String
renderCName CName Identity
n
                                       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"("
                                       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CName Identity -> String) -> [CName Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CName Identity -> String
renderCName [CName Identity]
as)
                                       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")" -- NOTE: no semicolon.
renderCStmt (CExtern [CStatement Identity]
body)           =   String
"extern \"C\" {\n"
                                       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (CStatement Identity -> String) -> [CStatement Identity] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CStatement Identity -> String
renderCStmt [CStatement Identity]
body
                                       String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}\n"
renderCStmt (Comment String
str)            = String
"// " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"
renderCStmt CStatement Identity
CEmptyLine               = String
"\n"
renderCStmt (CVerbatim String
str)          = String
str

-- | render CStatement in a macro definition environment
renderCStmtInMacro :: CStatement Identity -> [String]
renderCStmtInMacro :: CStatement Identity -> [String]
renderCStmtInMacro (Comment String
_str)  = [String
""] -- Comment cannot exist in Macro
renderCStmtInMacro CStatement Identity
CEmptyLine      = [String
""]
renderCStmtInMacro (CVerbatim String
str) = String -> [String]
lines String
str
renderCStmtInMacro CStatement Identity
s               = String -> [String]
lines (CStatement Identity -> String
renderCStmt CStatement Identity
s)

renderCMacro :: CMacro Identity -> String
renderCMacro :: CMacro Identity -> String
renderCMacro (CRegular CStatement Identity
stmt)          = CStatement Identity -> String
renderCStmt CStatement Identity
stmt
renderCMacro (Include (HdrName String
hdr))  = String
"\n#include \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
hdr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\"\n"
renderCMacro (Pragma PragmaParam
param)           = String
"\n#pragma " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PragmaParam -> String
renderPragmaParam PragmaParam
param String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"
renderCMacro (Undef CName Identity
n)                = String
"\n#undef " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CName Identity -> String
renderCName CName Identity
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"
renderCMacro (Define CName Identity
m [CName Identity]
ts [CStatement Identity]
stmts)       =
     String
"\n#define " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CName Identity -> String
renderCName CName Identity
m
   String -> ShowS
forall a. Semigroup a => a -> a -> a
<> case [CName Identity]
ts of
        [] -> String
" "
        [CName Identity]
_  -> String
"("  String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((CName Identity -> String) -> [CName Identity] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CName Identity -> String
renderCName [CName Identity]
ts) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") \\\n"
   String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\\\n" ((CStatement Identity -> [String])
-> [CStatement Identity] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CStatement Identity -> [String]
renderCStmtInMacro [CStatement Identity]
stmts)
   String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"
renderCMacro CMacro Identity
EmptyLine                = String
"\n"
renderCMacro (Verbatim String
str)           = String
str


renderBlock :: CBlock Identity -> String
renderBlock :: CBlock Identity -> String
renderBlock (ExternC [CMacro Identity]
ms) =
     String
"\n#ifdef __cplusplus\n\
     \extern \"C\" {\n\
     \#endif\n"
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ (CMacro Identity -> String) -> [CMacro Identity] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CMacro Identity -> String
renderCMacro [CMacro Identity]
ms
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n#ifdef __cplusplus\n\
     \}\n\
     \#endif\n"