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

module FFICXX.Generate.Code.Cpp where

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

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

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

---- "Class Type Declaration" Instances

typedefStmts :: String -> [R.CStatement Identity]
typedefStmts :: String -> [CStatement Identity]
typedefStmts String
classname =
  [ 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 :: TLOrdinary -> R.CFunDecl Identity
topLevelDecl :: TLOrdinary -> CFunDecl Identity
topLevelDecl TopLevelFunction {String
[Arg]
Maybe String
Types
toplevelfunc_ret :: Types
toplevelfunc_name :: String
toplevelfunc_args :: [Arg]
toplevelfunc_alias :: Maybe String
toplevelfunc_ret :: TLOrdinary -> Types
toplevelfunc_name :: TLOrdinary -> String
toplevelfunc_args :: TLOrdinary -> [Arg]
toplevelfunc_alias :: TLOrdinary -> Maybe String
..} = 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_ret :: Types
toplevelvar_name :: String
toplevelvar_alias :: Maybe String
toplevelvar_ret :: TLOrdinary -> Types
toplevelvar_name :: TLOrdinary -> String
toplevelvar_alias :: TLOrdinary -> Maybe String
..} = 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 :: TLOrdinary -> R.CStatement Identity
genTopLevelCppDefinition :: TLOrdinary -> CStatement Identity
genTopLevelCppDefinition tf :: TLOrdinary
tf@TopLevelFunction {String
[Arg]
Maybe String
Types
toplevelfunc_ret :: TLOrdinary -> Types
toplevelfunc_name :: TLOrdinary -> String
toplevelfunc_args :: TLOrdinary -> [Arg]
toplevelfunc_alias :: TLOrdinary -> Maybe String
toplevelfunc_ret :: Types
toplevelfunc_name :: String
toplevelfunc_args :: [Arg]
toplevelfunc_alias :: Maybe String
..} =
  let decl :: CFunDecl Identity
decl = TLOrdinary -> CFunDecl Identity
topLevelDecl TLOrdinary
tf
      body :: [CStatement Identity]
body =
        IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp
          IsCPrimitive
NonCPrim
          (Types
toplevelfunc_ret)
          (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 :: TLOrdinary
tv@TopLevelVariable {String
Maybe String
Types
toplevelvar_ret :: TLOrdinary -> Types
toplevelvar_name :: TLOrdinary -> String
toplevelvar_alias :: TLOrdinary -> Maybe String
toplevelvar_ret :: Types
toplevelvar_name :: String
toplevelvar_alias :: Maybe String
..} =
  let decl :: CFunDecl Identity
decl = TLOrdinary -> CFunDecl Identity
topLevelDecl TLOrdinary
tv
      body :: [CStatement Identity]
body = IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
NonCPrim (Types
toplevelvar_ret) (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_cabal :: Cabal
tclass_name :: String
tclass_cxxform :: Form
tclass_params :: [String]
tclass_funcs :: [TemplateFunction]
tclass_vars :: [Variable]
tclass_cabal :: TemplateClass -> Cabal
tclass_name :: TemplateClass -> String
tclass_cxxform :: TemplateClass -> Form
tclass_params :: TemplateClass -> [String]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_vars :: TemplateClass -> [Variable]
..} 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)))

genTLTmplFunCpp ::
  IsCPrimitive ->
  TLTemplate ->
  R.CMacro Identity
genTLTmplFunCpp :: IsCPrimitive -> TLTemplate -> CMacro Identity
genTLTmplFunCpp IsCPrimitive
b t :: TLTemplate
t@TopLevelTemplateFunction {String
[String]
[Arg]
Types
topleveltfunc_params :: [String]
topleveltfunc_ret :: Types
topleveltfunc_name :: String
topleveltfunc_oname :: String
topleveltfunc_args :: [Arg]
topleveltfunc_params :: TLTemplate -> [String]
topleveltfunc_ret :: TLTemplate -> Types
topleveltfunc_name :: TLTemplate -> String
topleveltfunc_oname :: TLTemplate -> String
topleveltfunc_args :: TLTemplate -> [Arg]
..} =
  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]
topleveltfunc_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 -> TLTemplate -> CStatement Identity
topLevelTemplateFunToDef IsCPrimitive
b TLTemplate
t,
      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]
topleveltfunc_params
    suffix :: String
suffix = case IsCPrimitive
b of IsCPrimitive
CPrim -> String
"_s"; IsCPrimitive
NonCPrim -> String
""
    macroname :: String
macroname = String -> String
firstUpper String
topleveltfunc_name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_instance" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix
    decl :: CFunDecl Identity
decl = IsCPrimitive -> TLTemplate -> CFunDecl Identity
topLevelTemplateFunToDecl IsCPrimitive
b TLTemplate
t
    autoinst :: CStatement f
autoinst =
      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
"_TL_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
topleveltfunc_name 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
"TL_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
topleveltfunc_name 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_cabal :: TemplateClass -> Cabal
tclass_name :: TemplateClass -> String
tclass_cxxform :: TemplateClass -> Form
tclass_params :: TemplateClass -> [String]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_vars :: TemplateClass -> [Variable]
tclass_cabal :: Cabal
tclass_name :: String
tclass_cxxform :: Form
tclass_params :: [String]
tclass_funcs :: [TemplateFunction]
tclass_vars :: [Variable]
..} var :: Variable
var@(Variable (Arg {})) =
  [Variable -> Accessor -> CMacro Identity
gen Variable
var Accessor
Getter, Variable -> Accessor -> CMacro Identity
gen Variable
var Accessor
Setter]
  where
    nsuffix :: [NamePart f]
nsuffix = 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 ->
  -- | (member functions, member accessors)
  ([TemplateFunction], [Variable]) ->
  R.CMacro Identity
genTmplClassCpp :: IsCPrimitive
-> TemplateClass
-> ([TemplateFunction], [Variable])
-> CMacro Identity
genTmplClassCpp IsCPrimitive
b TmplCls {String
[String]
[TemplateFunction]
[Variable]
Cabal
Form
tclass_cabal :: TemplateClass -> Cabal
tclass_name :: TemplateClass -> String
tclass_cxxform :: TemplateClass -> Form
tclass_params :: TemplateClass -> [String]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_vars :: TemplateClass -> [Variable]
tclass_cabal :: Cabal
tclass_name :: String
tclass_cxxform :: Form
tclass_params :: [String]
tclass_funcs :: [TemplateFunction]
tclass_vars :: [Variable]
..} ([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 {} = 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 {} = 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 {} = 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
"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")]
            ]
      ]
    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_cabal :: TemplateClass -> Cabal
tclass_name :: TemplateClass -> String
tclass_cxxform :: TemplateClass -> Form
tclass_params :: TemplateClass -> [String]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_vars :: TemplateClass -> [Variable]
tclass_cabal :: Cabal
tclass_name :: String
tclass_cxxform :: Form
tclass_params :: [String]
tclass_funcs :: [TemplateFunction]
tclass_vars :: [Variable]
..} 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_ret :: Types
tfun_name :: String
tfun_oname :: String
tfun_args :: [Arg]
tfun_ret :: TemplateFunction -> Types
tfun_name :: TemplateFunction -> String
tfun_oname :: TemplateFunction -> String
tfun_args :: TemplateFunction -> [Arg]
..} ->
          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_args :: [Arg]
tfun_new_alias :: Maybe String
tfun_new_args :: TemplateFunction -> [Arg]
tfun_new_alias :: TemplateFunction -> Maybe String
..} ->
          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_ret :: TemplateFunction -> Types
tfun_name :: TemplateFunction -> String
tfun_ret :: Types
tfun_name :: String
tfun_opexp :: OpExp
tfun_opexp :: TemplateFunction -> OpExp
..} ->
          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

-- | top-level (bare) template function declaration
topLevelTemplateFunToDecl ::
  IsCPrimitive ->
  TLTemplate ->
  R.CFunDecl Identity
topLevelTemplateFunToDecl :: IsCPrimitive -> TLTemplate -> CFunDecl Identity
topLevelTemplateFunToDecl IsCPrimitive
b (TopLevelTemplateFunction {String
[String]
[Arg]
Types
topleveltfunc_params :: TLTemplate -> [String]
topleveltfunc_ret :: TLTemplate -> Types
topleveltfunc_name :: TLTemplate -> String
topleveltfunc_oname :: TLTemplate -> String
topleveltfunc_args :: TLTemplate -> [Arg]
topleveltfunc_params :: [String]
topleveltfunc_ret :: Types
topleveltfunc_name :: String
topleveltfunc_oname :: String
topleveltfunc_args :: [Arg]
..}) =
  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]
topleveltfunc_params
      ret :: CType Identity
ret = IsCPrimitive -> Types -> CType Identity
tmplReturnCType IsCPrimitive
b Types
topleveltfunc_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
"TL_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
topleveltfunc_name 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 (IsCPrimitive -> Arg -> (CType Identity, CName Identity)
tmplArgToCTypVar IsCPrimitive
b) [Arg]
topleveltfunc_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

-- | function definition in a template class
tmplFunToDef ::
  IsCPrimitive ->
  TemplateClass ->
  TemplateFunction ->
  R.CStatement Identity
tmplFunToDef :: IsCPrimitive
-> TemplateClass -> TemplateFunction -> CStatement Identity
tmplFunToDef IsCPrimitive
b t :: TemplateClass
t@TmplCls {String
[String]
[TemplateFunction]
[Variable]
Cabal
Form
tclass_cabal :: TemplateClass -> Cabal
tclass_name :: TemplateClass -> String
tclass_cxxform :: TemplateClass -> Form
tclass_params :: TemplateClass -> [String]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_vars :: TemplateClass -> [Variable]
tclass_cabal :: Cabal
tclass_name :: String
tclass_cxxform :: Form
tclass_params :: [String]
tclass_funcs :: [TemplateFunction]
tclass_vars :: [Variable]
..} 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_args :: TemplateFunction -> [Arg]
tfun_new_alias :: TemplateFunction -> Maybe String
tfun_new_args :: [Arg]
tfun_new_alias :: Maybe String
..} ->
          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_ret :: TemplateFunction -> Types
tfun_name :: TemplateFunction -> String
tfun_oname :: TemplateFunction -> String
tfun_args :: TemplateFunction -> [Arg]
tfun_ret :: Types
tfun_name :: String
tfun_oname :: String
tfun_args :: [Arg]
..} ->
          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_ret :: TemplateFunction -> Types
tfun_name :: TemplateFunction -> String
tfun_opexp :: TemplateFunction -> OpExp
tfun_ret :: Types
tfun_name :: String
tfun_opexp :: OpExp
..} ->
          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))
              )

-- | function definition in a template class
topLevelTemplateFunToDef ::
  IsCPrimitive ->
  TLTemplate ->
  R.CStatement Identity
topLevelTemplateFunToDef :: IsCPrimitive -> TLTemplate -> CStatement Identity
topLevelTemplateFunToDef IsCPrimitive
b t :: TLTemplate
t@TopLevelTemplateFunction {String
[String]
[Arg]
Types
topleveltfunc_params :: TLTemplate -> [String]
topleveltfunc_ret :: TLTemplate -> Types
topleveltfunc_name :: TLTemplate -> String
topleveltfunc_oname :: TLTemplate -> String
topleveltfunc_args :: TLTemplate -> [Arg]
topleveltfunc_params :: [String]
topleveltfunc_ret :: Types
topleveltfunc_name :: String
topleveltfunc_oname :: String
topleveltfunc_args :: [Arg]
..} =
  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 -> TLTemplate -> CFunDecl Identity
topLevelTemplateFunToDecl IsCPrimitive
b TLTemplate
t) [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]
topleveltfunc_params
    body :: [CStatement Identity]
body =
      IsCPrimitive -> Types -> CExp Identity -> [CStatement Identity]
returnCpp IsCPrimitive
b (Types
topleveltfunc_ret) (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
topleveltfunc_oname)
          [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]
topleveltfunc_args)

-- |
tmplVarToDef ::
  IsCPrimitive ->
  TemplateClass ->
  Variable ->
  Accessor ->
  R.CStatement Identity
tmplVarToDef :: IsCPrimitive
-> TemplateClass -> Variable -> Accessor -> CStatement Identity
tmplVarToDef IsCPrimitive
b t :: TemplateClass
t@TmplCls {String
[String]
[TemplateFunction]
[Variable]
Cabal
Form
tclass_cabal :: TemplateClass -> Cabal
tclass_name :: TemplateClass -> String
tclass_cxxform :: TemplateClass -> Form
tclass_params :: TemplateClass -> [String]
tclass_funcs :: TemplateClass -> [TemplateFunction]
tclass_vars :: TemplateClass -> [Variable]
tclass_cabal :: Cabal
tclass_name :: String
tclass_cxxform :: Form
tclass_params :: [String]
tclass_funcs :: [TemplateFunction]
tclass_vars :: [Variable]
..} v :: Variable
v@(Variable (Arg {String
Types
arg_type :: Types
arg_name :: String
arg_type :: Arg -> Types
arg_name :: Arg -> String
..})) 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_ret :: TemplateFunction -> Types
tfun_name :: TemplateFunction -> String
tfun_oname :: TemplateFunction -> String
tfun_args :: TemplateFunction -> [Arg]
tfun_ret :: Types
tfun_name :: String
tfun_oname :: String
tfun_args :: [Arg]
..} ->
          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))
          )