{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module FFICXX.Generate.Code.Cpp where

import Data.Char (toUpper)
import Data.Functor.Identity (Identity)
import Data.List (intercalate, intersperse)
import FFICXX.Generate.Code.Primitive
  ( CFunSig (..),
    accessorCFunSig,
    argToCallCExp,
    argsToCTypVar,
    argsToCTypVarNoSelf,
    c2Cxx,
    cxx2C,
    genericFuncArgs,
    genericFuncRet,
    returnCType,
    tmplAccessorToTFun,
    tmplAllArgsToCTypVar,
    tmplAppTypeFromForm,
    tmplArgToCTypVar,
    tmplArgToCallCExp,
    tmplMemFuncArgToCTypVar,
    tmplMemFuncReturnCType,
    tmplReturnCType,
  )
import FFICXX.Generate.Name
  ( aliasedFuncName,
    cppFuncName,
    ffiClassName,
    ffiTmplFuncName,
    hsTemplateMemberFunctionName,
  )
import FFICXX.Generate.Type.Class
  ( Accessor (Getter, Setter),
    Arg (..),
    CPPTypes (..),
    CTypes (..),
    Class (..),
    Form (FormNested, FormSimple),
    Function (..),
    IsConst (Const, NoConst),
    Selfness (NoSelf, Self),
    TLOrdinary (..),
    TLTemplate (..),
    TemplateAppInfo (..),
    TemplateClass (..),
    TemplateFunction (..),
    TemplateMemberFunction (..),
    Types (..),
    Variable (..),
    argsFromOpExp,
    isDeleteFunc,
    isNewFunc,
    isStaticFunc,
    isVirtualFunc,
    opSymbol,
    virtualFuncs,
  )
import FFICXX.Generate.Type.Module (ClassImportHeader (..))
import FFICXX.Generate.Util (firstUpper, toUppers)
import qualified FFICXX.Runtime.CodeGen.Cxx as R
import FFICXX.Runtime.TH (IsCPrimitive (CPrim, NonCPrim))

--
--
-- Class Declaration and Definition
--

----
---- Declaration
----

---- "Class Type Declaration" Instances

typedefStmts :: String -> [R.CStatement Identity]
typedefStmts :: String -> [CStatement Identity]
typedefStmts String
classname =
  [ forall (f :: * -> *). CType f -> CName f -> CStatement f
R.TypeDef (forall (f :: * -> *). String -> CType f
R.CTVerbatim (String
"struct " forall a. Semigroup a => a -> a -> a
<> String
classname_tag)) (String -> CName Identity
R.sname String
classname_t),
    forall (f :: * -> *). CType f -> CName f -> CStatement f
R.TypeDef (forall (f :: * -> *). String -> CType f
R.CTVerbatim (String
classname_t forall a. Semigroup a => a -> a -> a
<> String
" *")) (String -> CName Identity
R.sname String
classname_p),
    forall (f :: * -> *). CType f -> CName f -> CStatement f
R.TypeDef (forall (f :: * -> *). String -> CType f
R.CTVerbatim (String
classname_t forall a. Semigroup a => a -> a -> a
<> String
" const*")) (String -> CName Identity
R.sname (String
"const_" forall a. Semigroup a => a -> a -> a
<> String
classname_p))
  ]
  where
    classname_tag :: String
classname_tag = String
classname forall a. Semigroup a => a -> a -> a
<> String
"_tag"
    classname_t :: String
classname_t = String
classname forall a. Semigroup a => a -> a -> a
<> String
"_t"
    classname_p :: String
classname_p = String
classname forall a. Semigroup a => a -> a -> a
<> String
"_p"

genCppHeaderMacroType :: Class -> [R.CStatement Identity]
genCppHeaderMacroType :: Class -> [CStatement Identity]
genCppHeaderMacroType Class
c =
  [forall (f :: * -> *). String -> CStatement f
R.Comment String
"Opaque type definition for $classname"]
    forall a. Semigroup a => a -> a -> a
<> String -> [CStatement Identity]
typedefStmts (Class -> String
ffiClassName Class
c)

---- "Class Declaration Virtual" Declaration

genCppHeaderMacroVirtual :: Class -> R.CMacro Identity
genCppHeaderMacroVirtual :: Class -> CMacro Identity
genCppHeaderMacroVirtual Class
aclass =
  let funcDecls :: [CStatement Identity]
funcDecls =
        forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Class -> Function -> CFunDecl Identity
funcToDecl Class
aclass)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Function] -> [Function]
virtualFuncs
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Function]
class_funcs
          forall a b. (a -> b) -> a -> b
$ Class
aclass
      macrocname :: String
macrocname = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
aclass)
      macroname :: String
macroname = String
macrocname forall a. Semigroup a => a -> a -> a
<> String
"_DECL_VIRT"
   in forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname String
"Type"] [CStatement Identity]
funcDecls

genCppHeaderMacroNonVirtual :: Class -> R.CMacro Identity
genCppHeaderMacroNonVirtual :: Class -> CMacro Identity
genCppHeaderMacroNonVirtual Class
c =
  let funcDecls :: [CStatement Identity]
funcDecls =
        forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Class -> Function -> CFunDecl Identity
funcToDecl Class
c)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Bool
isVirtualFunc)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Function]
class_funcs
          forall a b. (a -> b) -> a -> b
$ Class
c
      macrocname :: String
macrocname = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
c)
      macroname :: String
macroname = String
macrocname forall a. Semigroup a => a -> a -> a
<> String
"_DECL_NONVIRT"
   in forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname String
"Type"] [CStatement Identity]
funcDecls

---- "Class Declaration Accessor" Declaration

genCppHeaderMacroAccessor :: Class -> R.CMacro Identity
genCppHeaderMacroAccessor :: Class -> CMacro Identity
genCppHeaderMacroAccessor Class
c =
  let funcDecls :: [CStatement Identity]
funcDecls = forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration forall a b. (a -> b) -> a -> b
$ [Variable] -> [CFunDecl Identity]
accessorsToDecls (Class -> [Variable]
class_vars Class
c)
      macrocname :: String
macrocname = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
c)
      macroname :: String
macroname = String
macrocname forall a. Semigroup a => a -> a -> a
<> String
"_DECL_ACCESSOR"
   in forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname String
"Type"] [CStatement Identity]
funcDecls

---- "Class Declaration Virtual/NonVirtual/Accessor" Instances

genCppHeaderInstVirtual :: (Class, Class) -> R.CStatement Identity
genCppHeaderInstVirtual :: (Class, Class) -> CStatement Identity
genCppHeaderInstVirtual (Class
p, Class
c) =
  let macroname :: String
macroname = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
p) forall a. Semigroup a => a -> a -> a
<> String
"_DECL_VIRT"
   in forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c)]

genCppHeaderInstNonVirtual :: Class -> R.CStatement Identity
genCppHeaderInstNonVirtual :: Class -> CStatement Identity
genCppHeaderInstNonVirtual Class
c =
  let macroname :: String
macroname = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
c) forall a. Semigroup a => a -> a -> a
<> String
"_DECL_NONVIRT"
   in forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c)]

genCppHeaderInstAccessor :: Class -> R.CStatement Identity
genCppHeaderInstAccessor :: Class -> CStatement Identity
genCppHeaderInstAccessor Class
c =
  let macroname :: String
macroname = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
c) forall a. Semigroup a => a -> a -> a
<> String
"_DECL_ACCESSOR"
   in forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c)]

----
---- Definition
----

---- "Class Definition Virtual" Declaration

genCppDefMacroVirtual :: Class -> R.CMacro Identity
genCppDefMacroVirtual :: Class -> CMacro Identity
genCppDefMacroVirtual Class
aclass =
  let funcDefStr :: String
funcDefStr =
        forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (CStatement Identity -> String
R.renderCStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Function -> CStatement Identity
funcToDef Class
aclass)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Function] -> [Function]
virtualFuncs
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Function]
class_funcs
          forall a b. (a -> b) -> a -> b
$ Class
aclass
      macrocname :: String
macrocname = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
aclass)
      macroname :: String
macroname = String
macrocname forall a. Semigroup a => a -> a -> a
<> String
"_DEF_VIRT"
   in forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname String
"Type"] [forall (f :: * -> *). String -> CStatement f
R.CVerbatim String
funcDefStr]

---- "Class Definition NonVirtual" Declaration

genCppDefMacroNonVirtual :: Class -> R.CMacro Identity
genCppDefMacroNonVirtual :: Class -> CMacro Identity
genCppDefMacroNonVirtual Class
aclass =
  let funcDefStr :: String
funcDefStr =
        forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (CStatement Identity -> String
R.renderCStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Function -> CStatement Identity
funcToDef Class
aclass)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Bool
isVirtualFunc)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Function]
class_funcs
          forall a b. (a -> b) -> a -> b
$ Class
aclass
      macrocname :: String
macrocname = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
aclass)
      macroname :: String
macroname = String
macrocname forall a. Semigroup a => a -> a -> a
<> String
"_DEF_NONVIRT"
   in forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname String
"Type"] [forall (f :: * -> *). String -> CStatement f
R.CVerbatim String
funcDefStr]

---- Define Macro to provide Accessor C-C++ shim code for a class

genCppDefMacroAccessor :: Class -> R.CMacro Identity
genCppDefMacroAccessor :: Class -> CMacro Identity
genCppDefMacroAccessor Class
c =
  let funcDefs :: [CStatement Identity]
funcDefs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Variable
v -> [Variable -> Accessor -> CStatement Identity
accessorToDef Variable
v Accessor
Getter, Variable -> Accessor -> CStatement Identity
accessorToDef Variable
v Accessor
Setter]) (Class -> [Variable]
class_vars Class
c)
      macrocname :: String
macrocname = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
c)
      macroname :: String
macroname = String
macrocname forall a. Semigroup a => a -> a -> a
<> String
"_DEF_ACCESSOR"
   in forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname String
"Type"] [CStatement Identity]
funcDefs

---- Define Macro to provide TemplateMemberFunction C-C++ shim code for a class

genCppDefMacroTemplateMemberFunction ::
  Class ->
  TemplateMemberFunction ->
  R.CMacro Identity
genCppDefMacroTemplateMemberFunction :: Class -> TemplateMemberFunction -> CMacro Identity
genCppDefMacroTemplateMemberFunction Class
c TemplateMemberFunction
f =
  forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define
    (String -> CName Identity
R.sname String
macroname)
    (forall a b. (a -> b) -> [a] -> [b]
map String -> CName Identity
R.sname (TemplateMemberFunction -> [String]
tmf_params TemplateMemberFunction
f))
    [ forall (f :: * -> *). [CStatement f] -> CStatement f
R.CExtern [forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration CFunDecl Identity
decl],
      Class -> TemplateMemberFunction -> CStatement Identity
tmplMemberFunToDef Class
c TemplateMemberFunction
f,
      forall {f :: * -> *}. CStatement f
autoinst
    ]
  where
    nsuffix :: [NamePart f]
nsuffix = forall a. a -> [a] -> [a]
intersperse (forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). String -> NamePart f
R.NamePart (TemplateMemberFunction -> [String]
tmf_params TemplateMemberFunction
f)
    macroname :: String
macroname = Class -> TemplateMemberFunction -> String
hsTemplateMemberFunctionName Class
c TemplateMemberFunction
f
    decl :: CFunDecl Identity
decl = Class -> TemplateMemberFunction -> CFunDecl Identity
tmplMemberFunToDecl Class
c TemplateMemberFunction
f
    autoinst :: CStatement f
autoinst =
      forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
        ( forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl
            forall (f :: * -> *). CType f
R.CTAuto
            (forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"a_" forall a. Semigroup a => a -> a -> a
<> String
macroname forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix))
        )
        (forall (f :: * -> *). CName f -> CExp f
R.CVar (forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart (String
macroname forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix)))

---- Invoke Macro to define Virtual/NonVirtual method for a class

genCppDefInstVirtual :: (Class, Class) -> R.CStatement Identity
genCppDefInstVirtual :: (Class, Class) -> CStatement Identity
genCppDefInstVirtual (Class
p, Class
c) =
  let macroname :: String
macroname = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
p) forall a. Semigroup a => a -> a -> a
<> String
"_DEF_VIRT"
   in forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c)]

genCppDefInstNonVirtual :: Class -> R.CStatement Identity
genCppDefInstNonVirtual :: Class -> CStatement Identity
genCppDefInstNonVirtual Class
c =
  let macroname :: String
macroname = String -> String
toUppers (Class -> String
ffiClassName Class
c) forall a. Semigroup a => a -> a -> a
<> String
"_DEF_NONVIRT"
   in forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c)]

genCppDefInstAccessor :: Class -> R.CStatement Identity
genCppDefInstAccessor :: Class -> CStatement Identity
genCppDefInstAccessor Class
c =
  let macroname :: String
macroname = String -> String
toUppers (Class -> String
ffiClassName Class
c) forall a. Semigroup a => a -> a -> a
<> String
"_DEF_ACCESSOR"
   in forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname String
macroname) [String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c)]

-----------------

genAllCppHeaderInclude :: ClassImportHeader -> [R.CMacro Identity]
genAllCppHeaderInclude :: ClassImportHeader -> [CMacro Identity]
genAllCppHeaderInclude ClassImportHeader
header =
  forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). HeaderName -> CMacro f
R.Include (ClassImportHeader -> [HeaderName]
cihIncludedHPkgHeadersInCPP ClassImportHeader
header forall a. Semigroup a => a -> a -> a
<> ClassImportHeader -> [HeaderName]
cihIncludedCPkgHeaders ClassImportHeader
header)

----

-------------------------
-- TOP LEVEL FUNCTIONS --
-------------------------

topLevelDecl :: TLOrdinary -> R.CFunDecl Identity
topLevelDecl :: TLOrdinary -> CFunDecl Identity
topLevelDecl TopLevelFunction {String
[Arg]
Maybe String
Types
toplevelfunc_alias :: TLOrdinary -> Maybe String
toplevelfunc_args :: TLOrdinary -> [Arg]
toplevelfunc_name :: TLOrdinary -> String
toplevelfunc_ret :: TLOrdinary -> Types
toplevelfunc_alias :: Maybe String
toplevelfunc_args :: [Arg]
toplevelfunc_name :: String
toplevelfunc_ret :: Types
..} = forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret CName Identity
func [(CType Identity, CName Identity)]
args
  where
    ret :: CType Identity
ret = Types -> CType Identity
returnCType Types
toplevelfunc_ret
    func :: CName Identity
func = String -> CName Identity
R.sname (String
"TopLevel_" forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
toplevelfunc_name forall a. a -> a
id Maybe String
toplevelfunc_alias)
    args :: [(CType Identity, CName Identity)]
args = [Arg] -> [(CType Identity, CName Identity)]
argsToCTypVarNoSelf [Arg]
toplevelfunc_args
topLevelDecl TopLevelVariable {String
Maybe String
Types
toplevelvar_alias :: TLOrdinary -> Maybe String
toplevelvar_name :: TLOrdinary -> String
toplevelvar_ret :: TLOrdinary -> Types
toplevelvar_alias :: Maybe String
toplevelvar_name :: String
toplevelvar_ret :: Types
..} = forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret CName Identity
func []
  where
    ret :: CType Identity
ret = Types -> CType Identity
returnCType Types
toplevelvar_ret
    func :: CName Identity
func = String -> CName Identity
R.sname (String
"TopLevel_" forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
toplevelvar_name forall a. a -> a
id Maybe String
toplevelvar_alias)

genTopLevelCppDefinition :: TLOrdinary -> R.CStatement Identity
genTopLevelCppDefinition :: TLOrdinary -> CStatement Identity
genTopLevelCppDefinition tf :: TLOrdinary
tf@TopLevelFunction {String
[Arg]
Maybe String
Types
toplevelfunc_alias :: Maybe String
toplevelfunc_args :: [Arg]
toplevelfunc_name :: String
toplevelfunc_ret :: Types
toplevelfunc_alias :: TLOrdinary -> Maybe String
toplevelfunc_args :: TLOrdinary -> [Arg]
toplevelfunc_name :: TLOrdinary -> String
toplevelfunc_ret :: TLOrdinary -> Types
..} =
  let decl :: CFunDecl Identity
decl = TLOrdinary -> CFunDecl Identity
topLevelDecl TLOrdinary
tf
      body :: [CStatement Identity]
body =
        IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp
          IsCPrimitive
NonCPrim
          (Types
toplevelfunc_ret)
          (forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
toplevelfunc_name)) (forall a b. (a -> b) -> [a] -> [b]
map Arg -> CExp Identity
argToCallCExp [Arg]
toplevelfunc_args))
   in forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition forall a. Maybe a
Nothing CFunDecl Identity
decl [CStatement Identity]
body
genTopLevelCppDefinition tv :: TLOrdinary
tv@TopLevelVariable {String
Maybe String
Types
toplevelvar_alias :: Maybe String
toplevelvar_name :: String
toplevelvar_ret :: Types
toplevelvar_alias :: TLOrdinary -> Maybe String
toplevelvar_name :: TLOrdinary -> String
toplevelvar_ret :: TLOrdinary -> Types
..} =
  let decl :: CFunDecl Identity
decl = TLOrdinary -> CFunDecl Identity
topLevelDecl TLOrdinary
tv
      body :: [CStatement Identity]
body = IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
NonCPrim (Types
toplevelvar_ret) (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
toplevelvar_name))
   in forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition forall a. Maybe a
Nothing CFunDecl Identity
decl [CStatement Identity]
body

genTmplFunCpp ::
  IsCPrimitive ->
  TemplateClass ->
  TemplateFunction ->
  R.CMacro Identity
genTmplFunCpp :: IsCPrimitive
-> TemplateClass -> TemplateFunction -> CMacro Identity
genTmplFunCpp IsCPrimitive
b t :: TemplateClass
t@TmplCls {String
[String]
[TemplateFunction]
[Variable]
Cabal
Form
tclass_vars :: TemplateClass -> [Variable]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_params :: TemplateClass -> [String]
tclass_cxxform :: TemplateClass -> Form
tclass_name :: TemplateClass -> String
tclass_cabal :: TemplateClass -> Cabal
tclass_vars :: [Variable]
tclass_funcs :: [TemplateFunction]
tclass_params :: [String]
tclass_cxxform :: Form
tclass_name :: String
tclass_cabal :: Cabal
..} TemplateFunction
f =
  forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define
    (String -> CName Identity
R.sname String
macroname)
    (forall a b. (a -> b) -> [a] -> [b]
map String -> CName Identity
R.sname (String
"callmod" forall a. a -> [a] -> [a]
: [String]
tclass_params))
    [ forall (f :: * -> *). [CStatement f] -> CStatement f
R.CExtern [forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration CFunDecl Identity
decl],
      IsCPrimitive
-> TemplateClass -> TemplateFunction -> CStatement Identity
tmplFunToDef IsCPrimitive
b TemplateClass
t TemplateFunction
f,
      forall {f :: * -> *}. CStatement f
autoinst
    ]
  where
    nsuffix :: [NamePart f]
nsuffix = forall a. a -> [a] -> [a]
intersperse (forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). String -> NamePart f
R.NamePart [String]
tclass_params
    suffix :: String
suffix = case IsCPrimitive
b of IsCPrimitive
CPrim -> String
"_s"; IsCPrimitive
NonCPrim -> String
""
    macroname :: String
macroname = String
tclass_name forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
suffix
    decl :: CFunDecl Identity
decl = IsCPrimitive
-> TemplateClass -> TemplateFunction -> CFunDecl Identity
tmplFunToDecl IsCPrimitive
b TemplateClass
t TemplateFunction
f
    autoinst :: CStatement f
autoinst =
      forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
        ( forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl
            forall (f :: * -> *). CType f
R.CTAuto
            (forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart String
"a_" forall a. a -> [a] -> [a]
: forall (f :: * -> *). String -> NamePart f
R.NamePart String
"callmod" forall a. a -> [a] -> [a]
: forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"_" forall a. Semigroup a => a -> a -> a
<> String
tclass_name forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix))
        )
        (forall (f :: * -> *). CName f -> CExp f
R.CVar (forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix)))

genTLTmplFunCpp ::
  IsCPrimitive ->
  TLTemplate ->
  R.CMacro Identity
genTLTmplFunCpp :: IsCPrimitive -> TLTemplate -> CMacro Identity
genTLTmplFunCpp IsCPrimitive
b t :: TLTemplate
t@TopLevelTemplateFunction {String
[String]
[Arg]
Types
topleveltfunc_args :: TLTemplate -> [Arg]
topleveltfunc_oname :: TLTemplate -> String
topleveltfunc_name :: TLTemplate -> String
topleveltfunc_ret :: TLTemplate -> Types
topleveltfunc_params :: TLTemplate -> [String]
topleveltfunc_args :: [Arg]
topleveltfunc_oname :: String
topleveltfunc_name :: String
topleveltfunc_ret :: Types
topleveltfunc_params :: [String]
..} =
  forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define
    (String -> CName Identity
R.sname String
macroname)
    (forall a b. (a -> b) -> [a] -> [b]
map String -> CName Identity
R.sname (String
"callmod" forall a. a -> [a] -> [a]
: [String]
topleveltfunc_params))
    [ forall (f :: * -> *). [CStatement f] -> CStatement f
R.CExtern [forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration CFunDecl Identity
decl],
      IsCPrimitive -> TLTemplate -> CStatement Identity
topLevelTemplateFunToDef IsCPrimitive
b TLTemplate
t,
      forall {f :: * -> *}. CStatement f
autoinst
    ]
  where
    nsuffix :: [NamePart f]
nsuffix = forall a. a -> [a] -> [a]
intersperse (forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). String -> NamePart f
R.NamePart [String]
topleveltfunc_params
    suffix :: String
suffix = case IsCPrimitive
b of IsCPrimitive
CPrim -> String
"_s"; IsCPrimitive
NonCPrim -> String
""
    macroname :: String
macroname = String -> String
firstUpper String
topleveltfunc_name forall a. Semigroup a => a -> a -> a
<> String
"_instance" forall a. Semigroup a => a -> a -> a
<> String
suffix
    decl :: CFunDecl Identity
decl = IsCPrimitive -> TLTemplate -> CFunDecl Identity
topLevelTemplateFunToDecl IsCPrimitive
b TLTemplate
t
    autoinst :: CStatement f
autoinst =
      forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
        ( forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl
            forall (f :: * -> *). CType f
R.CTAuto
            (forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart String
"a_" forall a. a -> [a] -> [a]
: forall (f :: * -> *). String -> NamePart f
R.NamePart String
"callmod" forall a. a -> [a] -> [a]
: forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"_TL_" forall a. Semigroup a => a -> a -> a
<> String
topleveltfunc_name forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix))
        )
        (forall (f :: * -> *). CName f -> CExp f
R.CVar (forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"TL_" forall a. Semigroup a => a -> a -> a
<> String
topleveltfunc_name forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix)))

genTmplVarCpp ::
  IsCPrimitive ->
  TemplateClass ->
  Variable ->
  [R.CMacro Identity]
genTmplVarCpp :: IsCPrimitive -> TemplateClass -> Variable -> [CMacro Identity]
genTmplVarCpp IsCPrimitive
b t :: TemplateClass
t@TmplCls {String
[String]
[TemplateFunction]
[Variable]
Cabal
Form
tclass_vars :: [Variable]
tclass_funcs :: [TemplateFunction]
tclass_params :: [String]
tclass_cxxform :: Form
tclass_name :: String
tclass_cabal :: Cabal
tclass_vars :: TemplateClass -> [Variable]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_params :: TemplateClass -> [String]
tclass_cxxform :: TemplateClass -> Form
tclass_name :: TemplateClass -> String
tclass_cabal :: TemplateClass -> Cabal
..} var :: Variable
var@(Variable (Arg {})) =
  [Variable -> Accessor -> CMacro Identity
gen Variable
var Accessor
Getter, Variable -> Accessor -> CMacro Identity
gen Variable
var Accessor
Setter]
  where
    nsuffix :: [NamePart f]
nsuffix = forall a. a -> [a] -> [a]
intersperse (forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). String -> NamePart f
R.NamePart [String]
tclass_params
    suffix :: String
suffix = case IsCPrimitive
b of IsCPrimitive
CPrim -> String
"_s"; IsCPrimitive
NonCPrim -> String
""
    gen :: Variable -> Accessor -> CMacro Identity
gen Variable
v Accessor
a =
      let f :: TemplateFunction
f = Variable -> Accessor -> TemplateFunction
tmplAccessorToTFun Variable
v Accessor
a
          macroname :: String
macroname = String
tclass_name forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
suffix
       in forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define
            (String -> CName Identity
R.sname String
macroname)
            (forall a b. (a -> b) -> [a] -> [b]
map String -> CName Identity
R.sname (String
"callmod" forall a. a -> [a] -> [a]
: [String]
tclass_params))
            [ forall (f :: * -> *). [CStatement f] -> CStatement f
R.CExtern [forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration (IsCPrimitive
-> TemplateClass -> TemplateFunction -> CFunDecl Identity
tmplFunToDecl IsCPrimitive
b TemplateClass
t TemplateFunction
f)],
              IsCPrimitive
-> TemplateClass -> Variable -> Accessor -> CStatement Identity
tmplVarToDef IsCPrimitive
b TemplateClass
t Variable
v Accessor
a,
              forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
                ( forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl
                    forall (f :: * -> *). CType f
R.CTAuto
                    (forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart String
"a_" forall a. a -> [a] -> [a]
: forall (f :: * -> *). String -> NamePart f
R.NamePart String
"callmod" forall a. a -> [a] -> [a]
: forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"_" forall a. Semigroup a => a -> a -> a
<> String
tclass_name forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix))
                )
                (forall (f :: * -> *). CName f -> CExp f
R.CVar (forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix)))
            ]

-- |
genTmplClassCpp ::
  IsCPrimitive ->
  TemplateClass ->
  -- | (member functions, member accessors)
  ([TemplateFunction], [Variable]) ->
  R.CMacro Identity
genTmplClassCpp :: IsCPrimitive
-> TemplateClass
-> ([TemplateFunction], [Variable])
-> CMacro Identity
genTmplClassCpp IsCPrimitive
b TmplCls {String
[String]
[TemplateFunction]
[Variable]
Cabal
Form
tclass_vars :: [Variable]
tclass_funcs :: [TemplateFunction]
tclass_params :: [String]
tclass_cxxform :: Form
tclass_name :: String
tclass_cabal :: Cabal
tclass_vars :: TemplateClass -> [Variable]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_params :: TemplateClass -> [String]
tclass_cxxform :: TemplateClass -> Form
tclass_name :: TemplateClass -> String
tclass_cabal :: TemplateClass -> Cabal
..} ([TemplateFunction]
fs, [Variable]
vs) =
  forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define (String -> CName Identity
R.sname String
macroname) [CName Identity]
params [CStatement Identity]
body
  where
    params :: [CName Identity]
params = forall a b. (a -> b) -> [a] -> [b]
map String -> CName Identity
R.sname (String
"callmod" forall a. a -> [a] -> [a]
: [String]
tclass_params)
    suffix :: String
suffix = case IsCPrimitive
b of IsCPrimitive
CPrim -> String
"_s"; IsCPrimitive
NonCPrim -> String
""
    tname :: String
tname = String
tclass_name
    macroname :: String
macroname = String
tname forall a. Semigroup a => a -> a -> a
<> String
"_instance" forall a. Semigroup a => a -> a -> a
<> String
suffix
    macro1 :: TemplateFunction -> CStatement Identity
macro1 f :: TemplateFunction
f@TFun {} = forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname (String
tname forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
suffix)) [CName Identity]
params
    macro1 f :: TemplateFunction
f@TFunNew {} = forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname (String
tname forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
suffix)) [CName Identity]
params
    macro1 TemplateFunction
TFunDelete = forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname (String
tname forall a. Semigroup a => a -> a -> a
<> String
"_delete" forall a. Semigroup a => a -> a -> a
<> String
suffix)) [CName Identity]
params
    macro1 f :: TemplateFunction
f@TFunOp {} = forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname (String
tname forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
suffix)) [CName Identity]
params
    body :: [CStatement Identity]
body =
      forall a b. (a -> b) -> [a] -> [b]
map TemplateFunction -> CStatement Identity
macro1 [TemplateFunction]
fs
        forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map TemplateFunction -> CStatement Identity
macro1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Variable
v -> [Variable -> Accessor -> TemplateFunction
tmplAccessorToTFun Variable
v Accessor
Getter, Variable -> Accessor -> TemplateFunction
tmplAccessorToTFun Variable
v Accessor
Setter])) [Variable]
vs

-- |
returnCpp ::
  IsCPrimitive ->
  Types ->
  R.CExp Identity ->
  [R.CStatement Identity]
returnCpp :: IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
b Types
ret CExp Identity
caller =
  case Types
ret of
    Types
Void ->
      [forall (f :: * -> *). CExp f -> CStatement f
R.CExpSA CExp Identity
caller]
    Types
SelfType ->
      [ forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
            (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
            [ forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"]),
              forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type")
            ]
            [forall (f :: * -> *). CType f -> CExp f -> CExp f
R.CCast (forall (f :: * -> *). CType f -> CType f
R.CTStar (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type"))) CExp Identity
caller]
      ]
    CT (CRef CTypes
_) IsConst
_ ->
      [forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). CExp f -> CExp f
R.CAddr CExp Identity
caller]
    CT CTypes
_ IsConst
_ ->
      [forall (f :: * -> *). CExp f -> CStatement f
R.CReturn CExp Identity
caller]
    CPT (CPTClass Class
c') IsConst
isconst ->
      [ forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
            ( case IsConst
isconst of
                IsConst
NoConst -> String -> CName Identity
R.sname String
"from_nonconst_to_nonconst"
                IsConst
Const -> String -> CName Identity
R.sname String
"from_const_to_nonconst"
            )
            [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
str forall a. Semigroup a => a -> a -> a
<> String
"_t")), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str)]
            [forall (f :: * -> *). CType f -> CExp f -> CExp f
R.CCast (forall (f :: * -> *). CType f -> CType f
R.CTStar (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str))) CExp Identity
caller]
      ]
      where
        str :: String
str = Class -> String
ffiClassName Class
c'
    CPT (CPTClassRef Class
c') IsConst
isconst ->
      [ forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
            ( case IsConst
isconst of
                IsConst
NoConst -> String -> CName Identity
R.sname String
"from_nonconst_to_nonconst"
                IsConst
Const -> String -> CName Identity
R.sname String
"from_const_to_nonconst"
            )
            [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
str forall a. Semigroup a => a -> a -> a
<> String
"_t")), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str)]
            [forall (f :: * -> *). CExp f -> CExp f
R.CAddr CExp Identity
caller]
      ]
      where
        str :: String
str = Class -> String
ffiClassName Class
c'
    CPT (CPTClassCopy Class
c') IsConst
isconst ->
      [ forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
            ( case IsConst
isconst of
                IsConst
NoConst -> String -> CName Identity
R.sname String
"from_nonconst_to_nonconst"
                IsConst
Const -> String -> CName Identity
R.sname String
"from_const_to_nonconst"
            )
            [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
str forall a. Semigroup a => a -> a -> a
<> String
"_t")), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str)]
            [forall (f :: * -> *). CName f -> [CExp f] -> CExp f
R.CNew (String -> CName Identity
R.sname String
str) [CExp Identity
caller]]
      ]
      where
        str :: String
str = Class -> String
ffiClassName Class
c'
    CPT (CPTClassMove Class
c') IsConst
isconst ->
      -- TODO: check whether this is working or not.
      [ forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
            (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"std::move"))
            [ forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                ( case IsConst
isconst of
                    IsConst
NoConst -> String -> CName Identity
R.sname String
"from_nonconst_to_nonconst"
                    IsConst
Const -> String -> CName Identity
R.sname String
"from_const_to_nonconst"
                )
                [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
str forall a. Semigroup a => a -> a -> a
<> String
"_t")), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str)]
                [forall (f :: * -> *). CExp f -> CExp f
R.CAddr CExp Identity
caller]
            ]
      ]
      where
        str :: String
str = Class -> String
ffiClassName Class
c'
    TemplateApp (TemplateAppInfo TemplateClass
_ [TemplateArgType]
_ String
cpptype) ->
      [ forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
          (forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl (forall (f :: * -> *). CType f -> CType f
R.CTStar (forall (f :: * -> *). String -> CType f
R.CTVerbatim String
cpptype)) (String -> CName Identity
R.sname String
"r"))
          (forall (f :: * -> *). CName f -> [CExp f] -> CExp f
R.CNew (String -> CName Identity
R.sname String
cpptype) [CExp Identity
caller]),
        forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
            (String -> CName Identity
R.sname String
"static_cast")
            [forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid]
            [forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"r")]
      ]
    TemplateAppRef (TemplateAppInfo TemplateClass
_ [TemplateArgType]
_ String
cpptype) ->
      [ forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
          (forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl (forall (f :: * -> *). CType f -> CType f
R.CTStar (forall (f :: * -> *). String -> CType f
R.CTVerbatim String
cpptype)) (String -> CName Identity
R.sname String
"r"))
          (forall (f :: * -> *). CName f -> [CExp f] -> CExp f
R.CNew (String -> CName Identity
R.sname String
cpptype) [CExp Identity
caller]),
        forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
            (String -> CName Identity
R.sname String
"static_cast")
            [forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid]
            [forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"r")]
      ]
    TemplateAppMove (TemplateAppInfo TemplateClass
_ [TemplateArgType]
_ String
cpptype) ->
      [ forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
          (forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl (forall (f :: * -> *). CType f -> CType f
R.CTStar (forall (f :: * -> *). String -> CType f
R.CTVerbatim String
cpptype)) (String -> CName Identity
R.sname String
"r"))
          (forall (f :: * -> *). CName f -> [CExp f] -> CExp f
R.CNew (String -> CName Identity
R.sname String
cpptype) [CExp Identity
caller]),
        forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
            (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"std::move"))
            [ forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                (String -> CName Identity
R.sname String
"static_cast")
                [forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid]
                [forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"r")]
            ]
      ]
    TemplateType TemplateClass
_ ->
      forall a. HasCallStack => String -> a
error String
"returnCpp: TemplateType"
    TemplateParam String
typ ->
      [ forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$
          case IsCPrimitive
b of
            IsCPrimitive
CPrim -> CExp Identity
caller
            IsCPrimitive
NonCPrim ->
              forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
                [forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
typ, forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"]), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
typ)]
                [forall (f :: * -> *). CType f -> CExp f -> CExp f
R.CCast (forall (f :: * -> *). CType f -> CType f
R.CTStar (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
typ))) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). CExp f -> CExp f
R.CAddr CExp Identity
caller]
      ]
    TemplateParamPointer String
typ ->
      [ forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$
          case IsCPrimitive
b of
            IsCPrimitive
CPrim -> CExp Identity
caller
            IsCPrimitive
NonCPrim ->
              forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
                [forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
typ, forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"]), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
typ)]
                [CExp Identity
caller]
      ]

-- Function Declaration and Definition

funcToDecl :: Class -> Function -> R.CFunDecl Identity
funcToDecl :: Class -> Function -> CFunDecl Identity
funcToDecl Class
c Function
func
  | Function -> Bool
isNewFunc Function
func Bool -> Bool -> Bool
|| Function -> Bool
isStaticFunc Function
func =
    let ret :: CType Identity
ret = Types -> CType Identity
returnCType (Function -> Types
genericFuncRet Function
func)
        fname :: CName f
fname =
          forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"_" forall a. Semigroup a => a -> a -> a
<> Class -> Function -> String
aliasedFuncName Class
c Function
func)]
        args :: [(CType Identity, CName Identity)]
args = [Arg] -> [(CType Identity, CName Identity)]
argsToCTypVarNoSelf (Function -> [Arg]
genericFuncArgs Function
func)
     in forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret forall {f :: * -> *}. CName f
fname [(CType Identity, CName Identity)]
args
  | Bool
otherwise =
    let ret :: CType Identity
ret = Types -> CType Identity
returnCType (Function -> Types
genericFuncRet Function
func)
        fname :: CName f
fname =
          forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"_" forall a. Semigroup a => a -> a -> a
<> Class -> Function -> String
aliasedFuncName Class
c Function
func)]
        args :: [(CType Identity, CName Identity)]
args = [Arg] -> [(CType Identity, CName Identity)]
argsToCTypVar (Function -> [Arg]
genericFuncArgs Function
func)
     in forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret forall {f :: * -> *}. CName f
fname [(CType Identity, CName Identity)]
args

funcToDef :: Class -> Function -> R.CStatement Identity
funcToDef :: Class -> Function -> CStatement Identity
funcToDef Class
c Function
func
  | Function -> Bool
isNewFunc Function
func =
    let body :: [CStatement Identity]
body =
          [ forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
              (forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl (forall (f :: * -> *). CType f -> CType f
R.CTStar (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type"))) (String -> CName Identity
R.sname String
"newp"))
              (forall (f :: * -> *). CName f -> [CExp f] -> CExp f
R.CNew (String -> CName Identity
R.sname String
"Type") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Arg -> CExp Identity
argToCallCExp (Function -> [Arg]
genericFuncArgs Function
func)),
            forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$
              forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
                [forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"]), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type")]
                [forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"newp")]
          ]
     in forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition forall a. Maybe a
Nothing (Class -> Function -> CFunDecl Identity
funcToDecl Class
c Function
func) [CStatement Identity]
body
  | Function -> Bool
isDeleteFunc Function
func =
    let body :: [CStatement Identity]
body =
          [ forall (f :: * -> *). CExp f -> CStatement f
R.CDelete forall a b. (a -> b) -> a -> b
$
              forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
                [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type"), forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"])]
                [forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"p")]
          ]
     in forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition forall a. Maybe a
Nothing (Class -> Function -> CFunDecl Identity
funcToDecl Class
c Function
func) [CStatement Identity]
body
  | Function -> Bool
isStaticFunc Function
func =
    let body :: [CStatement Identity]
body =
          IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
NonCPrim (Function -> Types
genericFuncRet Function
func) forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname (Class -> Function -> String
cppFuncName Class
c Function
func))) (forall a b. (a -> b) -> [a] -> [b]
map Arg -> CExp Identity
argToCallCExp (Function -> [Arg]
genericFuncArgs Function
func))
     in forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition forall a. Maybe a
Nothing (Class -> Function -> CFunDecl Identity
funcToDecl Class
c Function
func) [CStatement Identity]
body
  | Bool
otherwise =
    let caller :: CExp Identity
caller =
          forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
            COp
R.CArrow
            ( forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
                ( forall (f :: * -> *). CName f -> [CName f] -> CExp f
R.CEMacroApp
                    (String -> CName Identity
R.sname String
"TYPECASTMETHOD")
                    [String -> CName Identity
R.sname String
"Type", String -> CName Identity
R.sname (Class -> Function -> String
aliasedFuncName Class
c Function
func), String -> CName Identity
R.sname (Class -> String
class_name Class
c)]
                )
                [forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"p")]
            )
            (forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname (Class -> Function -> String
cppFuncName Class
c Function
func))) (forall a b. (a -> b) -> [a] -> [b]
map Arg -> CExp Identity
argToCallCExp (Function -> [Arg]
genericFuncArgs Function
func)))
        body :: [CStatement Identity]
body = IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
NonCPrim (Function -> Types
genericFuncRet Function
func) CExp Identity
caller
     in forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition forall a. Maybe a
Nothing (Class -> Function -> CFunDecl Identity
funcToDecl Class
c Function
func) [CStatement Identity]
body

-- template function declaration and definition

tmplFunToDecl ::
  IsCPrimitive ->
  TemplateClass ->
  TemplateFunction ->
  R.CFunDecl Identity
tmplFunToDecl :: IsCPrimitive
-> TemplateClass -> TemplateFunction -> CFunDecl Identity
tmplFunToDecl IsCPrimitive
b t :: TemplateClass
t@TmplCls {String
[String]
[TemplateFunction]
[Variable]
Cabal
Form
tclass_vars :: [Variable]
tclass_funcs :: [TemplateFunction]
tclass_params :: [String]
tclass_cxxform :: Form
tclass_name :: String
tclass_cabal :: Cabal
tclass_vars :: TemplateClass -> [Variable]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_params :: TemplateClass -> [String]
tclass_cxxform :: TemplateClass -> Form
tclass_name :: TemplateClass -> String
tclass_cabal :: TemplateClass -> Cabal
..} TemplateFunction
f =
  let nsuffix :: [NamePart f]
nsuffix = forall a. a -> [a] -> [a]
intersperse (forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). String -> NamePart f
R.NamePart [String]
tclass_params
   in case TemplateFunction
f of
        TFun {String
[Arg]
Types
tfun_args :: TemplateFunction -> [Arg]
tfun_oname :: TemplateFunction -> String
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
tfun_args :: [Arg]
tfun_oname :: String
tfun_name :: String
tfun_ret :: Types
..} ->
          let ret :: CType Identity
ret = IsCPrimitive -> Types -> CType Identity
tmplReturnCType IsCPrimitive
b Types
tfun_ret
              func :: CName f
func = forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix)
              args :: [(CType Identity, CName Identity)]
args = IsCPrimitive
-> Selfness
-> TemplateClass
-> [Arg]
-> [(CType Identity, CName Identity)]
tmplAllArgsToCTypVar IsCPrimitive
b Selfness
Self TemplateClass
t [Arg]
tfun_args
           in forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret forall {f :: * -> *}. CName f
func [(CType Identity, CName Identity)]
args
        TFunNew {[Arg]
Maybe String
tfun_new_alias :: TemplateFunction -> Maybe String
tfun_new_args :: TemplateFunction -> [Arg]
tfun_new_alias :: Maybe String
tfun_new_args :: [Arg]
..} ->
          let ret :: CType Identity
ret = IsCPrimitive -> Types -> CType Identity
tmplReturnCType IsCPrimitive
b (TemplateClass -> Types
TemplateType TemplateClass
t)
              func :: CName f
func = forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix)
              args :: [(CType Identity, CName Identity)]
args = IsCPrimitive
-> Selfness
-> TemplateClass
-> [Arg]
-> [(CType Identity, CName Identity)]
tmplAllArgsToCTypVar IsCPrimitive
b Selfness
NoSelf TemplateClass
t [Arg]
tfun_new_args
           in forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret forall {f :: * -> *}. CName f
func [(CType Identity, CName Identity)]
args
        TemplateFunction
TFunDelete ->
          let ret :: CType f
ret = forall (f :: * -> *). CType f
R.CTVoid
              func :: CName f
func = forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name forall a. Semigroup a => a -> a -> a
<> String
"_delete_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix)
              args :: [(CType Identity, CName Identity)]
args = IsCPrimitive
-> Selfness
-> TemplateClass
-> [Arg]
-> [(CType Identity, CName Identity)]
tmplAllArgsToCTypVar IsCPrimitive
b Selfness
Self TemplateClass
t []
           in forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl forall (f :: * -> *). CType f
ret forall {f :: * -> *}. CName f
func [(CType Identity, CName Identity)]
args
        TFunOp {String
OpExp
Types
tfun_opexp :: TemplateFunction -> OpExp
tfun_opexp :: OpExp
tfun_name :: String
tfun_ret :: Types
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..} ->
          let ret :: CType Identity
ret = IsCPrimitive -> Types -> CType Identity
tmplReturnCType IsCPrimitive
b Types
tfun_ret
              func :: CName f
func = forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name forall a. Semigroup a => a -> a -> a
<> String
"_" forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix)
              args :: [(CType Identity, CName Identity)]
args = IsCPrimitive
-> Selfness
-> TemplateClass
-> [Arg]
-> [(CType Identity, CName Identity)]
tmplAllArgsToCTypVar IsCPrimitive
b Selfness
Self TemplateClass
t (OpExp -> [Arg]
argsFromOpExp OpExp
tfun_opexp)
           in forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret forall {f :: * -> *}. CName f
func [(CType Identity, CName Identity)]
args

-- | top-level (bare) template function declaration
topLevelTemplateFunToDecl ::
  IsCPrimitive ->
  TLTemplate ->
  R.CFunDecl Identity
topLevelTemplateFunToDecl :: IsCPrimitive -> TLTemplate -> CFunDecl Identity
topLevelTemplateFunToDecl IsCPrimitive
b (TopLevelTemplateFunction {String
[String]
[Arg]
Types
topleveltfunc_args :: [Arg]
topleveltfunc_oname :: String
topleveltfunc_name :: String
topleveltfunc_ret :: Types
topleveltfunc_params :: [String]
topleveltfunc_args :: TLTemplate -> [Arg]
topleveltfunc_oname :: TLTemplate -> String
topleveltfunc_name :: TLTemplate -> String
topleveltfunc_ret :: TLTemplate -> Types
topleveltfunc_params :: TLTemplate -> [String]
..}) =
  let nsuffix :: [NamePart f]
nsuffix = forall a. a -> [a] -> [a]
intersperse (forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). String -> NamePart f
R.NamePart [String]
topleveltfunc_params
      ret :: CType Identity
ret = IsCPrimitive -> Types -> CType Identity
tmplReturnCType IsCPrimitive
b Types
topleveltfunc_ret
      func :: CName f
func = forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"TL_" forall a. Semigroup a => a -> a -> a
<> String
topleveltfunc_name forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix)
      args :: [(CType Identity, CName Identity)]
args = forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> (CType Identity, CName Identity)
tmplArgToCTypVar IsCPrimitive
b) [Arg]
topleveltfunc_args
   in forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret forall {f :: * -> *}. CName f
func [(CType Identity, CName Identity)]
args

-- | function definition in a template class
tmplFunToDef ::
  IsCPrimitive ->
  TemplateClass ->
  TemplateFunction ->
  R.CStatement Identity
tmplFunToDef :: IsCPrimitive
-> TemplateClass -> TemplateFunction -> CStatement Identity
tmplFunToDef IsCPrimitive
b t :: TemplateClass
t@TmplCls {String
[String]
[TemplateFunction]
[Variable]
Cabal
Form
tclass_vars :: [Variable]
tclass_funcs :: [TemplateFunction]
tclass_params :: [String]
tclass_cxxform :: Form
tclass_name :: String
tclass_cabal :: Cabal
tclass_vars :: TemplateClass -> [Variable]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_params :: TemplateClass -> [String]
tclass_cxxform :: TemplateClass -> Form
tclass_name :: TemplateClass -> String
tclass_cabal :: TemplateClass -> Cabal
..} TemplateFunction
f =
  forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition (forall a. a -> Maybe a
Just CQual
R.Inline) (IsCPrimitive
-> TemplateClass -> TemplateFunction -> CFunDecl Identity
tmplFunToDecl IsCPrimitive
b TemplateClass
t TemplateFunction
f) [CStatement Identity]
body
  where
    typparams :: [CType Identity]
typparams = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *). CName f -> CType f
R.CTSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CName Identity
R.sname) [String]
tclass_params
    body :: [CStatement Identity]
body =
      case TemplateFunction
f of
        TFunNew {[Arg]
Maybe String
tfun_new_alias :: Maybe String
tfun_new_args :: [Arg]
tfun_new_alias :: TemplateFunction -> Maybe String
tfun_new_args :: TemplateFunction -> [Arg]
..} ->
          let caller :: CExp Identity
caller =
                case Form
tclass_cxxform of
                  FormSimple String
tclass ->
                    forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTNew
                      (String -> CName Identity
R.sname String
tclass)
                      [CType Identity]
typparams
                      (forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> CExp Identity
tmplArgToCallCExp IsCPrimitive
b) [Arg]
tfun_new_args)
                  FormNested String
tclass String
inner ->
                    forall (f :: * -> *).
CName f -> CName f -> [CType f] -> [CExp f] -> CExp f
R.CTNewI
                      (String -> CName Identity
R.sname String
tclass)
                      (String -> CName Identity
R.sname String
inner)
                      [CType Identity]
typparams
                      (forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> CExp Identity
tmplArgToCallCExp IsCPrimitive
b) [Arg]
tfun_new_args)
           in [forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp (String -> CName Identity
R.sname String
"static_cast") [forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid] [CExp Identity
caller]]
        TemplateFunction
TFunDelete ->
          [ forall (f :: * -> *). CExp f -> CStatement f
R.CDelete forall a b. (a -> b) -> a -> b
$
              forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                (String -> CName Identity
R.sname String
"static_cast")
                [forall (f :: * -> *). CType f -> CType f
R.CTStar forall a b. (a -> b) -> a -> b
$ Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm Form
tclass_cxxform [CType Identity]
typparams]
                [forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"p")]
          ]
        TFun {String
[Arg]
Types
tfun_args :: [Arg]
tfun_oname :: String
tfun_name :: String
tfun_ret :: Types
tfun_args :: TemplateFunction -> [Arg]
tfun_oname :: TemplateFunction -> String
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..} ->
          IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
b (Types
tfun_ret) forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
              COp
R.CArrow
              ( forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                  (String -> CName Identity
R.sname String
"static_cast")
                  [forall (f :: * -> *). CType f -> CType f
R.CTStar forall a b. (a -> b) -> a -> b
$ Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm Form
tclass_cxxform [CType Identity]
typparams]
                  [forall (f :: * -> *). CName f -> CExp f
R.CVar forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"p"]
              )
              ( forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
                  (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
tfun_oname))
                  (forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> CExp Identity
tmplArgToCallCExp IsCPrimitive
b) [Arg]
tfun_args)
              )
        TFunOp {String
OpExp
Types
tfun_opexp :: OpExp
tfun_name :: String
tfun_ret :: Types
tfun_opexp :: TemplateFunction -> OpExp
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..} ->
          IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
b (Types
tfun_ret) forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
              COp
R.CArrow
              ( forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                  (String -> CName Identity
R.sname String
"static_cast")
                  [forall (f :: * -> *). CType f -> CType f
R.CTStar forall a b. (a -> b) -> a -> b
$ Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm Form
tclass_cxxform [CType Identity]
typparams]
                  [forall (f :: * -> *). CName f -> CExp f
R.CVar forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"p"]
              )
              ( forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
                  (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname (String
"operator" forall a. Semigroup a => a -> a -> a
<> OpExp -> String
opSymbol OpExp
tfun_opexp)))
                  (forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> CExp Identity
tmplArgToCallCExp IsCPrimitive
b) (OpExp -> [Arg]
argsFromOpExp OpExp
tfun_opexp))
              )

-- | function definition in a template class
topLevelTemplateFunToDef ::
  IsCPrimitive ->
  TLTemplate ->
  R.CStatement Identity
topLevelTemplateFunToDef :: IsCPrimitive -> TLTemplate -> CStatement Identity
topLevelTemplateFunToDef IsCPrimitive
b t :: TLTemplate
t@TopLevelTemplateFunction {String
[String]
[Arg]
Types
topleveltfunc_args :: [Arg]
topleveltfunc_oname :: String
topleveltfunc_name :: String
topleveltfunc_ret :: Types
topleveltfunc_params :: [String]
topleveltfunc_args :: TLTemplate -> [Arg]
topleveltfunc_oname :: TLTemplate -> String
topleveltfunc_name :: TLTemplate -> String
topleveltfunc_ret :: TLTemplate -> Types
topleveltfunc_params :: TLTemplate -> [String]
..} =
  forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition (forall a. a -> Maybe a
Just CQual
R.Inline) (IsCPrimitive -> TLTemplate -> CFunDecl Identity
topLevelTemplateFunToDecl IsCPrimitive
b TLTemplate
t) [CStatement Identity]
body
  where
    typparams :: [CType Identity]
typparams = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *). CName f -> CType f
R.CTSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CName Identity
R.sname) [String]
topleveltfunc_params
    body :: [CStatement Identity]
body =
      IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
b (Types
topleveltfunc_ret) forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
          (String -> CName Identity
R.sname String
topleveltfunc_oname)
          [CType Identity]
typparams
          (forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> CExp Identity
tmplArgToCallCExp IsCPrimitive
b) [Arg]
topleveltfunc_args)

-- |
tmplVarToDef ::
  IsCPrimitive ->
  TemplateClass ->
  Variable ->
  Accessor ->
  R.CStatement Identity
tmplVarToDef :: IsCPrimitive
-> TemplateClass -> Variable -> Accessor -> CStatement Identity
tmplVarToDef IsCPrimitive
b t :: TemplateClass
t@TmplCls {String
[String]
[TemplateFunction]
[Variable]
Cabal
Form
tclass_vars :: [Variable]
tclass_funcs :: [TemplateFunction]
tclass_params :: [String]
tclass_cxxform :: Form
tclass_name :: String
tclass_cabal :: Cabal
tclass_vars :: TemplateClass -> [Variable]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_params :: TemplateClass -> [String]
tclass_cxxform :: TemplateClass -> Form
tclass_name :: TemplateClass -> String
tclass_cabal :: TemplateClass -> Cabal
..} v :: Variable
v@(Variable (Arg {String
Types
arg_name :: Arg -> String
arg_type :: Arg -> Types
arg_name :: String
arg_type :: Types
..})) Accessor
a =
  forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition (forall a. a -> Maybe a
Just CQual
R.Inline) (IsCPrimitive
-> TemplateClass -> TemplateFunction -> CFunDecl Identity
tmplFunToDecl IsCPrimitive
b TemplateClass
t TemplateFunction
f) [CStatement Identity]
body
  where
    f :: TemplateFunction
f = Variable -> Accessor -> TemplateFunction
tmplAccessorToTFun Variable
v Accessor
a
    typparams :: [CType Identity]
typparams = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *). CName f -> CType f
R.CTSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CName Identity
R.sname) [String]
tclass_params
    body :: [CStatement Identity]
body =
      case TemplateFunction
f of
        TFun {String
[Arg]
Types
tfun_args :: [Arg]
tfun_oname :: String
tfun_name :: String
tfun_ret :: Types
tfun_args :: TemplateFunction -> [Arg]
tfun_oname :: TemplateFunction -> String
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..} ->
          let varexp :: CExp Identity
varexp =
                forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
                  COp
R.CArrow
                  ( forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                      (String -> CName Identity
R.sname String
"static_cast")
                      [forall (f :: * -> *). CType f -> CType f
R.CTStar forall a b. (a -> b) -> a -> b
$ Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm Form
tclass_cxxform [CType Identity]
typparams]
                      [forall (f :: * -> *). CName f -> CExp f
R.CVar forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"p"]
                  )
                  (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
arg_name))
           in case Accessor
a of
                Accessor
Getter -> IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
b (Types
tfun_ret) CExp Identity
varexp
                Accessor
Setter ->
                  [ forall (f :: * -> *). CExp f -> CStatement f
R.CExpSA forall a b. (a -> b) -> a -> b
$
                      forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
                        COp
R.CAssign
                        CExp Identity
varexp
                        (Types -> CExp Identity -> CExp Identity
c2Cxx Types
arg_type (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"value")))
                  ]
        TemplateFunction
_ -> forall a. HasCallStack => String -> a
error String
"tmplVarToDef: should not happen"

-- Accessor Declaration and Definition

accessorToDecl :: Variable -> Accessor -> R.CFunDecl Identity
accessorToDecl :: Variable -> Accessor -> CFunDecl Identity
accessorToDecl Variable
v Accessor
a =
  let csig :: CFunSig
csig = Types -> Accessor -> CFunSig
accessorCFunSig (Arg -> Types
arg_type (Variable -> Arg
unVariable Variable
v)) Accessor
a
      ret :: CType Identity
ret = Types -> CType Identity
returnCType (CFunSig -> Types
cRetType CFunSig
csig)
      fname :: CName f
fname =
        forall (f :: * -> *). [NamePart f] -> CName f
R.CName
          [ forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type",
            forall (f :: * -> *). String -> NamePart f
R.NamePart
              ( String
"_"
                  forall a. Semigroup a => a -> a -> a
<> Arg -> String
arg_name (Variable -> Arg
unVariable Variable
v)
                  forall a. Semigroup a => a -> a -> a
<> String
"_"
                  forall a. Semigroup a => a -> a -> a
<> case Accessor
a of Accessor
Getter -> String
"get"; Accessor
Setter -> String
"set"
              )
          ]
      args :: [(CType Identity, CName Identity)]
args = [Arg] -> [(CType Identity, CName Identity)]
argsToCTypVar (CFunSig -> [Arg]
cArgTypes CFunSig
csig)
   in forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret forall {f :: * -> *}. CName f
fname [(CType Identity, CName Identity)]
args

accessorsToDecls :: [Variable] -> [R.CFunDecl Identity]
accessorsToDecls :: [Variable] -> [CFunDecl Identity]
accessorsToDecls [Variable]
vs =
  forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Variable
v -> [Variable -> Accessor -> CFunDecl Identity
accessorToDecl Variable
v Accessor
Getter, Variable -> Accessor -> CFunDecl Identity
accessorToDecl Variable
v Accessor
Setter]) [Variable]
vs

accessorToDef :: Variable -> Accessor -> R.CStatement Identity
accessorToDef :: Variable -> Accessor -> CStatement Identity
accessorToDef Variable
v Accessor
a =
  let varexp :: CExp Identity
varexp =
        forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
          COp
R.CArrow
          ( forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
              (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
              [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type"), forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"])]
              [forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"p")]
          )
          (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname (Arg -> String
arg_name (Variable -> Arg
unVariable Variable
v))))
      body :: Accessor -> CStatement Identity
body Accessor
Getter = forall (f :: * -> *). CExp f -> CStatement f
R.CReturn forall a b. (a -> b) -> a -> b
$ Types -> CExp Identity -> CExp Identity
cxx2C (Arg -> Types
arg_type (Variable -> Arg
unVariable Variable
v)) CExp Identity
varexp
      body Accessor
Setter =
        forall (f :: * -> *). CExp f -> CStatement f
R.CExpSA forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
            COp
R.CAssign
            CExp Identity
varexp
            (Types -> CExp Identity -> CExp Identity
c2Cxx (Arg -> Types
arg_type (Variable -> Arg
unVariable Variable
v)) (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"x")))
   in forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition forall a. Maybe a
Nothing (Variable -> Accessor -> CFunDecl Identity
accessorToDecl Variable
v Accessor
a) [Accessor -> CStatement Identity
body Accessor
a]

-- Template Member Function Declaration and Definition

-- TODO: Handle simple type
tmplMemberFunToDecl :: Class -> TemplateMemberFunction -> R.CFunDecl Identity
tmplMemberFunToDecl :: Class -> TemplateMemberFunction -> CFunDecl Identity
tmplMemberFunToDecl Class
c TemplateMemberFunction
f =
  let nsuffix :: [NamePart f]
nsuffix = forall a. a -> [a] -> [a]
intersperse (forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *). String -> NamePart f
R.NamePart (TemplateMemberFunction -> [String]
tmf_params TemplateMemberFunction
f)
      ret :: CType Identity
ret = Class -> Types -> CType Identity
tmplMemFuncReturnCType Class
c (TemplateMemberFunction -> Types
tmf_ret TemplateMemberFunction
f)
      fname :: CName f
fname =
        forall (f :: * -> *). [NamePart f] -> CName f
R.CName (forall (f :: * -> *). String -> NamePart f
R.NamePart (Class -> TemplateMemberFunction -> String
hsTemplateMemberFunctionName Class
c TemplateMemberFunction
f forall a. Semigroup a => a -> a -> a
<> String
"_") forall a. a -> [a] -> [a]
: forall {f :: * -> *}. [NamePart f]
nsuffix)
      args :: [(CType Identity, CName Identity)]
args = forall a b. (a -> b) -> [a] -> [b]
map (Class -> Arg -> (CType Identity, CName Identity)
tmplMemFuncArgToCTypVar Class
c) ((Types -> String -> Arg
Arg Types
SelfType String
"p") forall a. a -> [a] -> [a]
: TemplateMemberFunction -> [Arg]
tmf_args TemplateMemberFunction
f)
   in forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret forall {f :: * -> *}. CName f
fname [(CType Identity, CName Identity)]
args

-- TODO: Handle simple type
tmplMemberFunToDef :: Class -> TemplateMemberFunction -> R.CStatement Identity
tmplMemberFunToDef :: Class -> TemplateMemberFunction -> CStatement Identity
tmplMemberFunToDef Class
c TemplateMemberFunction
f =
  forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition (forall a. a -> Maybe a
Just CQual
R.Inline) (Class -> TemplateMemberFunction -> CFunDecl Identity
tmplMemberFunToDecl Class
c TemplateMemberFunction
f) [CStatement Identity]
body
  where
    tparams :: [CType Identity]
tparams = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *). CName f -> CType f
R.CTSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CName Identity
R.sname) (TemplateMemberFunction -> [String]
tmf_params TemplateMemberFunction
f)
    body :: [CStatement Identity]
body =
      IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
NonCPrim (TemplateMemberFunction -> Types
tmf_ret TemplateMemberFunction
f) forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
          COp
R.CArrow
          ( forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
              (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
              [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c)), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_t"))]
              [forall (f :: * -> *). CName f -> CExp f
R.CVar forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"p"]
          )
          ( forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
              (String -> CName Identity
R.sname (TemplateMemberFunction -> String
tmf_name TemplateMemberFunction
f))
              [CType Identity]
tparams
              (forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> CExp Identity
tmplArgToCallCExp IsCPrimitive
NonCPrim) (TemplateMemberFunction -> [Arg]
tmf_args TemplateMemberFunction
f))
          )