{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE RecordWildCards #-}

module FFICXX.Generate.Code.Primitive where

import Control.Monad.Trans.State    ( runState, put, get )
import Data.Functor.Identity        ( Identity )
import Data.Monoid                  ( (<>) )
import Language.Haskell.Exts.Syntax ( Asst(..), Context, Type(..) )
--
import qualified FFICXX.Runtime.CodeGen.Cxx as R
import FFICXX.Runtime.TH            ( IsCPrimitive(CPrim,NonCPrim) )
--
import FFICXX.Generate.Name         ( ffiClassName
                                    , hsClassName
                                    , hsClassNameForTArg
                                    , hsTemplateClassName
                                    , tmplAccessorName
                                    , typeclassName
                                    , typeclassNameFromStr
                                    )
import FFICXX.Generate.Type.Class   ( Accessor(Getter,Setter)
                                    , Arg(..)
                                    , Class(..)
                                    , CPPTypes(..)
                                    , CTypes(..)
                                    , Form(..)
                                    , Function(..)
                                    , IsConst(Const,NoConst)
                                    , Selfness(NoSelf,Self)
                                    , TemplateAppInfo(..)
                                    , TemplateArgType(TArg_TypeParam)
                                    , TemplateClass(..)
                                    , TemplateFunction(..)
                                    , TemplateMemberFunction(..)
                                    , Types(..)
                                    , Variable(..)
                                    , argsFromOpExp
                                    , isNonVirtualFunc
                                    , isVirtualFunc
                                    )
import FFICXX.Generate.Util.HaskellSrcExts
       ( classA, cxTuple, mkTVar, mkVar, parenSplice, tyapp, tycon, tyfun, tyPtr, tySplice
       , unit_tycon, unqual )


data CFunSig = CFunSig { CFunSig -> [Arg]
cArgTypes :: [Arg]
                       , CFunSig -> Types
cRetType :: Types
                       }

data HsFunSig = HsFunSig { HsFunSig -> [Type ()]
hsSigTypes :: [Type ()]
                         , HsFunSig -> [Asst ()]
hsSigConstraints :: [Asst ()]
                         }

ctypToCType :: CTypes -> IsConst -> R.CType Identity
ctypToCType :: CTypes -> IsConst -> CType Identity
ctypToCType CTypes
ctyp IsConst
isconst =
  let typ :: CType Identity
typ = case CTypes
ctyp of
        CTypes
CTBool      -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"bool"
        CTypes
CTChar      -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"char"
        CTypes
CTClock     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"clock_t"
        CTypes
CTDouble    -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"double"
        CTypes
CTFile      -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"FILE"
        CTypes
CTFloat     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"float"
        CTypes
CTFpos      -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"fpos_t"
        CTypes
CTInt       -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"int"
        CTypes
CTIntMax    -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"intmax_t"
        CTypes
CTIntPtr    -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"intptr_t"
        CTypes
CTJmpBuf    -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"jmp_buf"
        CTypes
CTLLong     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"long long"
        CTypes
CTLong      -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"long"
        CTypes
CTPtrdiff   -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"ptrdiff_t"
        CTypes
CTSChar     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"sized char"
        CTypes
CTSUSeconds -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"suseconds_t"
        CTypes
CTShort     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"short"
        CTypes
CTSigAtomic -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"sig_atomic_t"
        CTypes
CTSize      -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"size_t"
        CTypes
CTTime      -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"time_t"
        CTypes
CTUChar     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"unsigned char"
        CTypes
CTUInt      -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"unsigned int"
        CTypes
CTUIntMax   -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uintmax_t"
        CTypes
CTUIntPtr   -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uintptr_t"
        CTypes
CTULLong    -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"unsigned long long"
        CTypes
CTULong     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"unsigned long"
        CTypes
CTUSeconds  -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"useconds_t"
        CTypes
CTUShort    -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"unsigned short"
        CTypes
CTWchar     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"wchar_t"
        CTypes
CTInt8      -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"int8_t"
        CTypes
CTInt16     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"int16_t"
        CTypes
CTInt32     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"int32_t"
        CTypes
CTInt64     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"int64_t"
        CTypes
CTUInt8     -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uint8_t"
        CTypes
CTUInt16    -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uint16_t"
        CTypes
CTUInt32    -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uint32_t"
        CTypes
CTUInt64    -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uint64_t"
        CTypes
CTString    -> 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
$ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"char"
        CTypes
CTVoidStar  -> CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
        CEnum CTypes
_ String
type_str -> String -> CType Identity
forall (f :: * -> *). String -> CType f
R.CTVerbatim String
type_str
        CPointer CTypes
s  -> CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (CTypes -> IsConst -> CType Identity
ctypToCType CTypes
s IsConst
NoConst)
        CRef CTypes
s      -> CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar (CTypes -> IsConst -> CType Identity
ctypToCType CTypes
s IsConst
NoConst)
  in case IsConst
isconst of
       IsConst
Const   -> CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTConst CType Identity
typ
       IsConst
NoConst -> CType Identity
typ

self_ :: Types
self_ :: Types
self_ = Types
SelfType

cstring_ :: Types
cstring_ :: Types
cstring_ = CTypes -> IsConst -> Types
CT CTypes
CTString IsConst
Const

cint_ :: Types
cint_ :: Types
cint_    = CTypes -> IsConst -> Types
CT CTypes
CTInt    IsConst
Const

int_ :: Types
int_ :: Types
int_     = CTypes -> IsConst -> Types
CT CTypes
CTInt    IsConst
NoConst

uint_ :: Types
uint_ :: Types
uint_ = CTypes -> IsConst -> Types
CT CTypes
CTUInt IsConst
NoConst

ulong_ :: Types
ulong_ :: Types
ulong_ = CTypes -> IsConst -> Types
CT CTypes
CTULong IsConst
NoConst

long_ :: Types
long_ :: Types
long_ = CTypes -> IsConst -> Types
CT CTypes
CTLong IsConst
NoConst

culong_ :: Types
culong_ :: Types
culong_ = CTypes -> IsConst -> Types
CT CTypes
CTULong IsConst
Const

clong_ :: Types
clong_ :: Types
clong_ = CTypes -> IsConst -> Types
CT CTypes
CTLong IsConst
Const

cchar_ :: Types
cchar_ :: Types
cchar_ = CTypes -> IsConst -> Types
CT CTypes
CTChar IsConst
Const

char_ :: Types
char_ :: Types
char_ = CTypes -> IsConst -> Types
CT CTypes
CTChar IsConst
NoConst

cshort_ :: Types
cshort_ :: Types
cshort_ = CTypes -> IsConst -> Types
CT CTypes
CTShort IsConst
Const

short_ :: Types
short_ :: Types
short_ = CTypes -> IsConst -> Types
CT CTypes
CTShort IsConst
NoConst

cdouble_ :: Types
cdouble_ :: Types
cdouble_ = CTypes -> IsConst -> Types
CT CTypes
CTDouble IsConst
Const

double_ :: Types
double_ :: Types
double_  = CTypes -> IsConst -> Types
CT CTypes
CTDouble IsConst
NoConst

doublep_ :: Types
doublep_ :: Types
doublep_ = CTypes -> IsConst -> Types
CT (CTypes -> CTypes
CPointer CTypes
CTDouble) IsConst
NoConst

cfloat_ :: Types
cfloat_ :: Types
cfloat_ = CTypes -> IsConst -> Types
CT CTypes
CTFloat IsConst
Const

float_ :: Types
float_ :: Types
float_ = CTypes -> IsConst -> Types
CT CTypes
CTFloat IsConst
NoConst

bool_ :: Types
bool_ :: Types
bool_    = CTypes -> IsConst -> Types
CT CTypes
CTBool   IsConst
NoConst

void_ :: Types
void_ :: Types
void_ = Types
Void

voidp_ :: Types
voidp_ :: Types
voidp_ = CTypes -> IsConst -> Types
CT CTypes
CTVoidStar IsConst
NoConst

intp_ :: Types
intp_ :: Types
intp_ = CTypes -> IsConst -> Types
CT (CTypes -> CTypes
CPointer CTypes
CTInt) IsConst
NoConst

intref_ :: Types
intref_ :: Types
intref_ = CTypes -> IsConst -> Types
CT (CTypes -> CTypes
CRef CTypes
CTInt) IsConst
NoConst


charpp_ :: Types
charpp_ :: Types
charpp_ = CTypes -> IsConst -> Types
CT (CTypes -> CTypes
CPointer CTypes
CTString) IsConst
NoConst

ref_ :: CTypes -> Types
ref_ :: CTypes -> Types
ref_ CTypes
t = CTypes -> IsConst -> Types
CT (CTypes -> CTypes
CRef CTypes
t) IsConst
NoConst

star_ :: CTypes -> Types
star_ :: CTypes -> Types
star_ CTypes
t = CTypes -> IsConst -> Types
CT (CTypes -> CTypes
CPointer CTypes
t) IsConst
NoConst

cstar_ :: CTypes -> Types
cstar_ :: CTypes -> Types
cstar_ CTypes
t = CTypes -> IsConst -> Types
CT (CTypes -> CTypes
CPointer CTypes
t) IsConst
Const

self :: String -> Arg
self :: String -> Arg
self String
var = Types -> String -> Arg
Arg Types
self_ String
var

voidp :: String -> Arg
voidp :: String -> Arg
voidp String
var = Types -> String -> Arg
Arg Types
voidp_ String
var

cstring :: String -> Arg
cstring :: String -> Arg
cstring String
var = Types -> String -> Arg
Arg Types
cstring_ String
var

cint :: String -> Arg
cint :: String -> Arg
cint String
var = Types -> String -> Arg
Arg Types
cint_ String
var

int :: String -> Arg
int :: String -> Arg
int String
var = Types -> String -> Arg
Arg Types
int_ String
var

uint :: String -> Arg
uint :: String -> Arg
uint String
var = Types -> String -> Arg
Arg Types
uint_ String
var

long :: String -> Arg
long :: String -> Arg
long String
var = Types -> String -> Arg
Arg Types
long_ String
var

ulong :: String -> Arg
ulong :: String -> Arg
ulong String
var = Types -> String -> Arg
Arg Types
ulong_ String
var

clong :: String -> Arg
clong :: String -> Arg
clong String
var = Types -> String -> Arg
Arg Types
clong_ String
var

culong :: String -> Arg
culong :: String -> Arg
culong String
var = Types -> String -> Arg
Arg Types
culong_ String
var

cchar :: String -> Arg
cchar :: String -> Arg
cchar String
var = Types -> String -> Arg
Arg Types
cchar_ String
var

char :: String -> Arg
char :: String -> Arg
char String
var = Types -> String -> Arg
Arg Types
char_ String
var

cshort :: String -> Arg
cshort :: String -> Arg
cshort String
var = Types -> String -> Arg
Arg Types
cshort_ String
var

short :: String -> Arg
short :: String -> Arg
short String
var = Types -> String -> Arg
Arg Types
short_ String
var

cdouble :: String -> Arg
cdouble :: String -> Arg
cdouble String
var = Types -> String -> Arg
Arg Types
cdouble_ String
var

double :: String -> Arg
double :: String -> Arg
double  String
var = Types -> String -> Arg
Arg Types
double_ String
var

doublep :: String -> Arg
doublep :: String -> Arg
doublep String
var = Types -> String -> Arg
Arg Types
doublep_ String
var

cfloat :: String -> Arg
cfloat :: String -> Arg
cfloat String
var = Types -> String -> Arg
Arg Types
float_ String
var

float :: String -> Arg
float :: String -> Arg
float String
var = Types -> String -> Arg
Arg Types
float_ String
var

bool :: String -> Arg
bool :: String -> Arg
bool String
var = Types -> String -> Arg
Arg Types
bool_ String
var

intp :: String -> Arg
intp :: String -> Arg
intp String
var = Types -> String -> Arg
Arg Types
intp_ String
var

intref :: String -> Arg
intref :: String -> Arg
intref String
var = Types -> String -> Arg
Arg Types
intref_ String
var

charpp :: String -> Arg
charpp :: String -> Arg
charpp String
var = Types -> String -> Arg
Arg Types
charpp_ String
var

ref :: CTypes -> String -> Arg
ref :: CTypes -> String -> Arg
ref CTypes
t String
var = Types -> String -> Arg
Arg (CTypes -> Types
ref_ CTypes
t) String
var

star :: CTypes -> String -> Arg
star :: CTypes -> String -> Arg
star CTypes
t String
var = Types -> String -> Arg
Arg (CTypes -> Types
star_ CTypes
t) String
var

cstar :: CTypes -> String -> Arg
cstar :: CTypes -> String -> Arg
cstar CTypes
t String
var = Types -> String -> Arg
Arg (CTypes -> Types
cstar_ CTypes
t) String
var


cppclass_ :: Class -> Types
cppclass_ :: Class -> Types
cppclass_ Class
c =  CPPTypes -> IsConst -> Types
CPT (Class -> CPPTypes
CPTClass Class
c) IsConst
NoConst

cppclass :: Class -> String -> Arg
cppclass :: Class -> String -> Arg
cppclass Class
c String
vname = Types -> String -> Arg
Arg (Class -> Types
cppclass_ Class
c) String
vname



cppclassconst :: Class -> String -> Arg
cppclassconst :: Class -> String -> Arg
cppclassconst Class
c String
vname = Types -> String -> Arg
Arg (CPPTypes -> IsConst -> Types
CPT (Class -> CPPTypes
CPTClass Class
c) IsConst
Const) String
vname

cppclassref_ :: Class -> Types
cppclassref_ :: Class -> Types
cppclassref_ Class
c = CPPTypes -> IsConst -> Types
CPT (Class -> CPPTypes
CPTClassRef Class
c) IsConst
NoConst

cppclassref :: Class -> String -> Arg
cppclassref :: Class -> String -> Arg
cppclassref Class
c String
vname = Types -> String -> Arg
Arg (Class -> Types
cppclassref_ Class
c) String
vname

cppclasscopy_ :: Class -> Types
cppclasscopy_ :: Class -> Types
cppclasscopy_ Class
c = CPPTypes -> IsConst -> Types
CPT (Class -> CPPTypes
CPTClassCopy Class
c) IsConst
NoConst

cppclasscopy :: Class -> String -> Arg
cppclasscopy :: Class -> String -> Arg
cppclasscopy Class
c String
vname = Types -> String -> Arg
Arg (Class -> Types
cppclasscopy_ Class
c) String
vname

cppclassmove_ :: Class -> Types
cppclassmove_ :: Class -> Types
cppclassmove_ Class
c = CPPTypes -> IsConst -> Types
CPT (Class -> CPPTypes
CPTClassMove Class
c) IsConst
NoConst

cppclassmove :: Class -> String -> Arg
cppclassmove :: Class -> String -> Arg
cppclassmove Class
c String
vname = Types -> String -> Arg
Arg (Class -> Types
cppclassmove_ Class
c) String
vname


argToCTypVar :: Arg -> (R.CType Identity, R.CName Identity)
argToCTypVar :: Arg -> (CType Identity, CName Identity)
argToCTypVar (Arg (CT CTypes
ctyp IsConst
isconst) String
varname) =
  (CTypes -> IsConst -> CType Identity
ctypToCType CTypes
ctyp IsConst
isconst, String -> CName Identity
R.sname String
varname)
argToCTypVar (Arg Types
SelfType String
varname) =
  (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
"_p" ]), String -> CName Identity
R.sname String
varname)
argToCTypVar (Arg (CPT (CPTClass Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const   -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
cname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
  where cname :: String
cname = Class -> String
ffiClassName Class
c
argToCTypVar (Arg (CPT (CPTClassRef Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const   -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
cname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
  where cname :: String
cname = Class -> String
ffiClassName Class
c
argToCTypVar (Arg (CPT (CPTClassCopy Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const   -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
cname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
  where cname :: String
cname = Class -> String
ffiClassName Class
c
argToCTypVar (Arg (CPT (CPTClassMove Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const   -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
cname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
  where cname :: String
cname = Class -> String
ffiClassName Class
c
argToCTypVar (Arg (TemplateApp     TemplateAppInfo
_) String
varname) = (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
varname)
argToCTypVar (Arg (TemplateAppRef  TemplateAppInfo
_) String
varname) = (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
varname)
argToCTypVar (Arg (TemplateAppMove TemplateAppInfo
_) String
varname) = (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
varname)
argToCTypVar Arg
t = String -> (CType Identity, CName Identity)
forall a. HasCallStack => String -> a
error (String
"argToCTypVar: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Arg -> String
forall a. Show a => a -> String
show Arg
t)

argsToCTypVar :: [Arg] -> [ (R.CType Identity, R.CName Identity) ]
argsToCTypVar :: [Arg] -> [(CType Identity, CName Identity)]
argsToCTypVar [Arg]
args =
  let args' :: [Arg]
args' = (Types -> String -> Arg
Arg Types
SelfType String
"p") Arg -> [Arg] -> [Arg]
forall a. a -> [a] -> [a]
: [Arg]
args
  in (Arg -> (CType Identity, CName Identity))
-> [Arg] -> [(CType Identity, CName Identity)]
forall a b. (a -> b) -> [a] -> [b]
map Arg -> (CType Identity, CName Identity)
argToCTypVar [Arg]
args'

argsToCTypVarNoSelf :: [Arg] -> [ (R.CType Identity, R.CName Identity) ]
argsToCTypVarNoSelf :: [Arg] -> [(CType Identity, CName Identity)]
argsToCTypVarNoSelf = (Arg -> (CType Identity, CName Identity))
-> [Arg] -> [(CType Identity, CName Identity)]
forall a b. (a -> b) -> [a] -> [b]
map Arg -> (CType Identity, CName Identity)
argToCTypVar

argToCallCExp :: Arg -> R.CExp Identity
argToCallCExp :: Arg -> CExp Identity
argToCallCExp (Arg Types
t String
e) = Types -> CExp Identity -> CExp Identity
c2Cxx Types
t (CName Identity -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
e))


-- TODO: rename this function by castExpressionFrom/To or something like that.
returnCType :: Types -> R.CType Identity
returnCType :: Types -> CType Identity
returnCType (CT CTypes
ctyp IsConst
isconst)        = CTypes -> IsConst -> CType Identity
ctypToCType CTypes
ctyp IsConst
isconst
returnCType Types
Void                     = CType Identity
forall (f :: * -> *). CType f
R.CTVoid
returnCType Types
SelfType                 = 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
"_p" ])
returnCType (CPT (CPTClass Class
c) IsConst
_)     = 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
"_p"))
returnCType (CPT (CPTClassRef Class
c) IsConst
_)  = 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
"_p"))
returnCType (CPT (CPTClassCopy Class
c) IsConst
_) = 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
"_p"))
returnCType (CPT (CPTClassMove Class
c) IsConst
_) = 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
"_p"))
returnCType (TemplateApp     TemplateAppInfo
_)      = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
returnCType (TemplateAppRef  TemplateAppInfo
_)      = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
returnCType (TemplateAppMove TemplateAppInfo
_)      = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
returnCType (TemplateType TemplateClass
_)         = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
returnCType (TemplateParam String
t)        = 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
t, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p" ])
returnCType (TemplateParamPointer String
t) = 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
t, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p" ])

-- TODO: Rewrite this with static_cast
c2Cxx :: Types -> R.CExp Identity -> R.CExp Identity
c2Cxx :: Types -> CExp Identity -> CExp Identity
c2Cxx Types
t CExp Identity
e =
  case Types
t of
    CT  (CRef CTypes
_)         IsConst
_ -> CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar CExp Identity
e
    CPT (CPTClass     Class
c) IsConst
_ -> 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
f), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_t")) ]
                                [ CExp Identity
e ]
                              where f :: String
f = Class -> String
ffiClassName Class
c
    CPT (CPTClassRef  Class
c) IsConst
_ -> 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_nonconstref_to_nonconstref")
                                [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
f), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_t")) ]
                                [ CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar CExp Identity
e ]
                              where f :: String
f = Class -> String
ffiClassName Class
c
    CPT (CPTClassCopy Class
c) IsConst
_ -> CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar (CExp Identity -> CExp Identity) -> CExp Identity -> CExp 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
f), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_t")) ]
                                  [ CExp Identity
e ]
                              where f :: String
f = Class -> String
ffiClassName Class
c
    CPT (CPTClassMove Class
c) IsConst
_ -> 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
"from_nonconstref_to_nonconstref")
                                    [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
f), CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_t")) ]
                                    [ CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar CExp Identity
e ]
                                ]
                              where f :: String
f = Class -> String
ffiClassName Class
c
    TemplateApp    TemplateAppInfo
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 String
"from_nonconstref_to_nonconst")
                                [ String -> CType Identity
forall (f :: * -> *). String -> CType f
R.CTVerbatim (TemplateAppInfo -> String
tapp_CppTypeForParam TemplateAppInfo
p), CType Identity
forall (f :: * -> *). CType f
R.CTVoid ]
                                [ CExp Identity
e ]
    TemplateAppRef TemplateAppInfo
p       -> CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar (CExp Identity -> CExp Identity) -> CExp Identity -> CExp Identity
forall a b. (a -> b) -> a -> b
$
                                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 (String -> CType Identity
forall (f :: * -> *). String -> CType f
R.CTVerbatim (TemplateAppInfo -> String
tapp_CppTypeForParam TemplateAppInfo
p))) CExp Identity
e
    TemplateAppMove TemplateAppInfo
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
"std::move"))
                                [ CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar (CExp Identity -> CExp Identity) -> CExp Identity -> CExp Identity
forall a b. (a -> b) -> a -> b
$
                                    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 (String -> CType Identity
forall (f :: * -> *). String -> CType f
R.CTVerbatim (TemplateAppInfo -> String
tapp_CppTypeForParam TemplateAppInfo
p))) CExp Identity
e
                                ]
    Types
_                      -> CExp Identity
e

-- TODO: Rewrite this with static_cast
--       Merge this with returnCpp after Void and simple type adjustment
-- TODO: Resolve all the error cases
cxx2C :: Types -> R.CExp Identity -> R.CExp Identity
cxx2C :: Types -> CExp Identity -> CExp Identity
cxx2C Types
t CExp Identity
e =
  case Types
t of
    Types
Void -> CExp Identity
forall (f :: * -> *). CExp f
R.CNull
    Types
SelfType ->
      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
e ]
      -- "to_nonconst<Type ## _t, Type>((Type *)" <> e <> ")"
    CT (CRef CTypes
_) IsConst
_ -> CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CAddr CExp Identity
e
      -- "&(" <> e <> ")"
    CT CTypes
_ IsConst
_ -> CExp Identity
e
      -- e
    CPT (CPTClass Class
c) IsConst
_ ->
      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
f 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
f) ]
        [ 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
f))) CExp Identity
e ]
      where f :: String
f = Class -> String
ffiClassName Class
c
      -- "to_nonconst<" <> f <> "_t," <> f <> ">((" <> f <> "*)" <> e <> ")"
    CPT (CPTClassRef Class
c) IsConst
_  ->
      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
f 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
f) ]
        [ CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CAddr CExp Identity
e ]
      where f :: String
f = Class -> String
ffiClassName Class
c
      -- "to_nonconst<" <> f <> "_t," <> f <> ">(&(" <> e <> "))"
    CPT (CPTClassCopy Class
c) IsConst
_ ->
      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
f 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
f) ]
        [ CName Identity -> [CExp Identity] -> CExp Identity
forall (f :: * -> *). CName f -> [CExp f] -> CExp f
R.CNew (String -> CName Identity
R.sname String
f) [CExp Identity
e] ]
      where f :: String
f = Class -> String
ffiClassName Class
c
      -- "to_nonconst<" <> f <> "_t," <> f <> ">(new " <> f <> "(" <> e <> "))"
    CPT (CPTClassMove Class
c) IsConst
_ ->
      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
"from_nonconst_to_nonconst")
            [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f 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
f) ]
            [ CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CAddr CExp Identity
e ]
        ]
      where f :: String
f = Class -> String
ffiClassName Class
c
      -- "std::move(to_nonconst<" <> f <> "_t," <> f <>">(&(" <> e <> ")))"
    TemplateApp TemplateAppInfo
_  ->
      String -> CExp Identity
forall a. HasCallStack => String -> a
error String
"cxx2C: TemplateApp"
                              -- g <> "* r = new " <> g <> "(" <> e <> "); "
                              --  <> "return (static_cast<void*>(r));"
    TemplateAppRef TemplateAppInfo
_ ->
      String -> CExp Identity
forall a. HasCallStack => String -> a
error String
"cxx2C: TemplateAppRef"
                              -- g <> "* r = new " <> g <> "(" <> e <> "); "
                              -- <> "return (static_cast<void*>(r));"
    TemplateAppMove TemplateAppInfo
_ ->
      String -> CExp Identity
forall a. HasCallStack => String -> a
error String
"cxx2C: TemplateAppMove"
    TemplateType TemplateClass
_ ->
      String -> CExp Identity
forall a. HasCallStack => String -> a
error String
"cxx2C: TemplateType"
    TemplateParam String
_ ->
      String -> CExp Identity
forall a. HasCallStack => String -> a
error String
"cxx2C: TemplateParam"
                              -- if b then e
                              --      else "to_nonconst<Type ## _t, Type>((Type *)&(" <> e <> "))"
    TemplateParamPointer String
_ ->
      String -> CExp Identity
forall a. HasCallStack => String -> a
error String
"cxx2C: TemplateParamPointer"
                              -- if b then "(" <> callstr <> ");"
                              --      else "to_nonconst<Type ## _t, Type>(" <> e <> ") ;"

tmplAppTypeFromForm :: Form -> [R.CType Identity] -> R.CType Identity
tmplAppTypeFromForm :: Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm (FormSimple String
tclass) [CType Identity]
targs = CName Identity -> [CType Identity] -> CType Identity
forall (f :: * -> *). CName f -> [CType f] -> CType f
R.CTTApp (String -> CName Identity
R.sname String
tclass) [CType Identity]
targs
tmplAppTypeFromForm (FormNested String
tclass String
inner) [CType Identity]
targs = CType Identity -> CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f -> CType f
R.CTScoped (CName Identity -> [CType Identity] -> CType Identity
forall (f :: * -> *). CName f -> [CType f] -> CType f
R.CTTApp (String -> CName Identity
R.sname String
tclass) [CType Identity]
targs) (String -> CType Identity
forall (f :: * -> *). String -> CType f
R.CTVerbatim String
inner)

tmplArgToCTypVar ::
     IsCPrimitive
  -> TemplateClass
  -> Arg
  -> (R.CType Identity, R.CName Identity)
tmplArgToCTypVar :: IsCPrimitive
-> TemplateClass -> Arg -> (CType Identity, CName Identity)
tmplArgToCTypVar IsCPrimitive
_ TemplateClass
_  (Arg (CT CTypes
ctyp IsConst
isconst) String
varname) =
  (CTypes -> IsConst -> CType Identity
ctypToCType CTypes
ctyp IsConst
isconst, String -> CName Identity
R.sname String
varname)
tmplArgToCTypVar IsCPrimitive
_ TemplateClass
_ (Arg Types
SelfType String
varname) =
  (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
varname)
tmplArgToCTypVar IsCPrimitive
_ TemplateClass
_ (Arg (CPT (CPTClass Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const   -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (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
"_p")), String -> CName Identity
R.sname String
varname)
tmplArgToCTypVar IsCPrimitive
_ TemplateClass
_ (Arg (CPT (CPTClassRef Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const   -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (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
"_p")), String -> CName Identity
R.sname String
varname)
tmplArgToCTypVar IsCPrimitive
_ TemplateClass
_ (Arg (CPT (CPTClassMove Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const   -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (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
"_p")), String -> CName Identity
R.sname String
varname)
tmplArgToCTypVar IsCPrimitive
_ TemplateClass
_ (Arg (TemplateApp     TemplateAppInfo
_) String
v) = (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
_ TemplateClass
_ (Arg (TemplateAppRef  TemplateAppInfo
_) String
v) = (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
_ TemplateClass
_ (Arg (TemplateAppMove TemplateAppInfo
_) String
v) = (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
_ TemplateClass
_ (Arg (TemplateType    TemplateClass
_) String
v) = (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
CPrim    TemplateClass
_ (Arg (TemplateParam String
t) String
v) = (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
t), String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
NonCPrim TemplateClass
_ (Arg (TemplateParam String
t) String
v) = (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
t, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p" ]), String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
CPrim    TemplateClass
_ (Arg (TemplateParamPointer String
t) String
v) = (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
t), String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
NonCPrim TemplateClass
_ (Arg (TemplateParamPointer String
t) String
v) = (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
t, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p"]), String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
_ TemplateClass
_ Arg
_ = String -> (CType Identity, CName Identity)
forall a. HasCallStack => String -> a
error String
"tmplArgToCTypVar: undefined"

tmplAllArgsToCTypVar ::
     IsCPrimitive
  -> Selfness
  -> TemplateClass
  -> [Arg]
  -> [ (R.CType Identity, R.CName Identity) ]
tmplAllArgsToCTypVar :: IsCPrimitive
-> Selfness
-> TemplateClass
-> [Arg]
-> [(CType Identity, CName Identity)]
tmplAllArgsToCTypVar IsCPrimitive
b Selfness
s TemplateClass
t [Arg]
args =
  let args' :: [Arg]
args' = case Selfness
s of
                Selfness
Self   -> (Types -> String -> Arg
Arg (TemplateClass -> Types
TemplateType TemplateClass
t) String
"p") Arg -> [Arg] -> [Arg]
forall a. a -> [a] -> [a]
: [Arg]
args
                Selfness
NoSelf -> [Arg]
args
  in (Arg -> (CType Identity, CName Identity))
-> [Arg] -> [(CType Identity, CName Identity)]
forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive
-> TemplateClass -> Arg -> (CType Identity, CName Identity)
tmplArgToCTypVar IsCPrimitive
b TemplateClass
t) [Arg]
args'

-- TODO: Rewrite this with static_cast.
--       Implement missing cases.
tmplArgToCallCExp
  :: IsCPrimitive
  -> Arg
  -> R.CExp Identity
tmplArgToCallCExp :: IsCPrimitive -> Arg -> CExp Identity
tmplArgToCallCExp IsCPrimitive
_ (Arg (CPT (CPTClass Class
c) IsConst
_) String
varname) =
  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
str), 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 -> CExp Identity
forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
varname) ]
  where str :: String
str = Class -> String
ffiClassName Class
c
tmplArgToCallCExp IsCPrimitive
_ (Arg (CPT (CPTClassRef Class
c) IsConst
_) String
varname) =
  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_nonconstref_to_nonconstref")
    [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str), 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")) ]
    [ CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar (CExp Identity -> CExp Identity) -> CExp Identity -> CExp Identity
forall a b. (a -> b) -> a -> b
$ 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
varname ]
  where str :: String
str = Class -> String
ffiClassName Class
c
tmplArgToCallCExp IsCPrimitive
_ (Arg (CPT (CPTClassMove Class
c) IsConst
_) String
varname) =
  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
"from_nonconstref_to_nonconstref")
      [ CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str), 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")) ]
      [ CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar (CExp Identity -> CExp Identity) -> CExp Identity -> CExp Identity
forall a b. (a -> b) -> a -> b
$ 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
varname ]
    ]
  where str :: String
str = Class -> String
ffiClassName Class
c
tmplArgToCallCExp IsCPrimitive
_ (Arg (CT (CRef CTypes
_) IsConst
_) String
varname) =
  CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar (CExp Identity -> CExp Identity) -> CExp Identity -> CExp Identity
forall a b. (a -> b) -> a -> b
$ 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
varname
tmplArgToCallCExp IsCPrimitive
_ (Arg (TemplateApp TemplateAppInfo
x) String
varname) =
  let targs :: [CType Identity]
targs = (TemplateArgType -> CType Identity)
-> [TemplateArgType] -> [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)
-> (TemplateArgType -> CName Identity)
-> TemplateArgType
-> CType Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CName Identity
R.sname (String -> CName Identity)
-> (TemplateArgType -> String) -> TemplateArgType -> CName Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateArgType -> String
hsClassNameForTArg) (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
  in 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 (TemplateClass -> Form
tclass_cxxform (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x)) [CType Identity]
targs ]
       [ 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
varname ]
tmplArgToCallCExp IsCPrimitive
_ (Arg (TemplateAppRef TemplateAppInfo
x) String
varname) =
  let targs :: [CType Identity]
targs = (TemplateArgType -> CType Identity)
-> [TemplateArgType] -> [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)
-> (TemplateArgType -> CName Identity)
-> TemplateArgType
-> CType Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CName Identity
R.sname (String -> CName Identity)
-> (TemplateArgType -> String) -> TemplateArgType -> CName Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateArgType -> String
hsClassNameForTArg) (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
  in CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar (CExp Identity -> CExp Identity) -> CExp Identity -> CExp 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 (TemplateClass -> Form
tclass_cxxform (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x)) [CType Identity]
targs ]
         [ 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
varname ]
tmplArgToCallCExp IsCPrimitive
_ (Arg (TemplateAppMove TemplateAppInfo
x) String
varname) =
  let targs :: [CType Identity]
targs = (TemplateArgType -> CType Identity)
-> [TemplateArgType] -> [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)
-> (TemplateArgType -> CName Identity)
-> TemplateArgType
-> CType Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CName Identity
R.sname (String -> CName Identity)
-> (TemplateArgType -> String) -> TemplateArgType -> CName Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateArgType -> String
hsClassNameForTArg) (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
  in 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"))
       [ CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar (CExp Identity -> CExp Identity) -> CExp Identity -> CExp 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 (TemplateClass -> Form
tclass_cxxform (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x)) [CType Identity]
targs ]
             [ 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
varname ]
       ]
tmplArgToCallCExp IsCPrimitive
b (Arg (TemplateParam String
typ) String
varname) =
  case IsCPrimitive
b of
    IsCPrimitive
CPrim    -> 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
varname
    IsCPrimitive
NonCPrim -> CExp Identity -> CExp Identity
forall (f :: * -> *). CExp f -> CExp f
R.CStar (CExp Identity -> CExp Identity) -> CExp Identity -> CExp 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
typ), 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 -> 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
varname ]
tmplArgToCallCExp IsCPrimitive
b (Arg (TemplateParamPointer String
typ) String
varname) =
  case IsCPrimitive
b of
    IsCPrimitive
CPrim    -> 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
varname
    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 (String -> CName Identity
R.sname String
typ), 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 -> 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
varname ]
tmplArgToCallCExp IsCPrimitive
_ (Arg Types
_ String
varname) = 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
varname

tmplReturnCType ::
     IsCPrimitive
  -> Types
  -> R.CType Identity
tmplReturnCType :: IsCPrimitive -> Types -> CType Identity
tmplReturnCType IsCPrimitive
_ (CT CTypes
ctyp IsConst
isconst)        = CTypes -> IsConst -> CType Identity
ctypToCType CTypes
ctyp IsConst
isconst
tmplReturnCType IsCPrimitive
_ Types
Void                     = CType Identity
forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
_ Types
SelfType                 = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
_ (CPT (CPTClass Class
c) IsConst
_)     = 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
"_p"))
tmplReturnCType IsCPrimitive
_ (CPT (CPTClassRef Class
c) IsConst
_)  = 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
"_p"))
tmplReturnCType IsCPrimitive
_ (CPT (CPTClassCopy Class
c) IsConst
_) = 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
"_p"))
tmplReturnCType IsCPrimitive
_ (CPT (CPTClassMove Class
c) IsConst
_) = 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
"_p"))
tmplReturnCType IsCPrimitive
_ (TemplateApp     TemplateAppInfo
_)      = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
_ (TemplateAppRef  TemplateAppInfo
_)      = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
_ (TemplateAppMove TemplateAppInfo
_)      = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
_ (TemplateType TemplateClass
_)         = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
b (TemplateParam String
t)        = case IsCPrimitive
b of
                                                   IsCPrimitive
CPrim    -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
t
                                                   IsCPrimitive
NonCPrim -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ [NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [ String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p" ]
tmplReturnCType IsCPrimitive
b (TemplateParamPointer String
t) = case IsCPrimitive
b of
                                                   IsCPrimitive
CPrim    -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
t
                                                   IsCPrimitive
NonCPrim -> CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ [NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [ String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p" ]

-- ---------------------------
-- Template Member Function --
-- ---------------------------

-- |
tmplMemFuncArgToCTypVar :: Class -> Arg -> (R.CType Identity, R.CName Identity)
tmplMemFuncArgToCTypVar :: Class -> Arg -> (CType Identity, CName Identity)
tmplMemFuncArgToCTypVar Class
_ (Arg (CT CTypes
ctyp IsConst
isconst) String
varname) =
  (CTypes -> IsConst -> CType Identity
ctypToCType CTypes
ctyp IsConst
isconst, String -> CName Identity
R.sname String
varname)
tmplMemFuncArgToCTypVar Class
c (Arg Types
SelfType String
varname) =
  (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
"_p")), String -> CName Identity
R.sname String
varname)
tmplMemFuncArgToCTypVar Class
_ (Arg (CPT (CPTClass Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const   -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (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
"_p")), String -> CName Identity
R.sname String
varname)
tmplMemFuncArgToCTypVar Class
_ (Arg (CPT (CPTClassRef Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const   -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (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
"_p")), String -> CName Identity
R.sname String
varname)
tmplMemFuncArgToCTypVar Class
_ (Arg (CPT (CPTClassMove Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const   -> (CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (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
"_p")), String -> CName Identity
R.sname String
varname)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateApp     TemplateAppInfo
_) String
v)      = (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateAppRef  TemplateAppInfo
_) String
v)      = (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateAppMove TemplateAppInfo
_) String
v)      = (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateType   TemplateClass
_)  String
v)      = (CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateParam String
t) String
v)        = (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
t, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p" ]), String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateParamPointer String
t) String
v) = (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
t, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p" ]), String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ Arg
_ = String -> (CType Identity, CName Identity)
forall a. HasCallStack => String -> a
error String
"tmplMemFuncArgToString: undefined"


-- |
tmplMemFuncReturnCType :: Class -> Types -> R.CType Identity
tmplMemFuncReturnCType :: Class -> Types -> CType Identity
tmplMemFuncReturnCType Class
_ (CT CTypes
ctyp IsConst
isconst)        = CTypes -> IsConst -> CType Identity
ctypToCType CTypes
ctyp IsConst
isconst
tmplMemFuncReturnCType Class
_ Types
Void                     = CType Identity
forall (f :: * -> *). CType f
R.CTVoid
tmplMemFuncReturnCType Class
c Types
SelfType                 = 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
"_p"))
tmplMemFuncReturnCType Class
_ (CPT (CPTClass Class
c) IsConst
_)     = 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
"_p"))
tmplMemFuncReturnCType Class
_ (CPT (CPTClassRef Class
c) IsConst
_)  = 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
"_p"))
tmplMemFuncReturnCType Class
_ (CPT (CPTClassCopy Class
c) IsConst
_) = 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
"_p"))
tmplMemFuncReturnCType Class
_ (CPT (CPTClassMove Class
c) IsConst
_) = 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
"_p"))
tmplMemFuncReturnCType Class
_ (TemplateApp     TemplateAppInfo
_)      = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
tmplMemFuncReturnCType Class
_ (TemplateAppRef  TemplateAppInfo
_)      = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
tmplMemFuncReturnCType Class
_ (TemplateAppMove TemplateAppInfo
_)      = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
tmplMemFuncReturnCType Class
_ (TemplateType TemplateClass
_)         = CType Identity -> CType Identity
forall (f :: * -> *). CType f -> CType f
R.CTStar CType Identity
forall (f :: * -> *). CType f
R.CTVoid
tmplMemFuncReturnCType Class
_ (TemplateParam String
t)        = CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ [NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [ String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p" ]
tmplMemFuncReturnCType Class
_ (TemplateParamPointer String
t) = CName Identity -> CType Identity
forall (f :: * -> *). CName f -> CType f
R.CTSimple (CName Identity -> CType Identity)
-> CName Identity -> CType Identity
forall a b. (a -> b) -> a -> b
$ [NamePart Identity] -> CName Identity
forall (f :: * -> *). [NamePart f] -> CName f
R.CName [ String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, String -> NamePart Identity
forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p" ]

-- |
convertC2HS :: CTypes -> Type ()
convertC2HS :: CTypes -> Type ()
convertC2HS CTypes
CTBool        = String -> Type ()
tycon String
"CBool"
convertC2HS CTypes
CTChar        = String -> Type ()
tycon String
"CChar"
convertC2HS CTypes
CTClock       = String -> Type ()
tycon String
"CClock"
convertC2HS CTypes
CTDouble      = String -> Type ()
tycon String
"CDouble"
convertC2HS CTypes
CTFile        = String -> Type ()
tycon String
"CFile"
convertC2HS CTypes
CTFloat       = String -> Type ()
tycon String
"CFloat"
convertC2HS CTypes
CTFpos        = String -> Type ()
tycon String
"CFpos"
convertC2HS CTypes
CTInt         = String -> Type ()
tycon String
"CInt"
convertC2HS CTypes
CTIntMax      = String -> Type ()
tycon String
"CIntMax"
convertC2HS CTypes
CTIntPtr      = String -> Type ()
tycon String
"CIntPtr"
convertC2HS CTypes
CTJmpBuf      = String -> Type ()
tycon String
"CJmpBuf"
convertC2HS CTypes
CTLLong       = String -> Type ()
tycon String
"CLLong"
convertC2HS CTypes
CTLong        = String -> Type ()
tycon String
"CLong"
convertC2HS CTypes
CTPtrdiff     = String -> Type ()
tycon String
"CPtrdiff"
convertC2HS CTypes
CTSChar       = String -> Type ()
tycon String
"CSChar"
convertC2HS CTypes
CTSUSeconds   = String -> Type ()
tycon String
"CSUSeconds"
convertC2HS CTypes
CTShort       = String -> Type ()
tycon String
"CShort"
convertC2HS CTypes
CTSigAtomic   = String -> Type ()
tycon String
"CSigAtomic"
convertC2HS CTypes
CTSize        = String -> Type ()
tycon String
"CSize"
convertC2HS CTypes
CTTime        = String -> Type ()
tycon String
"CTime"
convertC2HS CTypes
CTUChar       = String -> Type ()
tycon String
"CUChar"
convertC2HS CTypes
CTUInt        = String -> Type ()
tycon String
"CUInt"
convertC2HS CTypes
CTUIntMax     = String -> Type ()
tycon String
"CUIntMax"
convertC2HS CTypes
CTUIntPtr     = String -> Type ()
tycon String
"CUIntPtr"
convertC2HS CTypes
CTULLong      = String -> Type ()
tycon String
"CULLong"
convertC2HS CTypes
CTULong       = String -> Type ()
tycon String
"CULong"
convertC2HS CTypes
CTUSeconds    = String -> Type ()
tycon String
"CUSeconds"
convertC2HS CTypes
CTUShort      = String -> Type ()
tycon String
"CUShort"
convertC2HS CTypes
CTWchar       = String -> Type ()
tycon String
"CWchar"
convertC2HS CTypes
CTInt8        = String -> Type ()
tycon String
"Int8"
convertC2HS CTypes
CTInt16       = String -> Type ()
tycon String
"Int16"
convertC2HS CTypes
CTInt32       = String -> Type ()
tycon String
"Int32"
convertC2HS CTypes
CTInt64       = String -> Type ()
tycon String
"Int64"
convertC2HS CTypes
CTUInt8       = String -> Type ()
tycon String
"Word8"
convertC2HS CTypes
CTUInt16      = String -> Type ()
tycon String
"Word16"
convertC2HS CTypes
CTUInt32      = String -> Type ()
tycon String
"Word32"
convertC2HS CTypes
CTUInt64      = String -> Type ()
tycon String
"Word64"
convertC2HS CTypes
CTString      = String -> Type ()
tycon String
"CString"
convertC2HS CTypes
CTVoidStar    = Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"Ptr") Type ()
unit_tycon
convertC2HS (CEnum CTypes
t String
_)   = CTypes -> Type ()
convertC2HS CTypes
t
convertC2HS (CPointer CTypes
t)  = Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"Ptr") (CTypes -> Type ()
convertC2HS CTypes
t)
convertC2HS (CRef CTypes
t)      = Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"Ptr") (CTypes -> Type ()
convertC2HS CTypes
t)

-- |
convertCpp2HS :: Maybe Class -> Types -> Type ()
convertCpp2HS :: Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
_c Types
Void                      = Type ()
unit_tycon
convertCpp2HS (Just Class
c) Types
SelfType            = String -> Type ()
tycon (((String, String) -> String
forall a b. (a, b) -> a
fst((String, String) -> String)
-> (Class -> (String, String)) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Class -> (String, String)
hsClassName) Class
c)
convertCpp2HS Maybe Class
Nothing Types
SelfType             = String -> Type ()
forall a. HasCallStack => String -> a
error String
"convertCpp2HS : SelfType but no class "
convertCpp2HS Maybe Class
_c (CT CTypes
t IsConst
_)                  = CTypes -> Type ()
convertC2HS CTypes
t
convertCpp2HS Maybe Class
_c (CPT (CPTClass Class
c') IsConst
_)     = (String -> Type ()
tycon (String -> Type ()) -> (Class -> String) -> Class -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (Class -> (String, String)) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> (String, String)
hsClassName) Class
c'
convertCpp2HS Maybe Class
_c (CPT (CPTClassRef Class
c') IsConst
_)  = (String -> Type ()
tycon (String -> Type ()) -> (Class -> String) -> Class -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (Class -> (String, String)) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> (String, String)
hsClassName) Class
c'
convertCpp2HS Maybe Class
_c (CPT (CPTClassCopy Class
c') IsConst
_) = (String -> Type ()
tycon (String -> Type ()) -> (Class -> String) -> Class -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (Class -> (String, String)) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> (String, String)
hsClassName) Class
c'
convertCpp2HS Maybe Class
_c (CPT (CPTClassMove Class
c') IsConst
_) = (String -> Type ()
tycon (String -> Type ()) -> (Class -> String) -> Class -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (Class -> (String, String)) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> (String, String)
hsClassName) Class
c'
convertCpp2HS Maybe Class
_c (TemplateApp TemplateAppInfo
x) =
  (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$ (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon ([String] -> [Type ()]) -> [String] -> [Type ()]
forall a b. (a -> b) -> a -> b
$
    TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (TemplateArgType -> String) -> [TemplateArgType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
convertCpp2HS Maybe Class
_c (TemplateAppRef TemplateAppInfo
x) =
  (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$ (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon ([String] -> [Type ()]) -> [String] -> [Type ()]
forall a b. (a -> b) -> a -> b
$
    TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (TemplateArgType -> String) -> [TemplateArgType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
convertCpp2HS Maybe Class
_c (TemplateAppMove TemplateAppInfo
x) =
  (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$ (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon ([String] -> [Type ()]) -> [String] -> [Type ()]
forall a b. (a -> b) -> a -> b
$
    TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (TemplateArgType -> String) -> [TemplateArgType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
convertCpp2HS Maybe Class
_c (TemplateType TemplateClass
t) =
  (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$
    String -> Type ()
tycon (TemplateClass -> String
tclass_name TemplateClass
t) Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
mkTVar (TemplateClass -> [String]
tclass_params TemplateClass
t)
convertCpp2HS Maybe Class
_c (TemplateParam String
p)         = String -> Type ()
mkTVar String
p
convertCpp2HS Maybe Class
_c (TemplateParamPointer String
p)  = String -> Type ()
mkTVar String
p

-- |
convertCpp2HS4Tmpl
  :: Type ()    -- ^ self
  -> Maybe Class
  -> [Type ()]    -- ^ type paramemter splice
  -> Types
  -> Type ()
convertCpp2HS4Tmpl :: Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
_ Maybe Class
c [Type ()]
_ Types
Void                          = Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
c Types
Void
convertCpp2HS4Tmpl Type ()
_ (Just Class
c) [Type ()]
_ Types
SelfType               = Maybe Class -> Types -> Type ()
convertCpp2HS (Class -> Maybe Class
forall a. a -> Maybe a
Just Class
c) Types
SelfType
convertCpp2HS4Tmpl Type ()
_ Maybe Class
Nothing [Type ()]
_ Types
SelfType                = Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing Types
SelfType
convertCpp2HS4Tmpl Type ()
_ Maybe Class
c [Type ()]
_ x :: Types
x@(CT CTypes
_ IsConst
_)                    = Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
c Types
x
convertCpp2HS4Tmpl Type ()
_ Maybe Class
c [Type ()]
_ x :: Types
x@(CPT (CPTClass Class
_) IsConst
_)        = Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
c Types
x
convertCpp2HS4Tmpl Type ()
_ Maybe Class
c [Type ()]
_ x :: Types
x@(CPT (CPTClassRef Class
_) IsConst
_)     = Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
c Types
x
convertCpp2HS4Tmpl Type ()
_ Maybe Class
c [Type ()]
_ x :: Types
x@(CPT (CPTClassCopy Class
_) IsConst
_)    = Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
c Types
x
convertCpp2HS4Tmpl Type ()
_ Maybe Class
c [Type ()]
_ x :: Types
x@(CPT (CPTClassMove Class
_) IsConst
_)    = Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
c Types
x
convertCpp2HS4Tmpl Type ()
_ Maybe Class
_ [Type ()]
ss (TemplateApp TemplateAppInfo
info) =
  let pss :: [(TemplateArgType, Type ())]
pss = [TemplateArgType] -> [Type ()] -> [(TemplateArgType, Type ())]
forall a b. [a] -> [b] -> [(a, b)]
zip (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
info) [Type ()]
ss
  in (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$
       String -> Type ()
tycon (TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
info)) Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: ((TemplateArgType, Type ()) -> Type ())
-> [(TemplateArgType, Type ())] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (\case (TArg_TypeParam String
_,Type ()
s) -> Type ()
s; (TemplateArgType
p,Type ()
_) -> String -> Type ()
tycon (TemplateArgType -> String
hsClassNameForTArg TemplateArgType
p)) [(TemplateArgType, Type ())]
pss
convertCpp2HS4Tmpl Type ()
_ Maybe Class
_ [Type ()]
ss (TemplateAppRef TemplateAppInfo
info) =
  let pss :: [(TemplateArgType, Type ())]
pss = [TemplateArgType] -> [Type ()] -> [(TemplateArgType, Type ())]
forall a b. [a] -> [b] -> [(a, b)]
zip (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
info) [Type ()]
ss
  in (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$
       String -> Type ()
tycon (TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
info)) Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: ((TemplateArgType, Type ()) -> Type ())
-> [(TemplateArgType, Type ())] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (\case (TArg_TypeParam String
_,Type ()
s) -> Type ()
s; (TemplateArgType
p,Type ()
_) -> String -> Type ()
tycon (TemplateArgType -> String
hsClassNameForTArg TemplateArgType
p)) [(TemplateArgType, Type ())]
pss
convertCpp2HS4Tmpl Type ()
_ Maybe Class
_ [Type ()]
ss (TemplateAppMove TemplateAppInfo
info) =
  let pss :: [(TemplateArgType, Type ())]
pss = [TemplateArgType] -> [Type ()] -> [(TemplateArgType, Type ())]
forall a b. [a] -> [b] -> [(a, b)]
zip (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
info) [Type ()]
ss
  in (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$
       String -> Type ()
tycon (TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
info)) Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: ((TemplateArgType, Type ()) -> Type ())
-> [(TemplateArgType, Type ())] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (\case (TArg_TypeParam String
_,Type ()
s) -> Type ()
s; (TemplateArgType
p,Type ()
_) -> String -> Type ()
tycon (TemplateArgType -> String
hsClassNameForTArg TemplateArgType
p)) [(TemplateArgType, Type ())]
pss
convertCpp2HS4Tmpl Type ()
e Maybe Class
_ [Type ()]
_ (TemplateType TemplateClass
_)         = Type ()
e
convertCpp2HS4Tmpl Type ()
_ Maybe Class
_ [Type ()]
_ (TemplateParam String
p)        = Splice () -> Type ()
tySplice (Splice () -> Type ())
-> (String -> Splice ()) -> String -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Splice ()
parenSplice (Exp () -> Splice ()) -> (String -> Exp ()) -> String -> Splice ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exp ()
mkVar (String -> Type ()) -> String -> Type ()
forall a b. (a -> b) -> a -> b
$ String
p
convertCpp2HS4Tmpl Type ()
_ Maybe Class
_ [Type ()]
_ (TemplateParamPointer String
p) = Splice () -> Type ()
tySplice (Splice () -> Type ())
-> (String -> Splice ()) -> String -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Splice ()
parenSplice (Exp () -> Splice ()) -> (String -> Exp ()) -> String -> Splice ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exp ()
mkVar (String -> Type ()) -> String -> Type ()
forall a b. (a -> b) -> a -> b
$ String
p


hsFuncXformer :: Function -> String
hsFuncXformer :: Function -> String
hsFuncXformer func :: Function
func@(Constructor [Arg]
_ Maybe String
_) = let len :: Int
len = [Arg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Function -> [Arg]
genericFuncArgs Function
func)
                                       in if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                                          then String
"xform" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                                          else String
"xformnull"
hsFuncXformer func :: Function
func@(Static Types
_ String
_ [Arg]
_ Maybe String
_) =
  let len :: Int
len = [Arg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Function -> [Arg]
genericFuncArgs Function
func)
  in if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
     then String
"xform" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
     else String
"xformnull"
hsFuncXformer Function
func = let len :: Int
len = [Arg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Function -> [Arg]
genericFuncArgs Function
func)
                     in String
"xform" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
len



classConstraints :: Class -> Context ()
classConstraints :: Class -> Context ()
classConstraints = [Asst ()] -> Context ()
cxTuple ([Asst ()] -> Context ())
-> (Class -> [Asst ()]) -> Class -> Context ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Class -> Asst ()) -> [Class] -> [Asst ()]
forall a b. (a -> b) -> [a] -> [b]
map ((\String
n->QName () -> [Type ()] -> Asst ()
classA (String -> QName ()
unqual String
n) [String -> Type ()
mkTVar String
"a"]) (String -> Asst ()) -> (Class -> String) -> Class -> Asst ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> String
typeclassName) ([Class] -> [Asst ()]) -> (Class -> [Class]) -> Class -> [Asst ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [Class]
class_parents

extractArgRetTypes
  :: Maybe Class  -- ^ class (Nothing for top-level function)
  -> Bool         -- ^ is virtual function?
  -> CFunSig      -- ^ C type signature information for a given function      -- (Args,Types)           -- ^ (argument types, return type) of a given function
  -> HsFunSig     -- ^ Haskell type signature information for the function    --   ([Type ()],[Asst ()])  -- ^ (types, class constraints)
extractArgRetTypes :: Maybe Class -> Bool -> CFunSig -> HsFunSig
extractArgRetTypes Maybe Class
mc Bool
isvirtual (CFunSig [Arg]
args Types
ret) =
  let  ([Type ()]
typs,([Asst ()], Int)
s) = (State ([Asst ()], Int) [Type ()]
 -> ([Asst ()], Int) -> ([Type ()], ([Asst ()], Int)))
-> ([Asst ()], Int)
-> State ([Asst ()], Int) [Type ()]
-> ([Type ()], ([Asst ()], Int))
forall a b c. (a -> b -> c) -> b -> a -> c
flip State ([Asst ()], Int) [Type ()]
-> ([Asst ()], Int) -> ([Type ()], ([Asst ()], Int))
forall s a. State s a -> s -> (a, s)
runState ([],(Int
0 :: Int)) (State ([Asst ()], Int) [Type ()] -> ([Type ()], ([Asst ()], Int)))
-> State ([Asst ()], Int) [Type ()]
-> ([Type ()], ([Asst ()], Int))
forall a b. (a -> b) -> a -> b
$ do
                    [Type ()]
as <- (Arg -> StateT ([Asst ()], Int) Identity (Type ()))
-> [Arg] -> State ([Asst ()], Int) [Type ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Types -> StateT ([Asst ()], Int) Identity (Type ())
mktyp (Types -> StateT ([Asst ()], Int) Identity (Type ()))
-> (Arg -> Types)
-> Arg
-> StateT ([Asst ()], Int) Identity (Type ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) [Arg]
args
                    Type ()
r <- case Types
ret of
                           Types
SelfType -> case Maybe Class
mc of
                                         Maybe Class
Nothing -> String -> StateT ([Asst ()], Int) Identity (Type ())
forall a. HasCallStack => String -> a
error String
"extractArgRetTypes: SelfType return but no class"
                                         Just Class
c -> if Bool
isvirtual then Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Type ()
mkTVar String
"a") else Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Type () -> StateT ([Asst ()], Int) Identity (Type ()))
-> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall a b. (a -> b) -> a -> b
$ String -> Type ()
tycon (((String, String) -> String
forall a b. (a, b) -> a
fst((String, String) -> String)
-> (Class -> (String, String)) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Class -> (String, String)
hsClassName) Class
c)
                           Types
x -> (Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Type () -> StateT ([Asst ()], Int) Identity (Type ()))
-> (Types -> Type ())
-> Types
-> StateT ([Asst ()], Int) Identity (Type ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing) Types
x
                    [Type ()] -> State ([Asst ()], Int) [Type ()]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Type ()]
as [Type ()] -> [Type ()] -> [Type ()]
forall a. [a] -> [a] -> [a]
++ [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
r])
  in   HsFunSig :: [Type ()] -> [Asst ()] -> HsFunSig
HsFunSig { hsSigTypes :: [Type ()]
hsSigTypes = [Type ()]
typs
                , hsSigConstraints :: [Asst ()]
hsSigConstraints = ([Asst ()], Int) -> [Asst ()]
forall a b. (a, b) -> a
fst ([Asst ()], Int)
s
                }
 where addclass :: Class -> StateT ([Asst ()], b) m (Type ())
addclass Class
c = do
         ([Asst ()]
ctxts,b
n) <- StateT ([Asst ()], b) m ([Asst ()], b)
forall (m :: * -> *) s. Monad m => StateT s m s
get
         let cname :: String
cname = ((String, String) -> String
forall a b. (a, b) -> a
fst((String, String) -> String)
-> (Class -> (String, String)) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Class -> (String, String)
hsClassName) Class
c
             iname :: String
iname = String -> String
typeclassNameFromStr String
cname
             tvar :: Type ()
tvar = String -> Type ()
mkTVar (Char
'c' Char -> String -> String
forall a. a -> [a] -> [a]
: b -> String
forall a. Show a => a -> String
show b
n)
             ctxt1 :: Asst ()
ctxt1 = QName () -> [Type ()] -> Asst ()
classA (String -> QName ()
unqual String
iname) [Type ()
tvar]
             ctxt2 :: Asst ()
ctxt2 = QName () -> [Type ()] -> Asst ()
classA (String -> QName ()
unqual String
"FPtr") [Type ()
tvar]
         ([Asst ()], b) -> StateT ([Asst ()], b) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Asst ()
ctxt1Asst () -> [Asst ()] -> [Asst ()]
forall a. a -> [a] -> [a]
:Asst ()
ctxt2Asst () -> [Asst ()] -> [Asst ()]
forall a. a -> [a] -> [a]
:[Asst ()]
ctxts,b
nb -> b -> b
forall a. Num a => a -> a -> a
+b
1)
         Type () -> StateT ([Asst ()], b) m (Type ())
forall (m :: * -> *) a. Monad m => a -> m a
return Type ()
tvar
       addstring :: StateT ([Asst ()], Int) Identity (Type ())
addstring = do
         ([Asst ()]
ctxts,Int
n) <- StateT ([Asst ()], Int) Identity ([Asst ()], Int)
forall (m :: * -> *) s. Monad m => StateT s m s
get
         let tvar :: Type ()
tvar = String -> Type ()
mkTVar (Char
'c' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
n)
             ctxt :: Asst ()
ctxt = QName () -> [Type ()] -> Asst ()
classA (String -> QName ()
unqual String
"Castable") [Type ()
tvar,String -> Type ()
tycon String
"CString"]
         ([Asst ()], Int) -> StateT ([Asst ()], Int) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Asst ()
ctxtAsst () -> [Asst ()] -> [Asst ()]
forall a. a -> [a] -> [a]
:[Asst ()]
ctxts,Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
         Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) a. Monad m => a -> m a
return Type ()
tvar

       mktyp :: Types -> StateT ([Asst ()], Int) Identity (Type ())
mktyp Types
typ =
         case Types
typ of
           Types
SelfType -> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Type ()
mkTVar String
"a")
           CT CTypes
CTString IsConst
Const -> StateT ([Asst ()], Int) Identity (Type ())
addstring
           CT CTypes
_ IsConst
_   -> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Type () -> StateT ([Asst ()], Int) Identity (Type ()))
-> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall a b. (a -> b) -> a -> b
$ Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing Types
typ
           CPT (CPTClass Class
c') IsConst
_    -> Class -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) b.
(Monad m, Num b, Show b) =>
Class -> StateT ([Asst ()], b) m (Type ())
addclass Class
c'
           CPT (CPTClassRef Class
c') IsConst
_ -> Class -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) b.
(Monad m, Num b, Show b) =>
Class -> StateT ([Asst ()], b) m (Type ())
addclass Class
c'
           CPT (CPTClassCopy Class
c') IsConst
_ -> Class -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) b.
(Monad m, Num b, Show b) =>
Class -> StateT ([Asst ()], b) m (Type ())
addclass Class
c'
           CPT (CPTClassMove Class
c') IsConst
_ -> Class -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) b.
(Monad m, Num b, Show b) =>
Class -> StateT ([Asst ()], b) m (Type ())
addclass Class
c'
           -- it is not clear whether the following is okay or not.
           (TemplateApp TemplateAppInfo
x)    -> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type () -> StateT ([Asst ()], Int) Identity (Type ()))
-> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall a b. (a -> b) -> a -> b
$
                                   Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing (TemplateAppInfo -> Types
TemplateApp TemplateAppInfo
x)
           (TemplateAppRef TemplateAppInfo
x) -> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type () -> StateT ([Asst ()], Int) Identity (Type ()))
-> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall a b. (a -> b) -> a -> b
$
                                   Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing (TemplateAppInfo -> Types
TemplateAppRef TemplateAppInfo
x)
           (TemplateAppMove TemplateAppInfo
x)-> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type () -> StateT ([Asst ()], Int) Identity (Type ()))
-> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall a b. (a -> b) -> a -> b
$
                                   Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing (TemplateAppInfo -> Types
TemplateAppMove TemplateAppInfo
x)
           (TemplateType TemplateClass
t)   -> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type () -> StateT ([Asst ()], Int) Identity (Type ()))
-> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall a b. (a -> b) -> a -> b
$
                                   (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon (TemplateClass -> String
tclass_name TemplateClass
t) Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
mkTVar (TemplateClass -> [String]
tclass_params TemplateClass
t))
           (TemplateParam String
p)      -> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Type ()
mkTVar String
p)
           Types
Void -> Type () -> StateT ([Asst ()], Int) Identity (Type ())
forall (m :: * -> *) a. Monad m => a -> m a
return Type ()
unit_tycon
           Types
_ -> String -> StateT ([Asst ()], Int) Identity (Type ())
forall a. HasCallStack => String -> a
error (String
"No such c type : " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Types -> String
forall a. Show a => a -> String
show Types
typ)

functionSignature :: Class -> Function -> Type ()
functionSignature :: Class -> Function -> Type ()
functionSignature Class
c Function
f =
  let HsFunSig [Type ()]
typs [Asst ()]
assts = Maybe Class -> Bool -> CFunSig -> HsFunSig
extractArgRetTypes
                              (Class -> Maybe Class
forall a. a -> Maybe a
Just Class
c)
                              (Function -> Bool
isVirtualFunc Function
f)
                              ([Arg] -> Types -> CFunSig
CFunSig (Function -> [Arg]
genericFuncArgs Function
f) (Function -> Types
genericFuncRet Function
f))
      ctxt :: Context ()
ctxt = [Asst ()] -> Context ()
cxTuple [Asst ()]
assts
      arg0 :: [Type ()] -> [Type ()]
arg0
        | Function -> Bool
isVirtualFunc Function
f    = (String -> Type ()
mkTVar String
"a" Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
:)
        | Function -> Bool
isNonVirtualFunc Function
f = (String -> Type ()
mkTVar ((String, String) -> String
forall a b. (a, b) -> a
fst (Class -> (String, String)
hsClassName Class
c)) Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
:)
        | Bool
otherwise          = [Type ()] -> [Type ()]
forall a. a -> a
id
  in ()
-> Maybe [TyVarBind ()] -> Maybe (Context ()) -> Type () -> Type ()
forall l.
l -> Maybe [TyVarBind l] -> Maybe (Context l) -> Type l -> Type l
TyForall () Maybe [TyVarBind ()]
forall a. Maybe a
Nothing (Context () -> Maybe (Context ())
forall a. a -> Maybe a
Just Context ()
ctxt) ((Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()] -> [Type ()]
arg0 [Type ()]
typs))

functionSignatureT :: TemplateClass -> TemplateFunction -> Type ()
functionSignatureT :: TemplateClass -> TemplateFunction -> Type ()
functionSignatureT TemplateClass
t TFun {String
[Arg]
Types
tfun_args :: TemplateFunction -> [Arg]
tfun_oname :: TemplateFunction -> String
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
tfun_args :: [Arg]
tfun_oname :: String
tfun_name :: String
tfun_ret :: Types
..} =
  let (String
hname,String
_) = TemplateClass -> (String, String)
hsTemplateClassName TemplateClass
t
      slf :: Type ()
slf = (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
hname Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
mkTVar (TemplateClass -> [String]
tclass_params TemplateClass
t))
      ctyp :: Type ()
ctyp = Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing Types
tfun_ret
      lst :: [Type ()]
lst = Type ()
slf Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: (Arg -> Type ()) -> [Arg] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing (Types -> Type ()) -> (Arg -> Types) -> Arg -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) [Arg]
tfun_args
  in (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()]
lst [Type ()] -> [Type ()] -> [Type ()]
forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
ctyp])
functionSignatureT TemplateClass
t TFunNew {[Arg]
Maybe String
tfun_new_alias :: TemplateFunction -> Maybe String
tfun_new_args :: TemplateFunction -> [Arg]
tfun_new_alias :: Maybe String
tfun_new_args :: [Arg]
..} =
  let ctyp :: Type ()
ctyp = Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing (TemplateClass -> Types
TemplateType TemplateClass
t)
      lst :: [Type ()]
lst = (Arg -> Type ()) -> [Arg] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing (Types -> Type ()) -> (Arg -> Types) -> Arg -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) [Arg]
tfun_new_args
  in (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()]
lst [Type ()] -> [Type ()] -> [Type ()]
forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
ctyp])
functionSignatureT TemplateClass
t TemplateFunction
TFunDelete =
  let ctyp :: Type ()
ctyp = Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing (TemplateClass -> Types
TemplateType TemplateClass
t)
  in Type ()
ctyp Type () -> Type () -> Type ()
`tyfun` (Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
unit_tycon)
functionSignatureT TemplateClass
t TFunOp {String
OpExp
Types
tfun_opexp :: TemplateFunction -> OpExp
tfun_opexp :: OpExp
tfun_name :: String
tfun_ret :: Types
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..} =
  let (String
hname,String
_) = TemplateClass -> (String, String)
hsTemplateClassName TemplateClass
t
      slf :: Type ()
slf = (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
hname Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
mkTVar (TemplateClass -> [String]
tclass_params TemplateClass
t))
      ctyp :: Type ()
ctyp = Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing Types
tfun_ret
      lst :: [Type ()]
lst = Type ()
slf Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: (Arg -> Type ()) -> [Arg] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Class -> Types -> Type ()
convertCpp2HS Maybe Class
forall a. Maybe a
Nothing (Types -> Type ()) -> (Arg -> Types) -> Arg -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) (OpExp -> [Arg]
argsFromOpExp OpExp
tfun_opexp)
  in (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()]
lst [Type ()] -> [Type ()] -> [Type ()]
forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
ctyp])

-- TODO: rename this and combine this with functionSignatureTMF
functionSignatureTT :: TemplateClass -> TemplateFunction -> Type ()
functionSignatureTT :: TemplateClass -> TemplateFunction -> Type ()
functionSignatureTT TemplateClass
t TemplateFunction
f = (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()]
lst [Type ()] -> [Type ()] -> [Type ()]
forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
ctyp])
 where
  (String
hname,String
_) = TemplateClass -> (String, String)
hsTemplateClassName TemplateClass
t
  ctyp :: Type ()
ctyp = case TemplateFunction
f of
           TFun {String
[Arg]
Types
tfun_args :: [Arg]
tfun_oname :: String
tfun_name :: String
tfun_ret :: Types
tfun_args :: TemplateFunction -> [Arg]
tfun_oname :: TemplateFunction -> String
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..}    -> Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e Maybe Class
forall a. Maybe a
Nothing [Type ()]
spls Types
tfun_ret
           TFunNew {[Arg]
Maybe String
tfun_new_alias :: Maybe String
tfun_new_args :: [Arg]
tfun_new_alias :: TemplateFunction -> Maybe String
tfun_new_args :: TemplateFunction -> [Arg]
..} -> Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e Maybe Class
forall a. Maybe a
Nothing [Type ()]
spls (TemplateClass -> Types
TemplateType TemplateClass
t)
           TemplateFunction
TFunDelete   -> Type ()
unit_tycon
           TFunOp {String
OpExp
Types
tfun_opexp :: OpExp
tfun_name :: String
tfun_ret :: Types
tfun_opexp :: TemplateFunction -> OpExp
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..}  -> Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e Maybe Class
forall a. Maybe a
Nothing [Type ()]
spls Types
tfun_ret
  e :: Type ()
e = (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
hname Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: [Type ()]
spls)
  spls :: [Type ()]
spls = (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (Splice () -> Type ()
tySplice (Splice () -> Type ())
-> (String -> Splice ()) -> String -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Splice ()
parenSplice (Exp () -> Splice ()) -> (String -> Exp ()) -> String -> Splice ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exp ()
mkVar) ([String] -> [Type ()]) -> [String] -> [Type ()]
forall a b. (a -> b) -> a -> b
$ TemplateClass -> [String]
tclass_params TemplateClass
t
  lst :: [Type ()]
lst =
    case TemplateFunction
f of
      TFun {String
[Arg]
Types
tfun_args :: [Arg]
tfun_oname :: String
tfun_name :: String
tfun_ret :: Types
tfun_args :: TemplateFunction -> [Arg]
tfun_oname :: TemplateFunction -> String
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..}    -> Type ()
e Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: (Arg -> Type ()) -> [Arg] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e Maybe Class
forall a. Maybe a
Nothing [Type ()]
spls (Types -> Type ()) -> (Arg -> Types) -> Arg -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) [Arg]
tfun_args
      TFunNew {[Arg]
Maybe String
tfun_new_alias :: Maybe String
tfun_new_args :: [Arg]
tfun_new_alias :: TemplateFunction -> Maybe String
tfun_new_args :: TemplateFunction -> [Arg]
..} -> (Arg -> Type ()) -> [Arg] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e Maybe Class
forall a. Maybe a
Nothing [Type ()]
spls (Types -> Type ()) -> (Arg -> Types) -> Arg -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) [Arg]
tfun_new_args
      TemplateFunction
TFunDelete   -> [Type ()
e]
      TFunOp {String
OpExp
Types
tfun_opexp :: OpExp
tfun_name :: String
tfun_ret :: Types
tfun_opexp :: TemplateFunction -> OpExp
tfun_name :: TemplateFunction -> String
tfun_ret :: TemplateFunction -> Types
..}  -> Type ()
e Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: (Arg -> Type ()) -> [Arg] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e Maybe Class
forall a. Maybe a
Nothing [Type ()]
spls (Types -> Type ()) -> (Arg -> Types) -> Arg -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) (OpExp -> [Arg]
argsFromOpExp OpExp
tfun_opexp)

-- TODO: rename this and combine this with functionSignatureTT
functionSignatureTMF :: Class -> TemplateMemberFunction -> Type ()
functionSignatureTMF :: Class -> TemplateMemberFunction -> Type ()
functionSignatureTMF Class
c TemplateMemberFunction
f = (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()]
lst [Type ()] -> [Type ()] -> [Type ()]
forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
ctyp])
  where
    spls :: [Type ()]
spls = (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (Splice () -> Type ()
tySplice (Splice () -> Type ())
-> (String -> Splice ()) -> String -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Splice ()
parenSplice (Exp () -> Splice ()) -> (String -> Exp ()) -> String -> Splice ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exp ()
mkVar) (TemplateMemberFunction -> [String]
tmf_params TemplateMemberFunction
f)
    ctyp :: Type ()
ctyp = Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e Maybe Class
forall a. Maybe a
Nothing [Type ()]
spls (TemplateMemberFunction -> Types
tmf_ret TemplateMemberFunction
f)
    e :: Type ()
e = String -> Type ()
tycon ((String, String) -> String
forall a b. (a, b) -> a
fst (Class -> (String, String)
hsClassName Class
c))
    lst :: [Type ()]
lst = Type ()
e Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: (Arg -> Type ()) -> [Arg] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e Maybe Class
forall a. Maybe a
Nothing [Type ()]
spls (Types -> Type ()) -> (Arg -> Types) -> Arg -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) (TemplateMemberFunction -> [Arg]
tmf_args TemplateMemberFunction
f)


tmplAccessorToTFun :: Variable -> Accessor -> TemplateFunction
tmplAccessorToTFun :: Variable -> Accessor -> TemplateFunction
tmplAccessorToTFun v :: Variable
v@(Variable (Arg {String
Types
arg_name :: Arg -> String
arg_name :: String
arg_type :: Types
arg_type :: Arg -> Types
..})) Accessor
a =
  case Accessor
a of
    Accessor
Getter -> TFun :: Types -> String -> String -> [Arg] -> TemplateFunction
TFun { tfun_ret :: Types
tfun_ret   = Types
arg_type
                   , tfun_name :: String
tfun_name  = Variable -> Accessor -> String
tmplAccessorName Variable
v Accessor
Getter
                   , tfun_oname :: String
tfun_oname = Variable -> Accessor -> String
tmplAccessorName Variable
v Accessor
Getter
                   , tfun_args :: [Arg]
tfun_args  = []
                   }
    Accessor
Setter -> TFun :: Types -> String -> String -> [Arg] -> TemplateFunction
TFun { tfun_ret :: Types
tfun_ret   = Types
Void
                   , tfun_name :: String
tfun_name  = Variable -> Accessor -> String
tmplAccessorName Variable
v Accessor
Setter
                   , tfun_oname :: String
tfun_oname = Variable -> Accessor -> String
tmplAccessorName Variable
v Accessor
Setter
                   , tfun_args :: [Arg]
tfun_args = [Types -> String -> Arg
Arg Types
arg_type String
"value"]
                   }


accessorCFunSig :: Types -> Accessor -> CFunSig
accessorCFunSig :: Types -> Accessor -> CFunSig
accessorCFunSig Types
typ Accessor
Getter = [Arg] -> Types -> CFunSig
CFunSig [] Types
typ
accessorCFunSig Types
typ Accessor
Setter = [Arg] -> Types -> CFunSig
CFunSig [Types -> String -> Arg
Arg Types
typ String
"x"] Types
Void


accessorSignature :: Class -> Variable -> Accessor -> Type ()
accessorSignature :: Class -> Variable -> Accessor -> Type ()
accessorSignature Class
c Variable
v Accessor
accessor =
  let csig :: CFunSig
csig = Types -> Accessor -> CFunSig
accessorCFunSig (Arg -> Types
arg_type (Variable -> Arg
unVariable Variable
v)) Accessor
accessor
      HsFunSig [Type ()]
typs [Asst ()]
assts = Maybe Class -> Bool -> CFunSig -> HsFunSig
extractArgRetTypes (Class -> Maybe Class
forall a. a -> Maybe a
Just Class
c) Bool
False CFunSig
csig
      ctxt :: Context ()
ctxt = [Asst ()] -> Context ()
cxTuple [Asst ()]
assts
      arg0 :: [Type ()] -> [Type ()]
arg0 = (String -> Type ()
mkTVar ((String, String) -> String
forall a b. (a, b) -> a
fst (Class -> (String, String)
hsClassName Class
c)) Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
:)
  in ()
-> Maybe [TyVarBind ()] -> Maybe (Context ()) -> Type () -> Type ()
forall l.
l -> Maybe [TyVarBind l] -> Maybe (Context l) -> Type l -> Type l
TyForall () Maybe [TyVarBind ()]
forall a. Maybe a
Nothing (Context () -> Maybe (Context ())
forall a. a -> Maybe a
Just Context ()
ctxt) ((Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()] -> [Type ()]
arg0 [Type ()]
typs))


-- | this is for FFI type.
hsFFIFuncTyp :: Maybe (Selfness, Class) -> CFunSig -> Type ()
hsFFIFuncTyp :: Maybe (Selfness, Class) -> CFunSig -> Type ()
hsFFIFuncTyp Maybe (Selfness, Class)
msc (CFunSig [Arg]
args Types
ret) =
  (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$ case Maybe (Selfness, Class)
msc of
                   Maybe (Selfness, Class)
Nothing         -> [Type ()]
argtyps [Type ()] -> [Type ()] -> [Type ()]
forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
rettyp]
                   Just (Selfness
Self,Class
_)   -> Type ()
selftypType () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: [Type ()]
argtyps [Type ()] -> [Type ()] -> [Type ()]
forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
rettyp]
                   Just (Selfness
NoSelf,Class
_) -> [Type ()]
argtyps [Type ()] -> [Type ()] -> [Type ()]
forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
rettyp]
  where argtyps :: [Type ()]
        argtyps :: [Type ()]
argtyps = (Arg -> Type ()) -> [Arg] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map (Types -> Type ()
hsargtype (Types -> Type ()) -> (Arg -> Types) -> Arg -> Type ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) [Arg]
args
        rettyp :: Type ()
        rettyp :: Type ()
rettyp  = Types -> Type ()
hsrettype Types
ret
        selftyp :: Type ()
selftyp = case Maybe (Selfness, Class)
msc of
                    Just (Selfness
_,Class
c) -> Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (String -> Type ()
tycon ((String, String) -> String
forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
c)))
                    Maybe (Selfness, Class)
Nothing    -> String -> Type ()
forall a. HasCallStack => String -> a
error String
"hsFFIFuncTyp: no self for top level function"
        hsargtype :: Types -> Type ()
        hsargtype :: Types -> Type ()
hsargtype (CT CTypes
ctype IsConst
_)               = CTypes -> Type ()
convertC2HS CTypes
ctype
        hsargtype (CPT (CPTClass Class
d) IsConst
_)       = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (String -> Type ()
tycon String
rawname)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
d)
        hsargtype (CPT (CPTClassRef Class
d) IsConst
_)    = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (String -> Type ()
tycon String
rawname)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
d)
        hsargtype (CPT (CPTClassMove Class
d) IsConst
_)    = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (String -> Type ()
tycon String
rawname)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
d)
        hsargtype (CPT (CPTClassCopy Class
d) IsConst
_)    = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (String -> Type ()
tycon String
rawname)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
d)
        hsargtype (TemplateApp TemplateAppInfo
x)    = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (Type () -> Type ()) -> Type () -> Type ()
forall a b. (a -> b) -> a -> b
$
                                         (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$
                                           (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon ([String] -> [Type ()]) -> [String] -> [Type ()]
forall a b. (a -> b) -> a -> b
$
                                            String
rawname String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (TemplateArgType -> String) -> [TemplateArgType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (TemplateClass -> (String, String)
hsTemplateClassName (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x))
        hsargtype (TemplateAppRef TemplateAppInfo
x) = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (Type () -> Type ()) -> Type () -> Type ()
forall a b. (a -> b) -> a -> b
$
                                         (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$
                                           (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon ([String] -> [Type ()]) -> [String] -> [Type ()]
forall a b. (a -> b) -> a -> b
$
                                             String
rawname String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (TemplateArgType -> String) -> [TemplateArgType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (TemplateClass -> (String, String)
hsTemplateClassName (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x))
        hsargtype (TemplateAppMove TemplateAppInfo
x)= Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (Type () -> Type ()) -> Type () -> Type ()
forall a b. (a -> b) -> a -> b
$
                                         (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$
                                           (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon ([String] -> [Type ()]) -> [String] -> [Type ()]
forall a b. (a -> b) -> a -> b
$
                                             String
rawname String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (TemplateArgType -> String) -> [TemplateArgType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (TemplateClass -> (String, String)
hsTemplateClassName (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x))
        hsargtype (TemplateType TemplateClass
t)           = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (Type () -> Type ()) -> Type () -> Type ()
forall a b. (a -> b) -> a -> b
$ (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
rawname Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
mkTVar (TemplateClass -> [String]
tclass_params TemplateClass
t))
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (TemplateClass -> (String, String)
hsTemplateClassName TemplateClass
t)
        hsargtype (TemplateParam String
p)          = String -> Type ()
mkTVar String
p
        hsargtype Types
SelfType                   = Type ()
selftyp
        hsargtype Types
_ = String -> Type ()
forall a. HasCallStack => String -> a
error String
"hsFuncTyp: undefined hsargtype"
        ---------------------------------------------------------
        hsrettype :: Types -> Type ()
hsrettype Types
Void                       = Type ()
unit_tycon
        hsrettype Types
SelfType                   = Type ()
selftyp
        hsrettype (CT CTypes
ctype IsConst
_)               = CTypes -> Type ()
convertC2HS CTypes
ctype
        hsrettype (CPT (CPTClass Class
d) IsConst
_)       = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (String -> Type ()
tycon String
rawname)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
d)
        hsrettype (CPT (CPTClassRef Class
d) IsConst
_)    = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (String -> Type ()
tycon String
rawname)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
d)
        hsrettype (CPT (CPTClassCopy Class
d) IsConst
_)   = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (String -> Type ()
tycon String
rawname)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
d)
        hsrettype (CPT (CPTClassMove Class
d) IsConst
_)   = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (String -> Type ()
tycon String
rawname)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
d)
        hsrettype (TemplateApp TemplateAppInfo
x)    = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (Type () -> Type ()) -> Type () -> Type ()
forall a b. (a -> b) -> a -> b
$
                                         (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$
                                           (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon ([String] -> [Type ()]) -> [String] -> [Type ()]
forall a b. (a -> b) -> a -> b
$
                                            String
rawname String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (TemplateArgType -> String) -> [TemplateArgType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (TemplateClass -> (String, String)
hsTemplateClassName (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x))
        hsrettype (TemplateAppRef TemplateAppInfo
x) = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (Type () -> Type ()) -> Type () -> Type ()
forall a b. (a -> b) -> a -> b
$
                                         (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$
                                           (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon ([String] -> [Type ()]) -> [String] -> [Type ()]
forall a b. (a -> b) -> a -> b
$
                                            String
rawname String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (TemplateArgType -> String) -> [TemplateArgType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (TemplateClass -> (String, String)
hsTemplateClassName (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x))
        hsrettype (TemplateAppMove TemplateAppInfo
x)= Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (Type () -> Type ()) -> Type () -> Type ()
forall a b. (a -> b) -> a -> b
$
                                         (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp ([Type ()] -> Type ()) -> [Type ()] -> Type ()
forall a b. (a -> b) -> a -> b
$
                                           (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon ([String] -> [Type ()]) -> [String] -> [Type ()]
forall a b. (a -> b) -> a -> b
$
                                            String
rawname String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (TemplateArgType -> String) -> [TemplateArgType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (TemplateClass -> (String, String)
hsTemplateClassName (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x))
        hsrettype (TemplateType TemplateClass
t)   = Type () -> Type () -> Type ()
tyapp Type ()
tyPtr (Type () -> Type ()) -> Type () -> Type ()
forall a b. (a -> b) -> a -> b
$
                                         (Type () -> Type () -> Type ()) -> [Type ()] -> Type ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
rawname Type () -> [Type ()] -> [Type ()]
forall a. a -> [a] -> [a]
: (String -> Type ()) -> [String] -> [Type ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
mkTVar (TemplateClass -> [String]
tclass_params TemplateClass
t))
          where rawname :: String
rawname = (String, String) -> String
forall a b. (a, b) -> b
snd (TemplateClass -> (String, String)
hsTemplateClassName TemplateClass
t)
        hsrettype (TemplateParam String
p)          = String -> Type ()
mkTVar String
p
        hsrettype (TemplateParamPointer String
p)   = String -> Type ()
mkTVar String
p



genericFuncRet :: Function -> Types
genericFuncRet :: Function -> Types
genericFuncRet Function
f =
  case Function
f of
    Constructor [Arg]
_ Maybe String
_ -> Types
self_
    Virtual Types
t String
_ [Arg]
_ Maybe String
_ -> Types
t
    NonVirtual Types
t String
_ [Arg]
_ Maybe String
_-> Types
t
    Static Types
t String
_ [Arg]
_ Maybe String
_ -> Types
t
    Destructor Maybe String
_ -> Types
void_

genericFuncArgs :: Function -> [Arg]
genericFuncArgs :: Function -> [Arg]
genericFuncArgs (Destructor Maybe String
_) = []
genericFuncArgs Function
f = Function -> [Arg]
func_args Function
f