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

module FFICXX.Generate.Code.Primitive where

import Control.Monad.Trans.State (get, put, runState)
import Data.Functor.Identity (Identity)
import FFICXX.Generate.Name
  ( ffiClassName,
    hsClassName,
    hsClassNameForTArg,
    hsTemplateClassName,
    tmplAccessorName,
    typeclassName,
    typeclassNameFromStr,
  )
import FFICXX.Generate.Type.Class
  ( Accessor (Getter, Setter),
    Arg (..),
    CPPTypes (..),
    CTypes (..),
    Class (..),
    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,
    tyPtr,
    tySplice,
    tyapp,
    tycon,
    tyfun,
    unit_tycon,
    unqual,
  )
import qualified FFICXX.Runtime.CodeGen.Cxx as R
import FFICXX.Runtime.TH (IsCPrimitive (CPrim, NonCPrim))
import Language.Haskell.Exts.Syntax (Asst (..), Context, Type (..))

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 -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"bool"
        CTypes
CTChar -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"char"
        CTypes
CTClock -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"clock_t"
        CTypes
CTDouble -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"double"
        CTypes
CTFile -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"FILE"
        CTypes
CTFloat -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"float"
        CTypes
CTFpos -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"fpos_t"
        CTypes
CTInt -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"int"
        CTypes
CTIntMax -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"intmax_t"
        CTypes
CTIntPtr -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"intptr_t"
        CTypes
CTJmpBuf -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"jmp_buf"
        CTypes
CTLLong -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"long long"
        CTypes
CTLong -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"long"
        CTypes
CTPtrdiff -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"ptrdiff_t"
        CTypes
CTSChar -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"sized char"
        CTypes
CTSUSeconds -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"suseconds_t"
        CTypes
CTShort -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"short"
        CTypes
CTSigAtomic -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"sig_atomic_t"
        CTypes
CTSize -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"size_t"
        CTypes
CTTime -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"time_t"
        CTypes
CTUChar -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"unsigned char"
        CTypes
CTUInt -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"unsigned int"
        CTypes
CTUIntMax -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uintmax_t"
        CTypes
CTUIntPtr -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uintptr_t"
        CTypes
CTULLong -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"unsigned long long"
        CTypes
CTULong -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"unsigned long"
        CTypes
CTUSeconds -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"useconds_t"
        CTypes
CTUShort -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"unsigned short"
        CTypes
CTWchar -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"wchar_t"
        CTypes
CTInt8 -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"int8_t"
        CTypes
CTInt16 -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"int16_t"
        CTypes
CTInt32 -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"int32_t"
        CTypes
CTInt64 -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"int64_t"
        CTypes
CTUInt8 -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uint8_t"
        CTypes
CTUInt16 -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uint16_t"
        CTypes
CTUInt32 -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uint32_t"
        CTypes
CTUInt64 -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"uint64_t"
        CTypes
CTString -> forall (f :: * -> *). CType f -> CType f
R.CTStar forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
"char"
        CTypes
CTVoidStar -> forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
        CEnum CTypes
_ String
type_str -> forall (f :: * -> *). String -> CType f
R.CTVerbatim String
type_str
        CPointer CTypes
s -> forall (f :: * -> *). CType f -> CType f
R.CTStar (CTypes -> IsConst -> CType Identity
ctypToCType CTypes
s IsConst
NoConst)
        CRef CTypes
s -> forall (f :: * -> *). CType f -> CType f
R.CTStar (CTypes -> IsConst -> CType Identity
ctypToCType CTypes
s IsConst
NoConst)
   in case IsConst
isconst of
        IsConst
Const -> 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) =
  (forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p"]), String -> CName Identity
R.sname String
varname)
argToCTypVar (Arg (CPT (CPTClass Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" forall a. Semigroup a => a -> a -> a
<> String
cname forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
cname 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 -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" forall a. Semigroup a => a -> a -> a
<> String
cname forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
cname 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 -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" forall a. Semigroup a => a -> a -> a
<> String
cname forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
cname 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 -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" forall a. Semigroup a => a -> a -> a
<> String
cname forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
cname 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) = (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
varname)
argToCTypVar (Arg (TemplateAppRef TemplateAppInfo
_) String
varname) = (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
varname)
argToCTypVar (Arg (TemplateAppMove TemplateAppInfo
_) String
varname) = (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
varname)
argToCTypVar Arg
t = forall a. HasCallStack => String -> a
error (String
"argToCTypVar: " forall a. Semigroup a => a -> a -> a
<> 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") forall a. a -> [a] -> [a]
: [Arg]
args
   in 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 = 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 (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 = forall (f :: * -> *). CType f
R.CTVoid
returnCType Types
SelfType = forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p"])
returnCType (CPT (CPTClass Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
returnCType (CPT (CPTClassRef Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
returnCType (CPT (CPTClassCopy Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
returnCType (CPT (CPTClassMove Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
returnCType (TemplateApp TemplateAppInfo
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
returnCType (TemplateAppRef TemplateAppInfo
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
returnCType (TemplateAppMove TemplateAppInfo
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
returnCType (TemplateType TemplateClass
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
returnCType (TemplateParam String
t) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p"])
returnCType (TemplateParamPointer String
t) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, 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
_ -> forall (f :: * -> *). CExp f -> CExp f
R.CStar CExp Identity
e
    CPT (CPTClass Class
c) IsConst
_ ->
      forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
        (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
        [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
f), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f 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
_ ->
      forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
        (String -> CName Identity
R.sname String
"from_nonconstref_to_nonconstref")
        [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
f), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f forall a. Semigroup a => a -> a -> a
<> String
"_t"))]
        [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
_ ->
      forall (f :: * -> *). CExp f -> CExp f
R.CStar forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
          (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
          [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
f), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f 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
_ ->
      forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
        (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"std::move"))
        [ forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
            (String -> CName Identity
R.sname String
"from_nonconstref_to_nonconstref")
            [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
f), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f forall a. Semigroup a => a -> a -> a
<> String
"_t"))]
            [forall (f :: * -> *). CExp f -> CExp f
R.CStar CExp Identity
e]
        ]
      where
        f :: String
f = Class -> String
ffiClassName Class
c
    TemplateApp TemplateAppInfo
p ->
      forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
        (String -> CName Identity
R.sname String
"from_nonconstref_to_nonconst")
        [forall (f :: * -> *). String -> CType f
R.CTVerbatim (TemplateAppInfo -> String
tapp_CppTypeForParam TemplateAppInfo
p), forall (f :: * -> *). CType f
R.CTVoid]
        [CExp Identity
e]
    TemplateAppRef TemplateAppInfo
p ->
      forall (f :: * -> *). CExp f -> CExp f
R.CStar forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *). CType f -> CExp f -> CExp f
R.CCast (forall (f :: * -> *). CType f -> CType f
R.CTStar (forall (f :: * -> *). String -> CType f
R.CTVerbatim (TemplateAppInfo -> String
tapp_CppTypeForParam TemplateAppInfo
p))) CExp Identity
e
    TemplateAppMove TemplateAppInfo
p ->
      forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
        (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"std::move"))
        [ forall (f :: * -> *). CExp f -> CExp f
R.CStar forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *). CType f -> CExp f -> CExp f
R.CCast (forall (f :: * -> *). CType f -> CType f
R.CTStar (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 -> forall (f :: * -> *). CExp f
R.CNull
    Types
SelfType ->
      forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
        (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
        [forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
"Type", forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"]), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type")]
        [forall (f :: * -> *). CType f -> CExp f -> CExp f
R.CCast (forall (f :: * -> *). CType f -> CType f
R.CTStar (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
"Type"))) CExp Identity
e]
    -- "to_nonconst<Type ## _t, Type>((Type *)" <> e <> ")"
    CT (CRef CTypes
_) IsConst
_ -> forall (f :: * -> *). CExp f -> CExp f
R.CAddr CExp Identity
e
    -- "&(" <> e <> ")"
    CT CTypes
_ IsConst
_ -> CExp Identity
e
    -- e
    CPT (CPTClass Class
c) IsConst
_ ->
      forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
        (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
        [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f forall a. Semigroup a => a -> a -> a
<> String
"_t")), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
f)]
        [forall (f :: * -> *). CType f -> CExp f -> CExp f
R.CCast (forall (f :: * -> *). CType f -> CType f
R.CTStar (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
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
_ ->
      forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
        (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
        [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f forall a. Semigroup a => a -> a -> a
<> String
"_t")), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
f)]
        [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
_ ->
      forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
        (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
        [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f forall a. Semigroup a => a -> a -> a
<> String
"_t")), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
f)]
        [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
_ ->
      forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
        (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"std::move"))
        [ forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
            (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
            [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
f forall a. Semigroup a => a -> a -> a
<> String
"_t")), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
f)]
            [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
_ ->
      forall a. HasCallStack => String -> a
error String
"cxx2C: TemplateApp"
    -- g <> "* r = new " <> g <> "(" <> e <> "); "
    --  <> "return (static_cast<void*>(r));"
    TemplateAppRef TemplateAppInfo
_ ->
      forall a. HasCallStack => String -> a
error String
"cxx2C: TemplateAppRef"
    -- g <> "* r = new " <> g <> "(" <> e <> "); "
    -- <> "return (static_cast<void*>(r));"
    TemplateAppMove TemplateAppInfo
_ ->
      forall a. HasCallStack => String -> a
error String
"cxx2C: TemplateAppMove"
    TemplateType TemplateClass
_ ->
      forall a. HasCallStack => String -> a
error String
"cxx2C: TemplateType"
    TemplateParam String
_ ->
      forall a. HasCallStack => String -> a
error String
"cxx2C: TemplateParam"
    -- if b then e
    --      else "to_nonconst<Type ## _t, Type>((Type *)&(" <> e <> "))"
    TemplateParamPointer String
_ ->
      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 = 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 = forall (f :: * -> *). CType f -> CType f -> CType f
R.CTScoped (forall (f :: * -> *). CName f -> [CType f] -> CType f
R.CTTApp (String -> CName Identity
R.sname String
tclass) [CType Identity]
targs) (forall (f :: * -> *). String -> CType f
R.CTVerbatim String
inner)

tmplArgToCTypVar ::
  IsCPrimitive ->
  Arg ->
  (R.CType Identity, R.CName Identity)
tmplArgToCTypVar :: IsCPrimitive -> Arg -> (CType Identity, CName Identity)
tmplArgToCTypVar IsCPrimitive
_ (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
_ (Arg Types
SelfType String
varname) =
  (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
varname)
tmplArgToCTypVar IsCPrimitive
_ (Arg (CPT (CPTClass Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
tmplArgToCTypVar IsCPrimitive
_ (Arg (CPT (CPTClassRef Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
tmplArgToCTypVar IsCPrimitive
_ (Arg (CPT (CPTClassMove Class
c) IsConst
isconst) String
varname) =
  case IsConst
isconst of
    IsConst
Const -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
tmplArgToCTypVar IsCPrimitive
_ (Arg (TemplateApp TemplateAppInfo
_) String
v) = (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
_ (Arg (TemplateAppRef TemplateAppInfo
_) String
v) = (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
_ (Arg (TemplateAppMove TemplateAppInfo
_) String
v) = (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
_ (Arg (TemplateType TemplateClass
_) String
v) = (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
CPrim (Arg (TemplateParam String
t) String
v) = (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 (Arg (TemplateParam String
t) String
v) = (forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p"]), String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
CPrim (Arg (TemplateParamPointer String
t) String
v) = (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 (Arg (TemplateParamPointer String
t) String
v) = (forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p"]), String -> CName Identity
R.sname String
v)
tmplArgToCTypVar IsCPrimitive
_ Arg
_ = 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") forall a. a -> [a] -> [a]
: [Arg]
args
        Selfness
NoSelf -> [Arg]
args
   in forall a b. (a -> b) -> [a] -> [b]
map (IsCPrimitive -> Arg -> (CType Identity, CName Identity)
tmplArgToCTypVar IsCPrimitive
b) [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) =
  forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
    (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
    [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
str forall a. Semigroup a => a -> a -> a
<> String
"_t"))]
    [forall (f :: * -> *). CName f -> 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) =
  forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
    (String -> CName Identity
R.sname String
"from_nonconstref_to_nonconstref")
    [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
str forall a. Semigroup a => a -> a -> a
<> String
"_t"))]
    [forall (f :: * -> *). CExp f -> CExp f
R.CStar forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). CName f -> CExp f
R.CVar 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) =
  forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
    (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"std::move"))
    [ forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
        (String -> CName Identity
R.sname String
"from_nonconstref_to_nonconstref")
        [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
str), forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
str forall a. Semigroup a => a -> a -> a
<> String
"_t"))]
        [forall (f :: * -> *). CExp f -> CExp f
R.CStar forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). CName f -> CExp f
R.CVar 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) =
  forall (f :: * -> *). CExp f -> CExp f
R.CStar forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). CName f -> CExp f
R.CVar 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *). CName f -> CType f
R.CTSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CName Identity
R.sname forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateArgType -> String
hsClassNameForTArg) (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
   in forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
        (String -> CName Identity
R.sname String
"static_cast")
        [forall (f :: * -> *). CType f -> CType f
R.CTStar forall a b. (a -> b) -> a -> b
$ Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm (TemplateClass -> Form
tclass_cxxform (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x)) [CType Identity]
targs]
        [forall (f :: * -> *). CName f -> CExp f
R.CVar 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *). CName f -> CType f
R.CTSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CName Identity
R.sname forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateArgType -> String
hsClassNameForTArg) (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
   in forall (f :: * -> *). CExp f -> CExp f
R.CStar forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
          (String -> CName Identity
R.sname String
"static_cast")
          [forall (f :: * -> *). CType f -> CType f
R.CTStar forall a b. (a -> b) -> a -> b
$ Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm (TemplateClass -> Form
tclass_cxxform (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x)) [CType Identity]
targs]
          [forall (f :: * -> *). CName f -> CExp f
R.CVar 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *). CName f -> CType f
R.CTSimple forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CName Identity
R.sname forall b c a. (b -> c) -> (a -> b) -> a -> c
. TemplateArgType -> String
hsClassNameForTArg) (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
   in forall (f :: * -> *). CExp f -> [CExp f] -> CExp f
R.CApp
        (forall (f :: * -> *). CName f -> CExp f
R.CVar (String -> CName Identity
R.sname String
"std::move"))
        [ forall (f :: * -> *). CExp f -> CExp f
R.CStar forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
              (String -> CName Identity
R.sname String
"static_cast")
              [forall (f :: * -> *). CType f -> CType f
R.CTStar forall a b. (a -> b) -> a -> b
$ Form -> [CType Identity] -> CType Identity
tmplAppTypeFromForm (TemplateClass -> Form
tclass_cxxform (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x)) [CType Identity]
targs]
              [forall (f :: * -> *). CName f -> CExp f
R.CVar 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 -> forall (f :: * -> *). CName f -> CExp f
R.CVar forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
varname
    IsCPrimitive
NonCPrim ->
      forall (f :: * -> *). CExp f -> CExp f
R.CStar forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
          (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
          [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
typ), forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
typ, forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"])]
          [forall (f :: * -> *). CName f -> CExp f
R.CVar 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 -> forall (f :: * -> *). CName f -> CExp f
R.CVar forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
varname
    IsCPrimitive
NonCPrim ->
      forall (f :: * -> *). CName f -> [CType f] -> [CExp f] -> CExp f
R.CTApp
        (String -> CName Identity
R.sname String
"from_nonconst_to_nonconst")
        [forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname String
typ), forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
typ, forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_t"])]
        [forall (f :: * -> *). CName f -> CExp f
R.CVar forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
varname]
tmplArgToCallCExp IsCPrimitive
_ (Arg Types
_ String
varname) = forall (f :: * -> *). CName f -> CExp f
R.CVar 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 = forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
_ Types
SelfType = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
_ (CPT (CPTClass Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
tmplReturnCType IsCPrimitive
_ (CPT (CPTClassRef Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
tmplReturnCType IsCPrimitive
_ (CPT (CPTClassCopy Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
tmplReturnCType IsCPrimitive
_ (CPT (CPTClassMove Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
tmplReturnCType IsCPrimitive
_ (TemplateApp TemplateAppInfo
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
_ (TemplateAppRef TemplateAppInfo
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
_ (TemplateAppMove TemplateAppInfo
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
_ (TemplateType TemplateClass
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
tmplReturnCType IsCPrimitive
b (TemplateParam String
t) = case IsCPrimitive
b of
  IsCPrimitive
CPrim -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
t
  IsCPrimitive
NonCPrim -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p"]
tmplReturnCType IsCPrimitive
b (TemplateParamPointer String
t) = case IsCPrimitive
b of
  IsCPrimitive
CPrim -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ String -> CName Identity
R.sname String
t
  IsCPrimitive
NonCPrim -> forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, 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) =
  (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_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 -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_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 -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_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 -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (String
"const_" forall a. Semigroup a => a -> a -> a
<> Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
    IsConst
NoConst -> (forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p")), String -> CName Identity
R.sname String
varname)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateApp TemplateAppInfo
_) String
v) = (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateAppRef TemplateAppInfo
_) String
v) = (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateAppMove TemplateAppInfo
_) String
v) = (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateType TemplateClass
_) String
v) = (forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid, String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateParam String
t) String
v) = (forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p"]), String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ (Arg (TemplateParamPointer String
t) String
v) = (forall (f :: * -> *). CName f -> CType f
R.CTSimple (forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p"]), String -> CName Identity
R.sname String
v)
tmplMemFuncArgToCTypVar Class
_ Arg
_ = 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 = forall (f :: * -> *). CType f
R.CTVoid
tmplMemFuncReturnCType Class
c Types
SelfType = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
tmplMemFuncReturnCType Class
_ (CPT (CPTClass Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
tmplMemFuncReturnCType Class
_ (CPT (CPTClassRef Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
tmplMemFuncReturnCType Class
_ (CPT (CPTClassCopy Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
tmplMemFuncReturnCType Class
_ (CPT (CPTClassMove Class
c) IsConst
_) = forall (f :: * -> *). CName f -> CType f
R.CTSimple (String -> CName Identity
R.sname (Class -> String
ffiClassName Class
c forall a. Semigroup a => a -> a -> a
<> String
"_p"))
tmplMemFuncReturnCType Class
_ (TemplateApp TemplateAppInfo
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
tmplMemFuncReturnCType Class
_ (TemplateAppRef TemplateAppInfo
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
tmplMemFuncReturnCType Class
_ (TemplateAppMove TemplateAppInfo
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
tmplMemFuncReturnCType Class
_ (TemplateType TemplateClass
_) = forall (f :: * -> *). CType f -> CType f
R.CTStar forall (f :: * -> *). CType f
R.CTVoid
tmplMemFuncReturnCType Class
_ (TemplateParam String
t) = forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, forall (f :: * -> *). String -> NamePart f
R.NamePart String
"_p"]
tmplMemFuncReturnCType Class
_ (TemplateParamPointer String
t) = forall (f :: * -> *). CName f -> CType f
R.CTSimple forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). [NamePart f] -> CName f
R.CName [forall (f :: * -> *). String -> NamePart f
R.NamePart String
t, 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 ((forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> (String, String)
hsClassName) Class
c)
convertCpp2HS Maybe Class
Nothing Types
SelfType = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> (String, String)
hsClassName) Class
c'
convertCpp2HS Maybe Class
_c (TemplateApp TemplateAppInfo
x) =
  forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon forall a b. (a -> b) -> a -> b
$
      TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
convertCpp2HS Maybe Class
_c (TemplateAppRef TemplateAppInfo
x) =
  forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon forall a b. (a -> b) -> a -> b
$
      TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
convertCpp2HS Maybe Class
_c (TemplateAppMove TemplateAppInfo
x) =
  forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon forall a b. (a -> b) -> a -> b
$
      TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
x) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
convertCpp2HS Maybe Class
_c (TemplateType TemplateClass
t) =
  forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
    String -> Type ()
tycon (TemplateClass -> String
tclass_name TemplateClass
t) forall a. a -> [a] -> [a]
: 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 ::
  -- | self
  Type () ->
  Maybe Class ->
  -- | type paramemter splice
  [Type ()] ->
  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 (forall a. a -> Maybe a
Just Class
c) Types
SelfType
convertCpp2HS4Tmpl Type ()
_ Maybe Class
Nothing [Type ()]
_ Types
SelfType = Maybe Class -> Types -> Type ()
convertCpp2HS 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 = forall a b. [a] -> [b] -> [(a, b)]
zip (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
info) [Type ()]
ss
   in forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
        String -> Type ()
tycon (TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
info)) forall a. a -> [a] -> [a]
: 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 = forall a b. [a] -> [b] -> [(a, b)]
zip (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
info) [Type ()]
ss
   in forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
        String -> Type ()
tycon (TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
info)) forall a. a -> [a] -> [a]
: 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 = forall a b. [a] -> [b] -> [(a, b)]
zip (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
info) [Type ()]
ss
   in forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
        String -> Type ()
tycon (TemplateClass -> String
tclass_name (TemplateAppInfo -> TemplateClass
tapp_tclass TemplateAppInfo
info)) forall a. a -> [a] -> [a]
: 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Splice ()
parenSplice forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exp ()
mkVar forall a b. (a -> b) -> a -> b
$ String
p
convertCpp2HS4Tmpl Type ()
_ Maybe Class
_ [Type ()]
_ (TemplateParamPointer String
p) = Splice () -> Type ()
tySplice forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Splice ()
parenSplice forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exp ()
mkVar 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length (Function -> [Arg]
genericFuncArgs Function
func)
   in if Int
len forall a. Ord a => a -> a -> Bool
> Int
0
        then String
"xform" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Int
len 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length (Function -> [Arg]
genericFuncArgs Function
func)
   in if Int
len forall a. Ord a => a -> a -> Bool
> Int
0
        then String
"xform" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Int
len forall a. Num a => a -> a -> a
- Int
1)
        else String
"xformnull"
hsFuncXformer Function
func =
  let len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length (Function -> [Arg]
genericFuncArgs Function
func)
   in String
"xform" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
len

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

extractArgRetTypes ::
  -- | class (Nothing for top-level function)
  Maybe Class ->
  -- | is virtual function?
  Bool ->
  -- | C type signature information for a given function      -- (Args,Types)           -- ^ (argument types, return type) of a given function
  CFunSig ->
  -- | Haskell type signature information for the function    --   ([Type ()],[Asst ()])  -- ^ (types, class constraints)
  HsFunSig
extractArgRetTypes :: Maybe Class -> Bool -> CFunSig -> HsFunSig
extractArgRetTypes Maybe Class
mc Bool
isvirtual (CFunSig [Arg]
args Types
ret) =
  let ([Type ()]
typs, ([Asst ()], Int)
s) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
runState ([], (Int
0 :: Int)) forall a b. (a -> b) -> a -> b
$ do
        [Type ()]
as <- 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 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 -> forall a. HasCallStack => String -> a
error String
"extractArgRetTypes: SelfType return but no class"
            Just Class
c -> if Bool
isvirtual then forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Type ()
mkTVar String
"a") else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Type ()
tycon ((forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> (String, String)
hsClassName) Class
c)
          Types
x -> (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Class -> Types -> Type ()
convertCpp2HS forall a. Maybe a
Nothing) Types
x
        forall (m :: * -> *) a. Monad m => a -> m a
return ([Type ()]
as forall a. [a] -> [a] -> [a]
++ [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
r])
   in HsFunSig
        { hsSigTypes :: [Type ()]
hsSigTypes = [Type ()]
typs,
          hsSigConstraints :: [Asst ()]
hsSigConstraints = 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) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
      let cname :: String
cname = (forall a b. (a, b) -> a
fst 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' forall a. a -> [a] -> [a]
: 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]
      forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Asst ()
ctxt1 forall a. a -> [a] -> [a]
: Asst ()
ctxt2 forall a. a -> [a] -> [a]
: [Asst ()]
ctxts, b
n forall a. Num a => a -> a -> a
+ b
1)
      forall (m :: * -> *) a. Monad m => a -> m a
return Type ()
tvar
    addstring :: StateT ([Asst ()], Int) Identity (Type ())
addstring = do
      ([Asst ()]
ctxts, Int
n) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
      let tvar :: Type ()
tvar = String -> Type ()
mkTVar (Char
'c' forall a. a -> [a] -> [a]
: 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"]
      forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Asst ()
ctxt forall a. a -> [a] -> [a]
: [Asst ()]
ctxts, Int
n forall a. Num a => a -> a -> a
+ Int
1)
      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 -> 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
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Class -> Types -> Type ()
convertCpp2HS forall a. Maybe a
Nothing Types
typ
        CPT (CPTClass Class
c') IsConst
_ -> forall {m :: * -> *} {b}.
(Monad m, Num b, Show b) =>
Class -> StateT ([Asst ()], b) m (Type ())
addclass Class
c'
        CPT (CPTClassRef Class
c') IsConst
_ -> forall {m :: * -> *} {b}.
(Monad m, Num b, Show b) =>
Class -> StateT ([Asst ()], b) m (Type ())
addclass Class
c'
        CPT (CPTClassCopy Class
c') IsConst
_ -> forall {m :: * -> *} {b}.
(Monad m, Num b, Show b) =>
Class -> StateT ([Asst ()], b) m (Type ())
addclass Class
c'
        CPT (CPTClassMove Class
c') IsConst
_ -> 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) ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            Maybe Class -> Types -> Type ()
convertCpp2HS forall a. Maybe a
Nothing (TemplateAppInfo -> Types
TemplateApp TemplateAppInfo
x)
        (TemplateAppRef TemplateAppInfo
x) ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            Maybe Class -> Types -> Type ()
convertCpp2HS forall a. Maybe a
Nothing (TemplateAppInfo -> Types
TemplateAppRef TemplateAppInfo
x)
        (TemplateAppMove TemplateAppInfo
x) ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            Maybe Class -> Types -> Type ()
convertCpp2HS forall a. Maybe a
Nothing (TemplateAppInfo -> Types
TemplateAppMove TemplateAppInfo
x)
        (TemplateType TemplateClass
t) ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            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) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
mkTVar (TemplateClass -> [String]
tclass_params TemplateClass
t))
        (TemplateParam String
p) -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Type ()
mkTVar String
p)
        Types
Void -> forall (m :: * -> *) a. Monad m => a -> m a
return Type ()
unit_tycon
        Types
_ -> forall a. HasCallStack => String -> a
error (String
"No such c type : " forall a. Semigroup a => a -> a -> a
<> 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
          (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" forall a. a -> [a] -> [a]
:)
        | Function -> Bool
isNonVirtualFunc Function
f = (String -> Type ()
mkTVar (forall a b. (a, b) -> a
fst (Class -> (String, String)
hsClassName Class
c)) forall a. a -> [a] -> [a]
:)
        | Bool
otherwise = forall a. a -> a
id
   in forall l.
l -> Maybe [TyVarBind l] -> Maybe (Context l) -> Type l -> Type l
TyForall () forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Context ()
ctxt) (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 = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
hname forall a. a -> [a] -> [a]
: 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 forall a. Maybe a
Nothing Types
tfun_ret
      lst :: [Type ()]
lst = Type ()
slf forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Maybe Class -> Types -> Type ()
convertCpp2HS forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) [Arg]
tfun_args
   in forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()]
lst 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 forall a. Maybe a
Nothing (TemplateClass -> Types
TemplateType TemplateClass
t)
      lst :: [Type ()]
lst = forall a b. (a -> b) -> [a] -> [b]
map (Maybe Class -> Types -> Type ()
convertCpp2HS forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) [Arg]
tfun_new_args
   in forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()]
lst 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 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 = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
hname forall a. a -> [a] -> [a]
: 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 forall a. Maybe a
Nothing Types
tfun_ret
      lst :: [Type ()]
lst = Type ()
slf forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Maybe Class -> Types -> Type ()
convertCpp2HS forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg -> Types
arg_type) (OpExp -> [Arg]
argsFromOpExp OpExp
tfun_opexp)
   in forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()]
lst 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 = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()]
lst 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 forall a. Maybe a
Nothing [Type ()]
spls Types
tfun_ret
      TFunNew {} -> Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e 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 forall a. Maybe a
Nothing [Type ()]
spls Types
tfun_ret
    e :: Type ()
e = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
hname forall a. a -> [a] -> [a]
: [Type ()]
spls)
    spls :: [Type ()]
spls = forall a b. (a -> b) -> [a] -> [b]
map (Splice () -> Type ()
tySplice forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Splice ()
parenSplice forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exp ()
mkVar) 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 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e forall a. Maybe a
Nothing [Type ()]
spls 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]
..} -> forall a b. (a -> b) -> [a] -> [b]
map (Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e forall a. Maybe a
Nothing [Type ()]
spls 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 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e forall a. Maybe a
Nothing [Type ()]
spls 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 = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun ([Type ()]
lst forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
ctyp])
  where
    spls :: [Type ()]
spls = forall a b. (a -> b) -> [a] -> [b]
map (Splice () -> Type ()
tySplice forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp () -> Splice ()
parenSplice 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 forall a. Maybe a
Nothing [Type ()]
spls (TemplateMemberFunction -> Types
tmf_ret TemplateMemberFunction
f)
    e :: Type ()
e = String -> Type ()
tycon (forall a b. (a, b) -> a
fst (Class -> (String, String)
hsClassName Class
c))
    lst :: [Type ()]
lst = Type ()
e forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Type () -> Maybe Class -> [Type ()] -> Types -> Type ()
convertCpp2HS4Tmpl Type ()
e forall a. Maybe a
Nothing [Type ()]
spls 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
        { 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
        { 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 (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 (forall a b. (a, b) -> a
fst (Class -> (String, String)
hsClassName Class
c)) forall a. a -> [a] -> [a]
:)
   in forall l.
l -> Maybe [TyVarBind l] -> Maybe (Context l) -> Type l -> Type l
TyForall () forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Context ()
ctxt) (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) =
  forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type () -> Type () -> Type ()
tyfun forall a b. (a -> b) -> a -> b
$ case Maybe (Selfness, Class)
msc of
    Maybe (Selfness, Class)
Nothing -> [Type ()]
argtyps forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
rettyp]
    Just (Selfness
Self, Class
_) -> Type ()
selftyp forall a. a -> [a] -> [a]
: [Type ()]
argtyps forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
rettyp]
    Just (Selfness
NoSelf, Class
_) -> [Type ()]
argtyps forall a. Semigroup a => a -> a -> a
<> [Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
"IO") Type ()
rettyp]
  where
    argtyps :: [Type ()]
    argtyps :: [Type ()]
argtyps = forall a b. (a -> b) -> [a] -> [b]
map (Types -> Type ()
hsargtype 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 (forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
c)))
      Maybe (Selfness, Class)
Nothing -> 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 = 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 = 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 = 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 = forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
d)
    hsargtype (TemplateApp TemplateAppInfo
x) =
      Type () -> Type () -> Type ()
tyapp Type ()
tyPtr forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon forall a b. (a -> b) -> a -> b
$
            String
rawname forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
      where
        rawname :: String
rawname = 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 forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon forall a b. (a -> b) -> a -> b
$
            String
rawname forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
      where
        rawname :: String
rawname = 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 forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon forall a b. (a -> b) -> a -> b
$
            String
rawname forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
      where
        rawname :: String
rawname = 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
rawname forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
mkTVar (TemplateClass -> [String]
tclass_params TemplateClass
t))
      where
        rawname :: String
rawname = 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
_ = 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 = 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 = 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 = 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 = forall a b. (a, b) -> b
snd (Class -> (String, String)
hsClassName Class
d)
    hsrettype (TemplateApp TemplateAppInfo
x) =
      Type () -> Type () -> Type ()
tyapp Type ()
tyPtr forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon forall a b. (a -> b) -> a -> b
$
            String
rawname forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
      where
        rawname :: String
rawname = 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 forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon forall a b. (a -> b) -> a -> b
$
            String
rawname forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
      where
        rawname :: String
rawname = 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 forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp forall a b. (a -> b) -> a -> b
$
          forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
tycon forall a b. (a -> b) -> a -> b
$
            String
rawname forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map TemplateArgType -> String
hsClassNameForTArg (TemplateAppInfo -> [TemplateArgType]
tapp_tparams TemplateAppInfo
x)
      where
        rawname :: String
rawname = 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 forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Type () -> Type () -> Type ()
tyapp (String -> Type ()
tycon String
rawname forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map String -> Type ()
mkTVar (TemplateClass -> [String]
tclass_params TemplateClass
t))
      where
        rawname :: String
rawname = 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