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

module FFICXX.Runtime.CodeGen.Cxx where

import Data.Functor.Identity (Identity)
import Data.Kind (Type)
import Data.List (intercalate)
import Data.String (IsString (..))

newtype HeaderName = HdrName {HeaderName -> String
unHdrName :: String}
  deriving (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
$cshowsPrec :: Int -> HeaderName -> ShowS
showsPrec :: Int -> HeaderName -> ShowS
$cshow :: HeaderName -> String
show :: HeaderName -> String
$cshowList :: [HeaderName] -> ShowS
showList :: [HeaderName] -> ShowS
Show, HeaderName -> HeaderName -> Bool
(HeaderName -> HeaderName -> Bool)
-> (HeaderName -> HeaderName -> Bool) -> Eq HeaderName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeaderName -> HeaderName -> Bool
== :: HeaderName -> HeaderName -> Bool
$c/= :: HeaderName -> HeaderName -> Bool
/= :: 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
$ccompare :: HeaderName -> HeaderName -> Ordering
compare :: HeaderName -> HeaderName -> Ordering
$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
>= :: HeaderName -> HeaderName -> Bool
$cmax :: HeaderName -> HeaderName -> HeaderName
max :: HeaderName -> HeaderName -> HeaderName
$cmin :: HeaderName -> HeaderName -> HeaderName
min :: HeaderName -> HeaderName -> 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
$cshowsPrec :: Int -> Namespace -> ShowS
showsPrec :: Int -> Namespace -> ShowS
$cshow :: Namespace -> String
show :: Namespace -> String
$cshowList :: [Namespace] -> ShowS
showList :: [Namespace] -> ShowS
Show, Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
/= :: 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
$ccompare :: Namespace -> Namespace -> Ordering
compare :: Namespace -> Namespace -> Ordering
$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
>= :: Namespace -> Namespace -> Bool
$cmax :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
min :: Namespace -> Namespace -> Namespace
Ord)

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

data PragmaParam = Once

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

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

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

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

data CQual = Inline

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

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

data CBlock (f :: Type -> Type) = 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"