Primitive.hs

{-# 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
  { cArgTypes :: [Arg],
    cRetType :: Types
  }

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

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

self_ :: Types
self_ = SelfType

cstring_ :: Types
cstring_ = CT CTString Const

cint_ :: Types
cint_ = CT CTInt Const

int_ :: Types
int_ = CT CTInt NoConst

uint_ :: Types
uint_ = CT CTUInt NoConst

ulong_ :: Types
ulong_ = CT CTULong NoConst

long_ :: Types
long_ = CT CTLong NoConst

culong_ :: Types
culong_ = CT CTULong Const

clong_ :: Types
clong_ = CT CTLong Const

cchar_ :: Types
cchar_ = CT CTChar Const

char_ :: Types
char_ = CT CTChar NoConst

cshort_ :: Types
cshort_ = CT CTShort Const

short_ :: Types
short_ = CT CTShort NoConst

cdouble_ :: Types
cdouble_ = CT CTDouble Const

double_ :: Types
double_ = CT CTDouble NoConst

doublep_ :: Types
doublep_ = CT (CPointer CTDouble) NoConst

cfloat_ :: Types
cfloat_ = CT CTFloat Const

float_ :: Types
float_ = CT CTFloat NoConst

bool_ :: Types
bool_ = CT CTBool NoConst

void_ :: Types
void_ = Void

voidp_ :: Types
voidp_ = CT CTVoidStar NoConst

intp_ :: Types
intp_ = CT (CPointer CTInt) NoConst

intref_ :: Types
intref_ = CT (CRef CTInt) NoConst

charpp_ :: Types
charpp_ = CT (CPointer CTString) NoConst

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

argToCTypVar :: Arg -> (R.CType Identity, R.CName Identity)
argToCTypVar (Arg (CT ctyp isconst) varname) =
  (ctypToCType ctyp isconst, R.sname varname)
argToCTypVar (Arg SelfType varname) =
  (R.CTSimple (R.CName [R.NamePart "Type", R.NamePart "_p"]), R.sname varname)
argToCTypVar (Arg (CPT (CPTClass c) isconst) varname) =
  case isconst of
    Const -> (R.CTSimple (R.sname ("const_" <> cname <> "_p")), R.sname varname)
    NoConst -> (R.CTSimple (R.sname (cname <> "_p")), R.sname varname)
  where
    cname = ffiClassName c
argToCTypVar (Arg (CPT (CPTClassRef c) isconst) varname) =
  case isconst of
    Const -> (R.CTSimple (R.sname ("const_" <> cname <> "_p")), R.sname varname)
    NoConst -> (R.CTSimple (R.sname (cname <> "_p")), R.sname varname)
  where
    cname = ffiClassName c
argToCTypVar (Arg (CPT (CPTClassCopy c) isconst) varname) =
  case isconst of
    Const -> (R.CTSimple (R.sname ("const_" <> cname <> "_p")), R.sname varname)
    NoConst -> (R.CTSimple (R.sname (cname <> "_p")), R.sname varname)
  where
    cname = ffiClassName c
argToCTypVar (Arg (CPT (CPTClassMove c) isconst) varname) =
  case isconst of
    Const -> (R.CTSimple (R.sname ("const_" <> cname <> "_p")), R.sname varname)
    NoConst -> (R.CTSimple (R.sname (cname <> "_p")), R.sname varname)
  where
    cname = ffiClassName c
argToCTypVar (Arg (TemplateApp _) varname) = (R.CTStar R.CTVoid, R.sname varname)
argToCTypVar (Arg (TemplateAppRef _) varname) = (R.CTStar R.CTVoid, R.sname varname)
argToCTypVar (Arg (TemplateAppMove _) varname) = (R.CTStar R.CTVoid, R.sname varname)
argToCTypVar t = error ("argToCTypVar: " <> show t)

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

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

argToCallCExp :: Arg -> R.CExp Identity
argToCallCExp (Arg t e) = c2Cxx t (R.CVar (R.sname e))

-- TODO: rename this function by castExpressionFrom/To or something like that.
returnCType :: Types -> R.CType Identity
returnCType (CT ctyp isconst) = ctypToCType ctyp isconst
returnCType Void = R.CTVoid
returnCType SelfType = R.CTSimple (R.CName [R.NamePart "Type", R.NamePart "_p"])
returnCType (CPT (CPTClass c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
returnCType (CPT (CPTClassRef c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
returnCType (CPT (CPTClassCopy c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
returnCType (CPT (CPTClassMove c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
returnCType (TemplateApp _) = R.CTStar R.CTVoid
returnCType (TemplateAppRef _) = R.CTStar R.CTVoid
returnCType (TemplateAppMove _) = R.CTStar R.CTVoid
returnCType (TemplateType _) = R.CTStar R.CTVoid
returnCType (TemplateParam t) = R.CTSimple (R.CName [R.NamePart t, R.NamePart "_p"])
returnCType (TemplateParamPointer t) = R.CTSimple (R.CName [R.NamePart t, R.NamePart "_p"])

-- TODO: Rewrite this with static_cast
c2Cxx :: Types -> R.CExp Identity -> R.CExp Identity
c2Cxx t e =
  case t of
    CT (CRef _) _ -> R.CStar e
    CPT (CPTClass c) _ ->
      R.CTApp
        (R.sname "from_nonconst_to_nonconst")
        [R.CTSimple (R.sname f), R.CTSimple (R.sname (f <> "_t"))]
        [e]
      where
        f = ffiClassName c
    CPT (CPTClassRef c) _ ->
      R.CTApp
        (R.sname "from_nonconstref_to_nonconstref")
        [R.CTSimple (R.sname f), R.CTSimple (R.sname (f <> "_t"))]
        [R.CStar e]
      where
        f = ffiClassName c
    CPT (CPTClassCopy c) _ ->
      R.CStar $
        R.CTApp
          (R.sname "from_nonconst_to_nonconst")
          [R.CTSimple (R.sname f), R.CTSimple (R.sname (f <> "_t"))]
          [e]
      where
        f = ffiClassName c
    CPT (CPTClassMove c) _ ->
      R.CApp
        (R.CVar (R.sname "std::move"))
        [ R.CTApp
            (R.sname "from_nonconstref_to_nonconstref")
            [R.CTSimple (R.sname f), R.CTSimple (R.sname (f <> "_t"))]
            [R.CStar e]
        ]
      where
        f = ffiClassName c
    TemplateApp p ->
      R.CTApp
        (R.sname "from_nonconstref_to_nonconst")
        [R.CTVerbatim (tapp_CppTypeForParam p), R.CTVoid]
        [e]
    TemplateAppRef p ->
      R.CStar $
        R.CCast (R.CTStar (R.CTVerbatim (tapp_CppTypeForParam p))) e
    TemplateAppMove p ->
      R.CApp
        (R.CVar (R.sname "std::move"))
        [ R.CStar $
            R.CCast (R.CTStar (R.CTVerbatim (tapp_CppTypeForParam p))) e
        ]
    _ -> 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 t e =
  case t of
    Void -> R.CNull
    SelfType ->
      R.CTApp
        (R.sname "from_nonconst_to_nonconst")
        [R.CTSimple (R.CName [R.NamePart "Type", R.NamePart "_t"]), R.CTSimple (R.sname "Type")]
        [R.CCast (R.CTStar (R.CTSimple (R.sname "Type"))) e]
    -- "to_nonconst<Type ## _t, Type>((Type *)" <> e <> ")"
    CT (CRef _) _ -> R.CAddr e
    -- "&(" <> e <> ")"
    CT _ _ -> e
    -- e
    CPT (CPTClass c) _ ->
      R.CTApp
        (R.sname "from_nonconst_to_nonconst")
        [R.CTSimple (R.sname (f <> "_t")), R.CTSimple (R.sname f)]
        [R.CCast (R.CTStar (R.CTSimple (R.sname f))) e]
      where
        f = ffiClassName c
    -- "to_nonconst<" <> f <> "_t," <> f <> ">((" <> f <> "*)" <> e <> ")"
    CPT (CPTClassRef c) _ ->
      R.CTApp
        (R.sname "from_nonconst_to_nonconst")
        [R.CTSimple (R.sname (f <> "_t")), R.CTSimple (R.sname f)]
        [R.CAddr e]
      where
        f = ffiClassName c
    -- "to_nonconst<" <> f <> "_t," <> f <> ">(&(" <> e <> "))"
    CPT (CPTClassCopy c) _ ->
      R.CTApp
        (R.sname "from_nonconst_to_nonconst")
        [R.CTSimple (R.sname (f <> "_t")), R.CTSimple (R.sname f)]
        [R.CNew (R.sname f) [e]]
      where
        f = ffiClassName c
    -- "to_nonconst<" <> f <> "_t," <> f <> ">(new " <> f <> "(" <> e <> "))"
    CPT (CPTClassMove c) _ ->
      R.CApp
        (R.CVar (R.sname "std::move"))
        [ R.CTApp
            (R.sname "from_nonconst_to_nonconst")
            [R.CTSimple (R.sname (f <> "_t")), R.CTSimple (R.sname f)]
            [R.CAddr e]
        ]
      where
        f = ffiClassName c
    -- "std::move(to_nonconst<" <> f <> "_t," <> f <>">(&(" <> e <> ")))"
    TemplateApp _ ->
      error "cxx2C: TemplateApp"
    -- g <> "* r = new " <> g <> "(" <> e <> "); "
    --  <> "return (static_cast<void*>(r));"
    TemplateAppRef _ ->
      error "cxx2C: TemplateAppRef"
    -- g <> "* r = new " <> g <> "(" <> e <> "); "
    -- <> "return (static_cast<void*>(r));"
    TemplateAppMove _ ->
      error "cxx2C: TemplateAppMove"
    TemplateType _ ->
      error "cxx2C: TemplateType"
    TemplateParam _ ->
      error "cxx2C: TemplateParam"
    -- if b then e
    --      else "to_nonconst<Type ## _t, Type>((Type *)&(" <> e <> "))"
    TemplateParamPointer _ ->
      error "cxx2C: TemplateParamPointer"

-- if b then "(" <> callstr <> ");"
--      else "to_nonconst<Type ## _t, Type>(" <> e <> ") ;"

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

tmplArgToCTypVar ::
  IsCPrimitive ->
  Arg ->
  (R.CType Identity, R.CName Identity)
tmplArgToCTypVar _ (Arg (CT ctyp isconst) varname) =
  (ctypToCType ctyp isconst, R.sname varname)
tmplArgToCTypVar _ (Arg SelfType varname) =
  (R.CTStar R.CTVoid, R.sname varname)
tmplArgToCTypVar _ (Arg (CPT (CPTClass c) isconst) varname) =
  case isconst of
    Const -> (R.CTSimple (R.sname ("const_" <> ffiClassName c <> "_p")), R.sname varname)
    NoConst -> (R.CTSimple (R.sname (ffiClassName c <> "_p")), R.sname varname)
tmplArgToCTypVar _ (Arg (CPT (CPTClassRef c) isconst) varname) =
  case isconst of
    Const -> (R.CTSimple (R.sname ("const_" <> ffiClassName c <> "_p")), R.sname varname)
    NoConst -> (R.CTSimple (R.sname (ffiClassName c <> "_p")), R.sname varname)
tmplArgToCTypVar _ (Arg (CPT (CPTClassMove c) isconst) varname) =
  case isconst of
    Const -> (R.CTSimple (R.sname ("const_" <> ffiClassName c <> "_p")), R.sname varname)
    NoConst -> (R.CTSimple (R.sname (ffiClassName c <> "_p")), R.sname varname)
tmplArgToCTypVar _ (Arg (TemplateApp _) v) = (R.CTStar R.CTVoid, R.sname v)
tmplArgToCTypVar _ (Arg (TemplateAppRef _) v) = (R.CTStar R.CTVoid, R.sname v)
tmplArgToCTypVar _ (Arg (TemplateAppMove _) v) = (R.CTStar R.CTVoid, R.sname v)
tmplArgToCTypVar _ (Arg (TemplateType _) v) = (R.CTStar R.CTVoid, R.sname v)
tmplArgToCTypVar CPrim (Arg (TemplateParam t) v) = (R.CTSimple (R.sname t), R.sname v)
tmplArgToCTypVar NonCPrim (Arg (TemplateParam t) v) = (R.CTSimple (R.CName [R.NamePart t, R.NamePart "_p"]), R.sname v)
tmplArgToCTypVar CPrim (Arg (TemplateParamPointer t) v) = (R.CTSimple (R.sname t), R.sname v)
tmplArgToCTypVar NonCPrim (Arg (TemplateParamPointer t) v) = (R.CTSimple (R.CName [R.NamePart t, R.NamePart "_p"]), R.sname v)
tmplArgToCTypVar _ _ = error "tmplArgToCTypVar: undefined"

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

-- TODO: Rewrite this with static_cast.
--       Implement missing cases.
tmplArgToCallCExp ::
  IsCPrimitive ->
  Arg ->
  R.CExp Identity
tmplArgToCallCExp _ (Arg (CPT (CPTClass c) _) varname) =
  R.CTApp
    (R.sname "from_nonconst_to_nonconst")
    [R.CTSimple (R.sname str), R.CTSimple (R.sname (str <> "_t"))]
    [R.CVar (R.sname varname)]
  where
    str = ffiClassName c
tmplArgToCallCExp _ (Arg (CPT (CPTClassRef c) _) varname) =
  R.CTApp
    (R.sname "from_nonconstref_to_nonconstref")
    [R.CTSimple (R.sname str), R.CTSimple (R.sname (str <> "_t"))]
    [R.CStar $ R.CVar $ R.sname varname]
  where
    str = ffiClassName c
tmplArgToCallCExp _ (Arg (CPT (CPTClassMove c) _) varname) =
  R.CApp
    (R.CVar (R.sname "std::move"))
    [ R.CTApp
        (R.sname "from_nonconstref_to_nonconstref")
        [R.CTSimple (R.sname str), R.CTSimple (R.sname (str <> "_t"))]
        [R.CStar $ R.CVar $ R.sname varname]
    ]
  where
    str = ffiClassName c
tmplArgToCallCExp _ (Arg (CT (CRef _) _) varname) =
  R.CStar $ R.CVar $ R.sname varname
tmplArgToCallCExp _ (Arg (TemplateApp x) varname) =
  let targs = map (R.CTSimple . R.sname . hsClassNameForTArg) (tapp_tparams x)
   in R.CTApp
        (R.sname "static_cast")
        [R.CTStar $ tmplAppTypeFromForm (tclass_cxxform (tapp_tclass x)) targs]
        [R.CVar $ R.sname varname]
tmplArgToCallCExp _ (Arg (TemplateAppRef x) varname) =
  let targs = map (R.CTSimple . R.sname . hsClassNameForTArg) (tapp_tparams x)
   in R.CStar $
        R.CTApp
          (R.sname "static_cast")
          [R.CTStar $ tmplAppTypeFromForm (tclass_cxxform (tapp_tclass x)) targs]
          [R.CVar $ R.sname varname]
tmplArgToCallCExp _ (Arg (TemplateAppMove x) varname) =
  let targs = map (R.CTSimple . R.sname . hsClassNameForTArg) (tapp_tparams x)
   in R.CApp
        (R.CVar (R.sname "std::move"))
        [ R.CStar $
            R.CTApp
              (R.sname "static_cast")
              [R.CTStar $ tmplAppTypeFromForm (tclass_cxxform (tapp_tclass x)) targs]
              [R.CVar $ R.sname varname]
        ]
tmplArgToCallCExp b (Arg (TemplateParam typ) varname) =
  case b of
    CPrim -> R.CVar $ R.sname varname
    NonCPrim ->
      R.CStar $
        R.CTApp
          (R.sname "from_nonconst_to_nonconst")
          [R.CTSimple (R.sname typ), R.CTSimple (R.CName [R.NamePart typ, R.NamePart "_t"])]
          [R.CVar $ R.sname varname]
tmplArgToCallCExp b (Arg (TemplateParamPointer typ) varname) =
  case b of
    CPrim -> R.CVar $ R.sname varname
    NonCPrim ->
      R.CTApp
        (R.sname "from_nonconst_to_nonconst")
        [R.CTSimple (R.sname typ), R.CTSimple (R.CName [R.NamePart typ, R.NamePart "_t"])]
        [R.CVar $ R.sname varname]
tmplArgToCallCExp _ (Arg _ varname) = R.CVar $ R.sname varname

tmplReturnCType ::
  IsCPrimitive ->
  Types ->
  R.CType Identity
tmplReturnCType _ (CT ctyp isconst) = ctypToCType ctyp isconst
tmplReturnCType _ Void = R.CTVoid
tmplReturnCType _ SelfType = R.CTStar R.CTVoid
tmplReturnCType _ (CPT (CPTClass c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
tmplReturnCType _ (CPT (CPTClassRef c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
tmplReturnCType _ (CPT (CPTClassCopy c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
tmplReturnCType _ (CPT (CPTClassMove c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
tmplReturnCType _ (TemplateApp _) = R.CTStar R.CTVoid
tmplReturnCType _ (TemplateAppRef _) = R.CTStar R.CTVoid
tmplReturnCType _ (TemplateAppMove _) = R.CTStar R.CTVoid
tmplReturnCType _ (TemplateType _) = R.CTStar R.CTVoid
tmplReturnCType b (TemplateParam t) = case b of
  CPrim -> R.CTSimple $ R.sname t
  NonCPrim -> R.CTSimple $ R.CName [R.NamePart t, R.NamePart "_p"]
tmplReturnCType b (TemplateParamPointer t) = case b of
  CPrim -> R.CTSimple $ R.sname t
  NonCPrim -> R.CTSimple $ R.CName [R.NamePart t, R.NamePart "_p"]

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

-- |
tmplMemFuncArgToCTypVar :: Class -> Arg -> (R.CType Identity, R.CName Identity)
tmplMemFuncArgToCTypVar _ (Arg (CT ctyp isconst) varname) =
  (ctypToCType ctyp isconst, R.sname varname)
tmplMemFuncArgToCTypVar c (Arg SelfType varname) =
  (R.CTSimple (R.sname (ffiClassName c <> "_p")), R.sname varname)
tmplMemFuncArgToCTypVar _ (Arg (CPT (CPTClass c) isconst) varname) =
  case isconst of
    Const -> (R.CTSimple (R.sname ("const_" <> ffiClassName c <> "_p")), R.sname varname)
    NoConst -> (R.CTSimple (R.sname (ffiClassName c <> "_p")), R.sname varname)
tmplMemFuncArgToCTypVar _ (Arg (CPT (CPTClassRef c) isconst) varname) =
  case isconst of
    Const -> (R.CTSimple (R.sname ("const_" <> ffiClassName c <> "_p")), R.sname varname)
    NoConst -> (R.CTSimple (R.sname (ffiClassName c <> "_p")), R.sname varname)
tmplMemFuncArgToCTypVar _ (Arg (CPT (CPTClassMove c) isconst) varname) =
  case isconst of
    Const -> (R.CTSimple (R.sname ("const_" <> ffiClassName c <> "_p")), R.sname varname)
    NoConst -> (R.CTSimple (R.sname (ffiClassName c <> "_p")), R.sname varname)
tmplMemFuncArgToCTypVar _ (Arg (TemplateApp _) v) = (R.CTStar R.CTVoid, R.sname v)
tmplMemFuncArgToCTypVar _ (Arg (TemplateAppRef _) v) = (R.CTStar R.CTVoid, R.sname v)
tmplMemFuncArgToCTypVar _ (Arg (TemplateAppMove _) v) = (R.CTStar R.CTVoid, R.sname v)
tmplMemFuncArgToCTypVar _ (Arg (TemplateType _) v) = (R.CTStar R.CTVoid, R.sname v)
tmplMemFuncArgToCTypVar _ (Arg (TemplateParam t) v) = (R.CTSimple (R.CName [R.NamePart t, R.NamePart "_p"]), R.sname v)
tmplMemFuncArgToCTypVar _ (Arg (TemplateParamPointer t) v) = (R.CTSimple (R.CName [R.NamePart t, R.NamePart "_p"]), R.sname v)
tmplMemFuncArgToCTypVar _ _ = error "tmplMemFuncArgToString: undefined"

-- |
tmplMemFuncReturnCType :: Class -> Types -> R.CType Identity
tmplMemFuncReturnCType _ (CT ctyp isconst) = ctypToCType ctyp isconst
tmplMemFuncReturnCType _ Void = R.CTVoid
tmplMemFuncReturnCType c SelfType = R.CTSimple (R.sname (ffiClassName c <> "_p"))
tmplMemFuncReturnCType _ (CPT (CPTClass c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
tmplMemFuncReturnCType _ (CPT (CPTClassRef c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
tmplMemFuncReturnCType _ (CPT (CPTClassCopy c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
tmplMemFuncReturnCType _ (CPT (CPTClassMove c) _) = R.CTSimple (R.sname (ffiClassName c <> "_p"))
tmplMemFuncReturnCType _ (TemplateApp _) = R.CTStar R.CTVoid
tmplMemFuncReturnCType _ (TemplateAppRef _) = R.CTStar R.CTVoid
tmplMemFuncReturnCType _ (TemplateAppMove _) = R.CTStar R.CTVoid
tmplMemFuncReturnCType _ (TemplateType _) = R.CTStar R.CTVoid
tmplMemFuncReturnCType _ (TemplateParam t) = R.CTSimple $ R.CName [R.NamePart t, R.NamePart "_p"]
tmplMemFuncReturnCType _ (TemplateParamPointer t) = R.CTSimple $ R.CName [R.NamePart t, R.NamePart "_p"]

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

-- |
convertCpp2HS :: Maybe Class -> Types -> Type ()
convertCpp2HS _c Void = unit_tycon
convertCpp2HS (Just c) SelfType = tycon ((fst . hsClassName) c)
convertCpp2HS Nothing SelfType = error "convertCpp2HS : SelfType but no class "
convertCpp2HS _c (CT t _) = convertC2HS t
convertCpp2HS _c (CPT (CPTClass c') _) = (tycon . fst . hsClassName) c'
convertCpp2HS _c (CPT (CPTClassRef c') _) = (tycon . fst . hsClassName) c'
convertCpp2HS _c (CPT (CPTClassCopy c') _) = (tycon . fst . hsClassName) c'
convertCpp2HS _c (CPT (CPTClassMove c') _) = (tycon . fst . hsClassName) c'
convertCpp2HS _c (TemplateApp x) =
  foldl1 tyapp $
    map tycon $
      tclass_name (tapp_tclass x) : map hsClassNameForTArg (tapp_tparams x)
convertCpp2HS _c (TemplateAppRef x) =
  foldl1 tyapp $
    map tycon $
      tclass_name (tapp_tclass x) : map hsClassNameForTArg (tapp_tparams x)
convertCpp2HS _c (TemplateAppMove x) =
  foldl1 tyapp $
    map tycon $
      tclass_name (tapp_tclass x) : map hsClassNameForTArg (tapp_tparams x)
convertCpp2HS _c (TemplateType t) =
  foldl1 tyapp $
    tycon (tclass_name t) : map mkTVar (tclass_params t)
convertCpp2HS _c (TemplateParam p) = mkTVar p
convertCpp2HS _c (TemplateParamPointer p) = mkTVar p

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

hsFuncXformer :: Function -> String
hsFuncXformer func@(Constructor _ _) =
  let len = length (genericFuncArgs func)
   in if len > 0
        then "xform" <> show (len - 1)
        else "xformnull"
hsFuncXformer func@(Static _ _ _ _) =
  let len = length (genericFuncArgs func)
   in if len > 0
        then "xform" <> show (len - 1)
        else "xformnull"
hsFuncXformer func =
  let len = length (genericFuncArgs func)
   in "xform" <> show len

classConstraints :: Class -> Context ()
classConstraints = cxTuple . map ((\n -> classA (unqual n) [mkTVar "a"]) . typeclassName) . 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 mc isvirtual (CFunSig args ret) =
  let (typs, s) = flip runState ([], (0 :: Int)) $ do
        as <- mapM (mktyp . arg_type) args
        r <- case ret of
          SelfType -> case mc of
            Nothing -> error "extractArgRetTypes: SelfType return but no class"
            Just c -> if isvirtual then return (mkTVar "a") else return $ tycon ((fst . hsClassName) c)
          x -> (return . convertCpp2HS Nothing) x
        return (as ++ [tyapp (tycon "IO") r])
   in HsFunSig
        { hsSigTypes = typs,
          hsSigConstraints = fst s
        }
  where
    addclass c = do
      (ctxts, n) <- get
      let cname = (fst . hsClassName) c
          iname = typeclassNameFromStr cname
          tvar = mkTVar ('c' : show n)
          ctxt1 = classA (unqual iname) [tvar]
          ctxt2 = classA (unqual "FPtr") [tvar]
      put (ctxt1 : ctxt2 : ctxts, n + 1)
      return tvar
    addstring = do
      (ctxts, n) <- get
      let tvar = mkTVar ('c' : show n)
          ctxt = classA (unqual "Castable") [tvar, tycon "CString"]
      put (ctxt : ctxts, n + 1)
      return tvar
    mktyp typ =
      case typ of
        SelfType -> return (mkTVar "a")
        CT CTString Const -> addstring
        CT _ _ -> return $ convertCpp2HS Nothing typ
        CPT (CPTClass c') _ -> addclass c'
        CPT (CPTClassRef c') _ -> addclass c'
        CPT (CPTClassCopy c') _ -> addclass c'
        CPT (CPTClassMove c') _ -> addclass c'
        -- it is not clear whether the following is okay or not.
        (TemplateApp x) ->
          pure $
            convertCpp2HS Nothing (TemplateApp x)
        (TemplateAppRef x) ->
          pure $
            convertCpp2HS Nothing (TemplateAppRef x)
        (TemplateAppMove x) ->
          pure $
            convertCpp2HS Nothing (TemplateAppMove x)
        (TemplateType t) ->
          pure $
            foldl1 tyapp (tycon (tclass_name t) : map mkTVar (tclass_params t))
        (TemplateParam p) -> return (mkTVar p)
        Void -> return unit_tycon
        _ -> error ("No such c type : " <> show typ)

functionSignature :: Class -> Function -> Type ()
functionSignature c f =
  let HsFunSig typs assts =
        extractArgRetTypes
          (Just c)
          (isVirtualFunc f)
          (CFunSig (genericFuncArgs f) (genericFuncRet f))
      ctxt = cxTuple assts
      arg0
        | isVirtualFunc f = (mkTVar "a" :)
        | isNonVirtualFunc f = (mkTVar (fst (hsClassName c)) :)
        | otherwise = id
   in TyForall () Nothing (Just ctxt) (foldr1 tyfun (arg0 typs))

functionSignatureT :: TemplateClass -> TemplateFunction -> Type ()
functionSignatureT t TFun {..} =
  let (hname, _) = hsTemplateClassName t
      slf = foldl1 tyapp (tycon hname : map mkTVar (tclass_params t))
      ctyp = convertCpp2HS Nothing tfun_ret
      lst = slf : map (convertCpp2HS Nothing . arg_type) tfun_args
   in foldr1 tyfun (lst <> [tyapp (tycon "IO") ctyp])
functionSignatureT t TFunNew {..} =
  let ctyp = convertCpp2HS Nothing (TemplateType t)
      lst = map (convertCpp2HS Nothing . arg_type) tfun_new_args
   in foldr1 tyfun (lst <> [tyapp (tycon "IO") ctyp])
functionSignatureT t TFunDelete =
  let ctyp = convertCpp2HS Nothing (TemplateType t)
   in ctyp `tyfun` (tyapp (tycon "IO") unit_tycon)
functionSignatureT t TFunOp {..} =
  let (hname, _) = hsTemplateClassName t
      slf = foldl1 tyapp (tycon hname : map mkTVar (tclass_params t))
      ctyp = convertCpp2HS Nothing tfun_ret
      lst = slf : map (convertCpp2HS Nothing . arg_type) (argsFromOpExp tfun_opexp)
   in foldr1 tyfun (lst <> [tyapp (tycon "IO") ctyp])

-- TODO: rename this and combine this with functionSignatureTMF
functionSignatureTT :: TemplateClass -> TemplateFunction -> Type ()
functionSignatureTT t f = foldr1 tyfun (lst <> [tyapp (tycon "IO") ctyp])
  where
    (hname, _) = hsTemplateClassName t
    ctyp = case f of
      TFun {..} -> convertCpp2HS4Tmpl e Nothing spls tfun_ret
      TFunNew {} -> convertCpp2HS4Tmpl e Nothing spls (TemplateType t)
      TFunDelete -> unit_tycon
      TFunOp {..} -> convertCpp2HS4Tmpl e Nothing spls tfun_ret
    e = foldl1 tyapp (tycon hname : spls)
    spls = map (tySplice . parenSplice . mkVar) $ tclass_params t
    lst =
      case f of
        TFun {..} -> e : map (convertCpp2HS4Tmpl e Nothing spls . arg_type) tfun_args
        TFunNew {..} -> map (convertCpp2HS4Tmpl e Nothing spls . arg_type) tfun_new_args
        TFunDelete -> [e]
        TFunOp {..} -> e : map (convertCpp2HS4Tmpl e Nothing spls . arg_type) (argsFromOpExp tfun_opexp)

-- TODO: rename this and combine this with functionSignatureTT
functionSignatureTMF :: Class -> TemplateMemberFunction -> Type ()
functionSignatureTMF c f = foldr1 tyfun (lst <> [tyapp (tycon "IO") ctyp])
  where
    spls = map (tySplice . parenSplice . mkVar) (tmf_params f)
    ctyp = convertCpp2HS4Tmpl e Nothing spls (tmf_ret f)
    e = tycon (fst (hsClassName c))
    lst = e : map (convertCpp2HS4Tmpl e Nothing spls . arg_type) (tmf_args f)

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

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

accessorSignature :: Class -> Variable -> Accessor -> Type ()
accessorSignature c v accessor =
  let csig = accessorCFunSig (arg_type (unVariable v)) accessor
      HsFunSig typs assts = extractArgRetTypes (Just c) False csig
      ctxt = cxTuple assts
      arg0 = (mkTVar (fst (hsClassName c)) :)
   in TyForall () Nothing (Just ctxt) (foldr1 tyfun (arg0 typs))

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

genericFuncRet :: Function -> Types
genericFuncRet f =
  case f of
    Constructor _ _ -> self_
    Virtual t _ _ _ -> t
    NonVirtual t _ _ _ -> t
    Static t _ _ _ -> t
    Destructor _ -> void_

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