{-# 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 Data.Monoid           ( (<>) )
--
import qualified FFICXX.Runtime.CodeGen.Cxx as R
import FFICXX.Runtime.TH     ( IsCPrimitive(CPrim, NonCPrim) )
--
import FFICXX.Generate.Code.Primitive
                                    ( accessorCFunSig
                                    , argToCallCExp
                                    , argsToCTypVar
                                    , argsToCTypVarNoSelf
                                    , c2Cxx
                                    , cxx2C
                                    , CFunSig(..)
                                    , genericFuncArgs
                                    , genericFuncRet
                                    , returnCType
                                    , tmplAccessorToTFun
                                    , tmplAllArgsToCTypVar
                                    , tmplAppTypeFromForm
                                    , tmplArgToCallCExp
                                    , tmplMemFuncArgToCTypVar
                                    , tmplMemFuncReturnCType
                                    , tmplReturnCType
                                    )
import FFICXX.Generate.Name         ( aliasedFuncName
                                    , cppFuncName
                                    , ffiClassName
                                    , ffiTmplFuncName
                                    , hsTemplateMemberFunctionName
                                    )
import FFICXX.Generate.Type.Class   ( Accessor(Getter,Setter)
                                    , Arg(..)
                                    , Class(..)
                                    , CPPTypes(..)
                                    , CTypes(..)
                                    , Form(FormSimple,FormNested)
                                    , Function(..)
                                    , IsConst(Const,NoConst)
                                    , Selfness(NoSelf,Self)
                                    , TemplateAppInfo(..)
                                    , TemplateClass(..)
                                    , TemplateFunction(..)
                                    , TemplateMemberFunction(..)
                                    , TopLevel(..)
                                    , Types(..)
                                    , Variable(..)
                                    , argsFromOpExp
                                    , isDeleteFunc
                                    , isNewFunc
                                    , isStaticFunc
                                    , isVirtualFunc
                                    , opSymbol
                                    , virtualFuncs
                                    )
import FFICXX.Generate.Type.Module  ( ClassImportHeader(..) )
import FFICXX.Generate.Util         ( toUppers )

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

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

---- "Class Type Declaration" Instances

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


genCppHeaderMacroType :: Class -> [R.CStatement Identity]
genCppHeaderMacroType :: Class -> [CStatement Identity]
genCppHeaderMacroType Class
c =
    [ String -> CStatement Identity
forall (f :: * -> *). String -> CStatement f
R.Comment String
"Opaque type definition for $classname" ]
    [CStatement Identity]
-> [CStatement Identity] -> [CStatement Identity]
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 = (CFunDecl Identity -> CStatement Identity)
-> [CFunDecl Identity] -> [CStatement Identity]
forall a b. (a -> b) -> [a] -> [b]
map CFunDecl Identity -> CStatement Identity
forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration
                ([CFunDecl Identity] -> [CStatement Identity])
-> (Class -> [CFunDecl Identity]) -> Class -> [CStatement Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Function -> CFunDecl Identity)
-> [Function] -> [CFunDecl Identity]
forall a b. (a -> b) -> [a] -> [b]
map (Class -> Function -> CFunDecl Identity
funcToDecl Class
aclass)
                ([Function] -> [CFunDecl Identity])
-> (Class -> [Function]) -> Class -> [CFunDecl Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Function] -> [Function]
virtualFuncs
                ([Function] -> [Function])
-> (Class -> [Function]) -> Class -> [Function]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Function]
class_funcs
                (Class -> [CStatement Identity]) -> Class -> [CStatement Identity]
forall a b. (a -> b) -> a -> b
$ Class
aclass
      macrocname :: String
macrocname = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
aclass)
      macroname :: String
macroname = String
macrocname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DECL_VIRT"
  in CName Identity
-> [CName Identity] -> [CStatement Identity] -> CMacro Identity
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 = (CFunDecl Identity -> CStatement Identity)
-> [CFunDecl Identity] -> [CStatement Identity]
forall a b. (a -> b) -> [a] -> [b]
map CFunDecl Identity -> CStatement Identity
forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration
                ([CFunDecl Identity] -> [CStatement Identity])
-> (Class -> [CFunDecl Identity]) -> Class -> [CStatement Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Function -> CFunDecl Identity)
-> [Function] -> [CFunDecl Identity]
forall a b. (a -> b) -> [a] -> [b]
map (Class -> Function -> CFunDecl Identity
funcToDecl Class
c)
                ([Function] -> [CFunDecl Identity])
-> (Class -> [Function]) -> Class -> [CFunDecl Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Function -> Bool) -> [Function] -> [Function]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Function -> Bool) -> Function -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Function -> Bool
isVirtualFunc)
                ([Function] -> [Function])
-> (Class -> [Function]) -> Class -> [Function]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Function]
class_funcs
                (Class -> [CStatement Identity]) -> Class -> [CStatement Identity]
forall a b. (a -> b) -> a -> b
$ Class
c
      macrocname :: String
macrocname = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
c)
      macroname :: String
macroname = String
macrocname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DECL_NONVIRT"
  in CName Identity
-> [CName Identity] -> [CStatement Identity] -> CMacro Identity
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  = (CFunDecl Identity -> CStatement Identity)
-> [CFunDecl Identity] -> [CStatement Identity]
forall a b. (a -> b) -> [a] -> [b]
map CFunDecl Identity -> CStatement Identity
forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration ([CFunDecl Identity] -> [CStatement Identity])
-> [CFunDecl Identity] -> [CStatement Identity]
forall a b. (a -> b) -> a -> b
$ [Variable] -> [CFunDecl Identity]
accessorsToDecls (Class -> [Variable]
class_vars Class
c)
      macrocname :: String
macrocname = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
c)
      macroname :: String
macroname  = String
macrocname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DECL_ACCESSOR"
  in CName Identity
-> [CName Identity] -> [CStatement Identity] -> CMacro Identity
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 = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
p) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DECL_VIRT"
  in CName Identity -> [CName Identity] -> CStatement Identity
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 = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
c) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DECL_NONVIRT"
  in CName Identity -> [CName Identity] -> CStatement Identity
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 = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
c) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DECL_ACCESSOR"
  in CName Identity -> [CName Identity] -> CStatement Identity
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 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"
                 ([String] -> String) -> (Class -> [String]) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Function -> String) -> [Function] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (CStatement Identity -> String
R.renderCStmt (CStatement Identity -> String)
-> (Function -> CStatement Identity) -> Function -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Function -> CStatement Identity
funcToDef Class
aclass)
                 ([Function] -> [String])
-> (Class -> [Function]) -> Class -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Function] -> [Function]
virtualFuncs
                 ([Function] -> [Function])
-> (Class -> [Function]) -> Class -> [Function]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Function]
class_funcs
                 (Class -> String) -> Class -> String
forall a b. (a -> b) -> a -> b
$ Class
aclass
      macrocname :: String
macrocname = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
aclass)
      macroname :: String
macroname = String
macrocname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DEF_VIRT"
  in CName Identity
-> [CName Identity] -> [CStatement Identity] -> CMacro Identity
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"] [ String -> CStatement Identity
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 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"
                 ([String] -> String) -> (Class -> [String]) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Function -> String) -> [Function] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (CStatement Identity -> String
R.renderCStmt (CStatement Identity -> String)
-> (Function -> CStatement Identity) -> Function -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Function -> CStatement Identity
funcToDef Class
aclass)
                 ([Function] -> [String])
-> (Class -> [Function]) -> Class -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Function -> Bool) -> [Function] -> [Function]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Function -> Bool) -> Function -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Function -> Bool
isVirtualFunc)
                 ([Function] -> [Function])
-> (Class -> [Function]) -> Class -> [Function]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Function]
class_funcs
                 (Class -> String) -> Class -> String
forall a b. (a -> b) -> a -> b
$ Class
aclass
      macrocname :: String
macrocname = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
aclass)
      macroname :: String
macroname = String
macrocname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DEF_NONVIRT"
  in CName Identity
-> [CName Identity] -> [CStatement Identity] -> CMacro Identity
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"] [ String -> CStatement Identity
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 = (Variable -> [CStatement Identity])
-> [Variable] -> [CStatement Identity]
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 = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
c)
      macroname :: String
macroname = String
macrocname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DEF_ACCESSOR"
  in CName Identity
-> [CName Identity] -> [CStatement Identity] -> CMacro Identity
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 =
   CName Identity
-> [CName Identity] -> [CStatement Identity] -> CMacro Identity
forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define (String -> CName Identity
R.sname String
macroname) ((String -> CName Identity) -> [String] -> [CName Identity]
forall a b. (a -> b) -> [a] -> [b]
map String -> CName Identity
R.sname (TemplateMemberFunction -> [String]
tmf_params TemplateMemberFunction
f))
     [ [CStatement Identity] -> CStatement Identity
forall (f :: * -> *). [CStatement f] -> CStatement f
R.CExtern [CFunDecl Identity -> CStatement Identity
forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration CFunDecl Identity
decl]
     , Class -> TemplateMemberFunction -> CStatement Identity
tmplMemberFunToDef Class
c TemplateMemberFunction
f
     , CStatement Identity
forall (f :: * -> *). CStatement f
autoinst
     ]
  where
    nsuffix :: [NamePart f]
nsuffix = NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
intersperse (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") ([NamePart f] -> [NamePart f]) -> [NamePart f] -> [NamePart f]
forall a b. (a -> b) -> a -> b
$ (String -> NamePart f) -> [String] -> [NamePart f]
forall a b. (a -> b) -> [a] -> [b]
map String -> NamePart f
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 =
      CVarDecl f -> CExp f -> CStatement f
forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
        (CType f -> CName f -> CVarDecl f
forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl
          CType f
forall (f :: * -> *). CType f
R.CTAuto
          ([NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"a_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
macroname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_") NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
: [NamePart f]
forall (f :: * -> *). [NamePart f]
nsuffix))
        )
        (CName f -> CExp f
forall (f :: * -> *). CName f -> CExp f
R.CVar ([NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
macroname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_") NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
: [NamePart f]
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 = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (Class -> String
ffiClassName Class
p) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DEF_VIRT"
  in CName Identity -> [CName Identity] -> CStatement Identity
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) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DEF_NONVIRT"
  in CName Identity -> [CName Identity] -> CStatement Identity
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) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_DEF_ACCESSOR"
  in CName Identity -> [CName Identity] -> CStatement Identity
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 =
  (HeaderName -> CMacro Identity)
-> [HeaderName] -> [CMacro Identity]
forall a b. (a -> b) -> [a] -> [b]
map HeaderName -> CMacro Identity
forall (f :: * -> *). HeaderName -> CMacro f
R.Include (ClassImportHeader -> [HeaderName]
cihIncludedHPkgHeadersInCPP ClassImportHeader
header [HeaderName] -> [HeaderName] -> [HeaderName]
forall a. Semigroup a => a -> a -> a
<> ClassImportHeader -> [HeaderName]
cihIncludedCPkgHeaders ClassImportHeader
header)

----

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

topLevelDecl :: TopLevel -> R.CFunDecl Identity
topLevelDecl :: TopLevel -> CFunDecl Identity
topLevelDecl TopLevelFunction {String
[Arg]
Maybe String
Types
toplevelfunc_alias :: TopLevel -> Maybe String
toplevelfunc_args :: TopLevel -> [Arg]
toplevelfunc_name :: TopLevel -> String
toplevelfunc_ret :: TopLevel -> Types
toplevelfunc_alias :: Maybe String
toplevelfunc_args :: [Arg]
toplevelfunc_name :: String
toplevelfunc_ret :: Types
..} = CType Identity
-> CName Identity
-> [(CType Identity, CName Identity)]
-> CFunDecl Identity
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_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
toplevelfunc_name String -> String
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 :: TopLevel -> Maybe String
toplevelvar_name :: TopLevel -> String
toplevelvar_ret :: TopLevel -> Types
toplevelvar_alias :: Maybe String
toplevelvar_name :: String
toplevelvar_ret :: Types
..} = CType Identity
-> CName Identity
-> [(CType Identity, CName Identity)]
-> CFunDecl Identity
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_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
toplevelvar_name String -> String
forall a. a -> a
id Maybe String
toplevelvar_alias)

genTopLevelCppDefinition :: TopLevel -> R.CStatement Identity
genTopLevelCppDefinition :: TopLevel -> CStatement Identity
genTopLevelCppDefinition tf :: TopLevel
tf@TopLevelFunction {String
[Arg]
Maybe String
Types
toplevelfunc_alias :: Maybe String
toplevelfunc_args :: [Arg]
toplevelfunc_name :: String
toplevelfunc_ret :: Types
toplevelfunc_alias :: TopLevel -> Maybe String
toplevelfunc_args :: TopLevel -> [Arg]
toplevelfunc_name :: TopLevel -> String
toplevelfunc_ret :: TopLevel -> Types
..} =
  let decl :: CFunDecl Identity
decl = TopLevel -> CFunDecl Identity
topLevelDecl TopLevel
tf
      body :: [CStatement Identity]
body = IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp
               IsCPrimitive
NonCPrim
               (Types
toplevelfunc_ret)
               (CExp Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
toplevelfunc_name)) ((Arg -> CExp Identity) -> [Arg] -> [CExp Identity]
forall a b. (a -> b) -> [a] -> [b]
map Arg -> CExp Identity
argToCallCExp [Arg]
toplevelfunc_args))
  in Maybe CQual
-> CFunDecl Identity
-> [CStatement Identity]
-> CStatement Identity
forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition Maybe CQual
forall a. Maybe a
Nothing CFunDecl Identity
decl [CStatement Identity]
body
genTopLevelCppDefinition tv :: TopLevel
tv@TopLevelVariable {String
Maybe String
Types
toplevelvar_alias :: Maybe String
toplevelvar_name :: String
toplevelvar_ret :: Types
toplevelvar_alias :: TopLevel -> Maybe String
toplevelvar_name :: TopLevel -> String
toplevelvar_ret :: TopLevel -> Types
..} =
  let decl :: CFunDecl Identity
decl = TopLevel -> CFunDecl Identity
topLevelDecl TopLevel
tv
      body :: [CStatement Identity]
body = IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
NonCPrim (Types
toplevelvar_ret) (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
toplevelvar_name))
  in Maybe CQual
-> CFunDecl Identity
-> [CStatement Identity]
-> CStatement Identity
forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition Maybe CQual
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 =
    CName Identity
-> [CName Identity] -> [CStatement Identity] -> CMacro Identity
forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define (String -> CName Identity
R.sname String
macroname) ((String -> CName Identity) -> [String] -> [CName Identity]
forall a b. (a -> b) -> [a] -> [b]
map String -> CName Identity
R.sname (String
"callmod" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
tclass_params))
      [ [CStatement Identity] -> CStatement Identity
forall (f :: * -> *). [CStatement f] -> CStatement f
R.CExtern [CFunDecl Identity -> CStatement Identity
forall (f :: * -> *). CFunDecl f -> CStatement f
R.CDeclaration CFunDecl Identity
decl]
      , IsCPrimitive
-> TemplateClass -> TemplateFunction -> CStatement Identity
tmplFunToDef IsCPrimitive
b TemplateClass
t TemplateFunction
f
      , CStatement Identity
forall (f :: * -> *). CStatement f
autoinst
      ]
 where
  nsuffix :: [NamePart f]
nsuffix = NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
intersperse (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") ([NamePart f] -> [NamePart f]) -> [NamePart f] -> [NamePart f]
forall a b. (a -> b) -> a -> b
$ (String -> NamePart f) -> [String] -> [NamePart f]
forall a b. (a -> b) -> [a] -> [b]
map String -> NamePart f
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 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
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 =
    CVarDecl f -> CExp f -> CStatement f
forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
      (CType f -> CName f -> CVarDecl f
forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl
        CType f
forall (f :: * -> *). CType f
R.CTAuto
        ([NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"a_" NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
: String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"callmod" NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
: String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tclass_name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_") NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
: [NamePart f]
forall (f :: * -> *). [NamePart f]
nsuffix ))
      )
      (CName f -> CExp f
forall (f :: * -> *). CName f -> CExp f
R.CVar ([NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_") NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
: [NamePart f]
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 {String
Types
arg_name :: Arg -> String
arg_type :: Arg -> Types
arg_name :: String
arg_type :: Types
..})) =
    [ Variable -> Accessor -> CMacro Identity
gen Variable
var Accessor
Getter, Variable -> Accessor -> CMacro Identity
gen Variable
var Accessor
Setter ]
  where
    nsuffix :: [NamePart f]
nsuffix = NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
intersperse (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") ([NamePart f] -> [NamePart f]) -> [NamePart f] -> [NamePart f]
forall a b. (a -> b) -> a -> b
$ (String -> NamePart f) -> [String] -> [NamePart f]
forall a b. (a -> b) -> [a] -> [b]
map String -> NamePart f
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 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix
      in CName Identity
-> [CName Identity] -> [CStatement Identity] -> CMacro Identity
forall (f :: * -> *).
CName f -> [CName f] -> [CStatement f] -> CMacro f
R.Define (String -> CName Identity
R.sname String
macroname) ((String -> CName Identity) -> [String] -> [CName Identity]
forall a b. (a -> b) -> [a] -> [b]
map String -> CName Identity
R.sname (String
"callmod" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
tclass_params))
           [ [CStatement Identity] -> CStatement Identity
forall (f :: * -> *). [CStatement f] -> CStatement f
R.CExtern [CFunDecl Identity -> CStatement Identity
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
           , CVarDecl Identity -> CExp Identity -> CStatement Identity
forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
               (CType Identity -> CName Identity -> CVarDecl Identity
forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl
                 CType Identity
forall (f :: * -> *). CType f
R.CTAuto
                 ([NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName (String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"a_" NamePart Identity -> [NamePart Identity] -> [NamePart Identity]
forall a. a -> [a] -> [a]
: String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"callmod" NamePart Identity -> [NamePart Identity] -> [NamePart Identity]
forall a. a -> [a] -> [a]
: String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tclass_name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_") NamePart Identity -> [NamePart Identity] -> [NamePart Identity]
forall a. a -> [a] -> [a]
: [NamePart Identity]
forall (f :: * -> *). [NamePart f]
nsuffix ))
           )
               (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar ([NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName (String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_") NamePart Identity -> [NamePart Identity] -> [NamePart Identity]
forall a. a -> [a] -> [a]
: [NamePart Identity]
forall (f :: * -> *). [NamePart f]
nsuffix )))
           ]

-- |
genTmplClassCpp ::
     IsCPrimitive
  -> TemplateClass
  -> ([TemplateFunction],[Variable]) -- ^ (member functions, member accessors)
  -> 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) =
    CName Identity
-> [CName Identity] -> [CStatement Identity] -> CMacro Identity
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 = (String -> CName Identity) -> [String] -> [CName Identity]
forall a b. (a -> b) -> [a] -> [b]
map String -> CName Identity
R.sname (String
"callmod" String -> [String] -> [String]
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 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_instance" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix
  macro1 :: TemplateFunction -> CStatement Identity
macro1 f :: TemplateFunction
f@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
..}    = CName Identity -> [CName Identity] -> CStatement Identity
forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname (String
tname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix)) [CName Identity]
params
  macro1 f :: TemplateFunction
f@TFunNew {[Arg]
Maybe String
tfun_new_alias :: TemplateFunction -> Maybe String
tfun_new_args :: TemplateFunction -> [Arg]
tfun_new_alias :: Maybe String
tfun_new_args :: [Arg]
..} = CName Identity -> [CName Identity] -> CStatement Identity
forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname (String
tname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix)) [CName Identity]
params
  macro1 TemplateFunction
TFunDelete     = CName Identity -> [CName Identity] -> CStatement Identity
forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname (String
tname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_delete" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix)) [CName Identity]
params
  macro1 f :: TemplateFunction
f@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
..}  = CName Identity -> [CName Identity] -> CStatement Identity
forall (f :: * -> *). CName f -> [CName f] -> CStatement f
R.CMacroApp (String -> CName Identity
R.sname (String
tname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix)) [CName Identity]
params
  body :: [CStatement Identity]
body =    (TemplateFunction -> CStatement Identity)
-> [TemplateFunction] -> [CStatement Identity]
forall a b. (a -> b) -> [a] -> [b]
map TemplateFunction -> CStatement Identity
macro1 [TemplateFunction]
fs
         [CStatement Identity]
-> [CStatement Identity] -> [CStatement Identity]
forall a. [a] -> [a] -> [a]
++ ((TemplateFunction -> CStatement Identity)
-> [TemplateFunction] -> [CStatement Identity]
forall a b. (a -> b) -> [a] -> [b]
map TemplateFunction -> CStatement Identity
macro1 ([TemplateFunction] -> [CStatement Identity])
-> ([Variable] -> [TemplateFunction])
-> [Variable]
-> [CStatement Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Variable -> [TemplateFunction])
-> [Variable] -> [TemplateFunction]
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 ->
      [ CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CExpSA CExp Identity
caller ]
    Types
SelfType ->
      [CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
        CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
          (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
          [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple ([NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [ String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t" ])
          , CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type") ]
          [ CType Identity -> CExp Identity -> CExp Identity
forall (f :: * -> *). CType f -> CExp f -> CExp f
R.CCast (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type"))) CExp Identity
caller ]
      ]
    CT (CRef CTypes
_) IsConst
_ ->
      [CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$ CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CAddr CExp Identity
caller ]
    CT CTypes
_ IsConst
_ ->
      [CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn CExp Identity
caller ]
    CPT (CPTClass Class
c') IsConst
isconst ->
      [CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
        CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
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" 
          )
          [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_t")), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str) ]
          [ CType Identity -> CExp Identity -> CExp Identity
forall (f :: * -> *). CType f -> CExp f -> CExp f
R.CCast (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (CName Identity -> CType Identity
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 ->
      [CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
        CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
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"
          )
          [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_t")), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str) ]
          [ CExp Identity -> CExp Identity
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 ->
      [CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
        CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
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"
          )
          [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_t")), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str) ]
          [ CName Identity -> [CExp Identity] -> CExp Identity
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.
      [CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
        CExp Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
          (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"std::move"))
          [CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
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"
            )
            [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_t")), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str) ]
            [ CExp Identity -> CExp Identity
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) ->
      [ CVarDecl Identity -> CExp Identity -> CStatement Identity
forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
          (CType Identity -> CName Identity -> CVarDecl Identity
forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (String -> CType Identity
forall (f :: * -> *). String -> CType f
R.CTVerbatim String
cpptype)) (String -> CName Identity
R.sname String
"r"))
          (CName Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CExp f] -> CExp f
R.CNew (String -> CName Identity
R.sname String
cpptype) [ CExp Identity
caller ])
      , CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
          CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
            (String -> CName Identity
R.sname String
"static_cast")
            [ CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid ]
            [ CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"r") ]
      ]
    TemplateAppRef (TemplateAppInfo TemplateClass
_ [TemplateArgType]
_ String
cpptype) ->
      [ CVarDecl Identity -> CExp Identity -> CStatement Identity
forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
          (CType Identity -> CName Identity -> CVarDecl Identity
forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (String -> CType Identity
forall (f :: * -> *). String -> CType f
R.CTVerbatim String
cpptype)) (String -> CName Identity
R.sname String
"r"))
          (CName Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CExp f] -> CExp f
R.CNew (String -> CName Identity
R.sname String
cpptype) [ CExp Identity
caller ])
      , CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
          CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
            (String -> CName Identity
R.sname String
"static_cast")
            [ CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid ]
            [ CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"r") ]
      ]
    TemplateAppMove (TemplateAppInfo TemplateClass
_ [TemplateArgType]
_ String
cpptype) ->
      [ CVarDecl Identity -> CExp Identity -> CStatement Identity
forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
          (CType Identity -> CName Identity -> CVarDecl Identity
forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (String -> CType Identity
forall (f :: * -> *). String -> CType f
R.CTVerbatim String
cpptype)) (String -> CName Identity
R.sname String
"r"))
          (CName Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CExp f] -> CExp f
R.CNew (String -> CName Identity
R.sname String
cpptype) [ CExp Identity
caller ])
      , CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
          CExp Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
            (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"std::move"))
            [CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
              (String -> CName Identity
R.sname String
"staic_cast")
              [ CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid ]
              [ CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"r") ]
            ]
      ]
    TemplateType TemplateClass
_ ->
      String -> [CStatement Identity]
forall a. HasCallStack => String -> a
error String
"returnCpp: TemplateType"
    TemplateParam String
typ ->
      [ CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
          case IsCPrimitive
b of
            IsCPrimitive
CPrim    -> CExp Identity
caller
            IsCPrimitive
NonCPrim ->
              CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
                [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple ([NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [ String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
typ, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t" ]), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
typ) ]
                [ CType Identity -> CExp Identity -> CExp Identity
forall (f :: * -> *). CType f -> CExp f -> CExp f
R.CCast (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
typ))) (CExp Identity -> CExp Identity) -> CExp Identity -> CExp Identity
forall a b. (a -> b) -> a -> b
$ CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CAddr CExp Identity
caller ]
      ]
    TemplateParamPointer String
typ ->
      [ CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
          case IsCPrimitive
b of
            IsCPrimitive
CPrim    -> CExp Identity
caller
            IsCPrimitive
NonCPrim ->
              CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
                [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple ([NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [ String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
typ, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"]), CName Identity -> CType Identity
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 =
          [NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"_" String -> String -> 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 CType Identity
-> CName Identity
-> [(CType Identity, CName Identity)]
-> CFunDecl Identity
forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret CName Identity
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 =
          [NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
"_" String -> String -> 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 CType Identity
-> CName Identity
-> [(CType Identity, CName Identity)]
-> CFunDecl Identity
forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret CName Identity
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 = [ CVarDecl Identity -> CExp Identity -> CStatement Identity
forall (f :: * -> *). CVarDecl f -> CExp f -> CStatement f
R.CInit
                   (CType Identity -> CName Identity -> CVarDecl Identity
forall (f :: * -> *). CType f -> CName f -> CVarDecl f
R.CVarDecl (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type"))) (String -> CName Identity
R.sname String
"newp"))
                   (CName Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CExp f] -> CExp f
R.CNew (String -> CName Identity
R.sname String
"Type") ([CExp Identity] -> CExp Identity)
-> [CExp Identity] -> CExp Identity
forall a b. (a -> b) -> a -> b
$ (Arg -> CExp Identity) -> [Arg] -> [CExp Identity]
forall a b. (a -> b) -> [a] -> [b]
map Arg -> CExp Identity
argToCallCExp (Function -> [Arg]
genericFuncArgs Function
func))
               , CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
                   CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                     (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
                     [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple ([NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [ String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"]), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type") ]
                     [ CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"newp") ]
               ]
    in Maybe CQual
-> CFunDecl Identity
-> [CStatement Identity]
-> CStatement Identity
forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition Maybe CQual
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 = [ CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CDelete (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
                   CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                     (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
                     [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type"), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple ([NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [ String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t" ]) ]
                     [ CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"p") ]
               ]
    in Maybe CQual
-> CFunDecl Identity
-> [CStatement Identity]
-> CStatement Identity
forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition Maybe CQual
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) (CExp Identity -> [CStatement Identity])
-> CExp Identity -> [CStatement Identity]
forall a b. (a -> b) -> a -> b
$
                 CExp Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname (Class -> Function -> String
cppFuncName Class
c Function
func))) ((Arg -> CExp Identity) -> [Arg] -> [CExp Identity]
forall a b. (a -> b) -> [a] -> [b]
map Arg -> CExp Identity
argToCallCExp (Function -> [Arg]
genericFuncArgs Function
func))
    in Maybe CQual
-> CFunDecl Identity
-> [CStatement Identity]
-> CStatement Identity
forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition Maybe CQual
forall a. Maybe a
Nothing (Class -> Function -> CFunDecl Identity
funcToDecl Class
c Function
func) [CStatement Identity]
body
  | Bool
otherwise =
    let caller :: CExp Identity
caller =
          COp -> CExp Identity -> CExp Identity -> CExp Identity
forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
            COp
R.CArrow
            (CExp Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
              (CName Identity -> [CName Identity] -> CExp Identity
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) ]
              )
              [ CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"p") ]
            )
            (CExp Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname (Class -> Function -> String
cppFuncName Class
c Function
func))) ((Arg -> CExp Identity) -> [Arg] -> [CExp Identity]
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 Maybe CQual
-> CFunDecl Identity
-> [CStatement Identity]
-> CStatement Identity
forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition Maybe CQual
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 = NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
intersperse (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") ([NamePart f] -> [NamePart f]) -> [NamePart f] -> [NamePart f]
forall a b. (a -> b) -> a -> b
$ (String -> NamePart f) -> [String] -> [NamePart f]
forall a b. (a -> b) -> [a] -> [b]
map String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart [String]
tclass_params
  in 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 ret :: CType Identity
ret  = IsCPrimitive -> Types -> CType Identity
tmplReturnCType IsCPrimitive
b Types
tfun_ret
          func :: CName f
func = [NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_") NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
: [NamePart f]
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 CType Identity
-> CName Identity
-> [(CType Identity, CName Identity)]
-> CFunDecl Identity
forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret CName Identity
forall (f :: * -> *). CName f
func [(CType Identity, CName Identity)]
args
    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 ret :: CType Identity
ret  = IsCPrimitive -> Types -> CType Identity
tmplReturnCType IsCPrimitive
b (TemplateClass -> Types
TemplateType TemplateClass
t)
          func :: CName f
func = [NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_") NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
: [NamePart f]
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 CType Identity
-> CName Identity
-> [(CType Identity, CName Identity)]
-> CFunDecl Identity
forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret CName Identity
forall (f :: * -> *). CName f
func [(CType Identity, CName Identity)]
args
    TemplateFunction
TFunDelete ->
      let ret :: CType f
ret  = CType f
forall (f :: * -> *). CType f
R.CTVoid
          func :: CName f
func = [NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_delete_") NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
: [NamePart f]
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 CType Identity
-> CName Identity
-> [(CType Identity, CName Identity)]
-> CFunDecl Identity
forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
forall (f :: * -> *). CType f
ret CName Identity
forall (f :: * -> *). CName f
func [(CType Identity, CName Identity)]
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
..} ->
      let ret :: CType Identity
ret  = IsCPrimitive -> Types -> CType Identity
tmplReturnCType IsCPrimitive
b Types
tfun_ret
          func :: CName f
func = [NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (String
tclass_name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TemplateFunction -> String
ffiTmplFuncName TemplateFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_") NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
: [NamePart f]
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 CType Identity
-> CName Identity
-> [(CType Identity, CName Identity)]
-> CFunDecl Identity
forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret CName Identity
forall (f :: * -> *). CName f
func [(CType Identity, CName Identity)]
args

-- |
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 =
    Maybe CQual
-> CFunDecl Identity
-> [CStatement Identity]
-> CStatement Identity
forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition (CQual -> Maybe CQual
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 = (String -> CType Identity) -> [String] -> [CType Identity]
forall a b. (a -> b) -> [a] -> [b]
map (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> (String -> CName Identity) -> String -> CType Identity
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 ->
                    CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTNew
                      (String -> CName Identity
R.sname String
tclass)
                      [CType Identity]
typparams
                      ((Arg -> CExp Identity) -> [Arg] -> [CExp Identity]
forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> CExp Identity
tmplArgToCallCExp IsCPrimitive
b) [Arg]
tfun_new_args)
                  FormNested String
tclass String
inner ->
                    CName Identity
-> CName Identity
-> [CType Identity]
-> [CExp Identity]
-> CExp Identity
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
                      ((Arg -> CExp Identity) -> [Arg] -> [CExp Identity]
forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> CExp Identity
tmplArgToCallCExp IsCPrimitive
b) [Arg]
tfun_new_args)
          in  [ CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$ CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp (String -> CName Identity
R.sname String
"static_cast") [CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid] [CExp Identity
caller] ]
        TemplateFunction
TFunDelete ->
          [ CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CDelete (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
              CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                (String -> CName Identity
R.sname String
"static_cast")
                [ CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (CType Identity -> CType Identity)
-> CType Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm Form
tclass_cxxform [CType Identity]
typparams ]
                [ CName Identity -> CExp Identity
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) (CExp Identity -> [CStatement Identity])
-> CExp Identity -> [CStatement Identity]
forall a b. (a -> b) -> a -> b
$
            COp -> CExp Identity -> CExp Identity -> CExp Identity
forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
              COp
R.CArrow
              (CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                 (String -> CName Identity
R.sname String
"static_cast")
                 [ CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (CType Identity -> CType Identity)
-> CType Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm Form
tclass_cxxform [CType Identity]
typparams ]
                 [ CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (CName Identity -> CExp Identity)
-> CName Identity -> CExp Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"p" ]
              )
              (CExp Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
                (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
tfun_oname))
                ((Arg -> CExp Identity) -> [Arg] -> [CExp Identity]
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) (CExp Identity -> [CStatement Identity])
-> CExp Identity -> [CStatement Identity]
forall a b. (a -> b) -> a -> b
$
            COp -> CExp Identity -> CExp Identity -> CExp Identity
forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
              COp
R.CArrow
              (CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                 (String -> CName Identity
R.sname String
"static_cast")
                 [ CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (CType Identity -> CType Identity)
-> CType Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm Form
tclass_cxxform [CType Identity]
typparams ]
                 [ CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (CName Identity -> CExp Identity)
-> CName Identity -> CExp Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"p" ]
              )
              (CExp Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
                (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname (String
"operator" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OpExp -> String
opSymbol OpExp
tfun_opexp)))
                ((Arg -> CExp Identity) -> [Arg] -> [CExp Identity]
forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> CExp Identity
tmplArgToCallCExp IsCPrimitive
b) (OpExp -> [Arg]
argsFromOpExp OpExp
tfun_opexp))
              )


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 :: String
arg_type :: Types
arg_name :: Arg -> String
arg_type :: Arg -> Types
..})) Accessor
a =
    Maybe CQual
-> CFunDecl Identity
-> [CStatement Identity]
-> CStatement Identity
forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition (CQual -> Maybe CQual
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 = (String -> CType Identity) -> [String] -> [CType Identity]
forall a b. (a -> b) -> [a] -> [b]
map (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> (String -> CName Identity) -> String -> CType Identity
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 = COp -> CExp Identity -> CExp Identity -> CExp Identity
forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
                         COp
R.CArrow
                         (CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                           (String -> CName Identity
R.sname String
"static_cast")
                           [ CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (CType Identity -> CType Identity)
-> CType Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm Form
tclass_cxxform [CType Identity]
typparams ]
                           [ CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (CName Identity -> CExp Identity)
-> CName Identity -> CExp Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"p" ]
                         )
                         (CName Identity -> CExp Identity
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 -> [ CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CExpSA (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
                             COp -> CExp Identity -> CExp Identity -> CExp Identity
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 (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"value")))
                         ]
        TemplateFunction
_ -> String -> [CStatement Identity]
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 =
        [NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [ String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type"
                , String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (   String
"_"
                              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Arg -> String
arg_name (Variable -> Arg
unVariable Variable
v)
                              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_"
                              String -> String -> 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 CType Identity
-> CName Identity
-> [(CType Identity, CName Identity)]
-> CFunDecl Identity
forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret CName Identity
forall (f :: * -> *). CName f
fname [(CType Identity, CName Identity)]
args

accessorsToDecls :: [Variable] -> [R.CFunDecl Identity]
accessorsToDecls :: [Variable] -> [CFunDecl Identity]
accessorsToDecls [Variable]
vs =
  (Variable -> [CFunDecl Identity])
-> [Variable] -> [CFunDecl Identity]
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 =
        COp -> CExp Identity -> CExp Identity -> CExp Identity
forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
          COp
R.CArrow
          (CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
            (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
            [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type"), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple ([NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [ String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"]) ]
            [ CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"p") ]
          )
          (CName Identity -> CExp Identity
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 = CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CReturn (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
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 = CExp Identity -> CStatement Identity
forall (f :: * -> *). CExp f -> CStatement f
R.CExpSA (CExp Identity -> CStatement Identity)
-> CExp Identity -> CStatement Identity
forall a b. (a -> b) -> a -> b
$
                      COp -> CExp Identity -> CExp Identity -> CExp Identity
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)) (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"x")))
  in Maybe CQual
-> CFunDecl Identity
-> [CStatement Identity]
-> CStatement Identity
forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition Maybe CQual
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 = NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
intersperse (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_") ([NamePart f] -> [NamePart f]) -> [NamePart f] -> [NamePart f]
forall a b. (a -> b) -> a -> b
$ (String -> NamePart f) -> [String] -> [NamePart f]
forall a b. (a -> b) -> [a] -> [b]
map String -> NamePart f
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 =
        [NamePart f] -> CName f
forall (f :: * -> *). [NamePart f] -> CName f
R.CName (String -> NamePart f
forall (f :: * -> *). String -> NamePart f
R.NamePart (Class -> TemplateMemberFunction -> String
hsTemplateMemberFunctionName Class
c TemplateMemberFunction
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_") NamePart f -> [NamePart f] -> [NamePart f]
forall a. a -> [a] -> [a]
: [NamePart f]
forall (f :: * -> *). [NamePart f]
nsuffix)
      args :: [(CType Identity, CName Identity)]
args = (Arg -> (CType Identity, CName Identity))
-> [Arg] -> [(CType Identity, CName Identity)]
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")Arg -> [Arg] -> [Arg]
forall a. a -> [a] -> [a]
:TemplateMemberFunction -> [Arg]
tmf_args TemplateMemberFunction
f)
  in CType Identity
-> CName Identity
-> [(CType Identity, CName Identity)]
-> CFunDecl Identity
forall (f :: * -> *).
CType f -> CName f -> [(CType f, CName f)] -> CFunDecl f
R.CFunDecl CType Identity
ret CName Identity
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 =
    Maybe CQual
-> CFunDecl Identity
-> [CStatement Identity]
-> CStatement Identity
forall (f :: * -> *).
Maybe CQual -> CFunDecl f -> [CStatement f] -> CStatement f
R.CDefinition (CQual -> Maybe CQual
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 = (String -> CType Identity) -> [String] -> [CType Identity]
forall a b. (a -> b) -> [a] -> [b]
map (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> (String -> CName Identity) -> String -> CType Identity
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) (CExp Identity -> [CStatement Identity])
-> CExp Identity -> [CStatement Identity]
forall a b. (a -> b) -> a -> b
$
             COp -> CExp Identity -> CExp Identity -> CExp Identity
forall (f :: * -> *). COp -> CExp f -> CExp f -> CExp f
R.CBinOp
               COp
R.CArrow
               (CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
                 (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
                 [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c)), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_t")) ]
                 [ CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (CName Identity -> CExp Identity)
-> CName Identity -> CExp Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"p" ]
               )
               (CName Identity
-> [CType Identity] -> [CExp Identity] -> CExp Identity
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
                 ((Arg -> CExp Identity) -> [Arg] -> [CExp Identity]
forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> CExp Identity
tmplArgToCallCExp IsCPrimitive
NonCPrim) (TemplateMemberFunction -> [Arg]
tmf_args TemplateMemberFunction
f))
               )