{-# LANGUAGE TemplateHaskell #-}
module FFICXX.Runtime.TH where
--
import FFICXX.Runtime.CodeGen.Cxx (HeaderName, Namespace)
import Language.Haskell.TH (forImpD, safe, varE)
import Language.Haskell.TH.Syntax
( Body (NormalB),
Callconv (CCall),
Clause (..),
Cxt,
Dec (..),
Exp (..),
Pat (..),
Q,
Type (..),
addTopDecls,
mkNameS,
newName,
)
-- | Primitive C type like int, double should be treated differently than
-- Non-primitive type. The primitive type detection is not yet automatic.
-- So we manually mark template instantiation with this boolean parameter.
data IsCPrimitive
= CPrim
| NonCPrim
deriving (Show)
-- | template parameter: A,B,.. in T
data TemplateParamInfo = TPInfo
{ tpinfoCxxType :: String,
-- , tpinfoIsCPrimitive :: IsCPrimitive -- ^ whether the parameter is C-primitive type
tpinfoCxxHeaders :: [HeaderName],
tpinfoCxxNamespaces :: [Namespace],
tpinfoSuffix :: String
}
deriving (Show)
-- | function pointer parameter A(B,C,..) in std::function
data FunctionParamInfo = FPInfo
{ fpinfoCxxArgTypes :: [(String, String)],
fpinfoCxxRetType :: Maybe String,
fpinfoCxxHeaders :: [HeaderName],
fpinfoCxxNamespaces :: [Namespace],
fpinfoSuffix :: String
}
deriving (Show)
con :: String -> Type
con = ConT . mkNameS
-- |
mkInstance :: Cxt -> Type -> [Dec] -> Dec
mkInstance = InstanceD Nothing
-- |
mkTFunc :: (types, String, String -> String, types -> Q Type) -> Q Exp
mkTFunc (typs, suffix, nf, tyf) =
do
let fn = nf suffix
let fn' = "c_" <> fn
n <- newName fn'
d <- forImpD CCall safe fn n (tyf typs)
addTopDecls [d]
[|$(varE n)|]
-- |
mkMember :: String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkMember fname f typ suffix = do
let x = mkNameS "x"
e <- f typ suffix
pure $
FunD (mkNameS fname) [Clause [VarP x] (NormalB (AppE e (VarE x))) []]
-- |
mkNew :: String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkNew fname f typ suffix = do
e <- f typ suffix
pure $
FunD
(mkNameS fname)
[Clause [] (NormalB e) []]
-- |
mkDelete :: String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkDelete = mkMember
-- |
mkFunc :: String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkFunc fname f typ suffix = do
let x = mkNameS "x"
e <- f typ suffix
pure $
FunD (mkNameS fname) [Clause [VarP x] (NormalB (AppE e (VarE x))) []]
-- | utility function for converting '.' to '_'
dot2_ :: String -> String
dot2_ = map (\c -> if c == '.' then '_' else c)