{-# LANGUAGE TemplateHaskell #-}
module STD.Vector.TH where
import Data.Char
import Data.List
import Data.Monoid
import Foreign.C.Types
import Foreign.Ptr
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import FFICXX.Runtime.CodeGen.Cxx
import FFICXX.Runtime.TH
import STD.Vector.Template
import STD.VectorIterator.Template

t_newVector :: Type -> String -> Q Exp
t_newVector :: Type -> String -> Q Exp
t_newVector Type
typ1 String
suffix
  = forall types.
(types, String, String -> String, types -> Q Type) -> Q Exp
mkTFunc (Type
typ1, String
suffix, \ String
n -> String
"Vector_new" forall a. Semigroup a => a -> a -> a
<> String
n, forall {m :: * -> *} {p}. Quote m => p -> m Type
tyf)
  where tyf :: p -> m Type
tyf p
_ = let tp1 :: m Type
tp1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
typ1 in [t| IO (Vector $( tp1 )) |]

t_begin :: Type -> String -> Q Exp
t_begin :: Type -> String -> Q Exp
t_begin Type
typ1 String
suffix
  = forall types.
(types, String, String -> String, types -> Q Type) -> Q Exp
mkTFunc (Type
typ1, String
suffix, \ String
n -> String
"Vector_begin" forall a. Semigroup a => a -> a -> a
<> String
n, forall {m :: * -> *} {p}. Quote m => p -> m Type
tyf)
  where tyf :: p -> m Type
tyf p
_
          = let tp1 :: m Type
tp1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
typ1 in
              [t| Vector $( tp1 ) -> IO (VectorIterator $( tp1 )) |]

t_end :: Type -> String -> Q Exp
t_end :: Type -> String -> Q Exp
t_end Type
typ1 String
suffix
  = forall types.
(types, String, String -> String, types -> Q Type) -> Q Exp
mkTFunc (Type
typ1, String
suffix, \ String
n -> String
"Vector_end" forall a. Semigroup a => a -> a -> a
<> String
n, forall {m :: * -> *} {p}. Quote m => p -> m Type
tyf)
  where tyf :: p -> m Type
tyf p
_
          = let tp1 :: m Type
tp1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
typ1 in
              [t| Vector $( tp1 ) -> IO (VectorIterator $( tp1 )) |]

t_push_back :: Type -> String -> Q Exp
t_push_back :: Type -> String -> Q Exp
t_push_back Type
typ1 String
suffix
  = forall types.
(types, String, String -> String, types -> Q Type) -> Q Exp
mkTFunc (Type
typ1, String
suffix, \ String
n -> String
"Vector_push_back" forall a. Semigroup a => a -> a -> a
<> String
n, forall {m :: * -> *} {p}. Quote m => p -> m Type
tyf)
  where tyf :: p -> m Type
tyf p
_
          = let tp1 :: m Type
tp1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
typ1 in
              [t| Vector $( tp1 ) -> $( tp1 ) -> IO () |]

t_pop_back :: Type -> String -> Q Exp
t_pop_back :: Type -> String -> Q Exp
t_pop_back Type
typ1 String
suffix
  = forall types.
(types, String, String -> String, types -> Q Type) -> Q Exp
mkTFunc (Type
typ1, String
suffix, \ String
n -> String
"Vector_pop_back" forall a. Semigroup a => a -> a -> a
<> String
n, forall {m :: * -> *} {p}. Quote m => p -> m Type
tyf)
  where tyf :: p -> m Type
tyf p
_
          = let tp1 :: m Type
tp1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
typ1 in [t| Vector $( tp1 ) -> IO () |]

t_at :: Type -> String -> Q Exp
t_at :: Type -> String -> Q Exp
t_at Type
typ1 String
suffix
  = forall types.
(types, String, String -> String, types -> Q Type) -> Q Exp
mkTFunc (Type
typ1, String
suffix, \ String
n -> String
"Vector_at" forall a. Semigroup a => a -> a -> a
<> String
n, forall {m :: * -> *} {p}. Quote m => p -> m Type
tyf)
  where tyf :: p -> m Type
tyf p
_
          = let tp1 :: m Type
tp1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
typ1 in
              [t| Vector $( tp1 ) -> CInt -> IO $( tp1 ) |]

t_size :: Type -> String -> Q Exp
t_size :: Type -> String -> Q Exp
t_size Type
typ1 String
suffix
  = forall types.
(types, String, String -> String, types -> Q Type) -> Q Exp
mkTFunc (Type
typ1, String
suffix, \ String
n -> String
"Vector_size" forall a. Semigroup a => a -> a -> a
<> String
n, forall {m :: * -> *} {p}. Quote m => p -> m Type
tyf)
  where tyf :: p -> m Type
tyf p
_
          = let tp1 :: m Type
tp1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
typ1 in [t| Vector $( tp1 ) -> IO CInt |]

t_deleteVector :: Type -> String -> Q Exp
t_deleteVector :: Type -> String -> Q Exp
t_deleteVector Type
typ1 String
suffix
  = forall types.
(types, String, String -> String, types -> Q Type) -> Q Exp
mkTFunc (Type
typ1, String
suffix, \ String
n -> String
"Vector_delete" forall a. Semigroup a => a -> a -> a
<> String
n, forall {m :: * -> *} {p}. Quote m => p -> m Type
tyf)
  where tyf :: p -> m Type
tyf p
_
          = let tp1 :: m Type
tp1 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
typ1 in [t| Vector $( tp1 ) -> IO () |]

genVectorInstanceFor ::
                     IsCPrimitive -> (Q Type, TemplateParamInfo) -> Q [Dec]
genVectorInstanceFor :: IsCPrimitive -> (Q Type, TemplateParamInfo) -> Q [Dec]
genVectorInstanceFor IsCPrimitive
isCprim (Q Type
qtyp1, TemplateParamInfo
param1)
  = do let params :: [String]
params = forall a b. (a -> b) -> [a] -> [b]
map TemplateParamInfo -> String
tpinfoSuffix [TemplateParamInfo
param1]
       let suffix :: String
suffix = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ TemplateParamInfo
x -> String
"_" forall a. [a] -> [a] -> [a]
++ TemplateParamInfo -> String
tpinfoSuffix TemplateParamInfo
x) [TemplateParamInfo
param1]
       String
callmod_ <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Loc -> String
loc_module Q Loc
location
       let callmod :: String
callmod = String -> String
dot2_ String
callmod_
       Type
typ1 <- Q Type
qtyp1
       Dec
f1 <- forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkNew String
"newVector" Type -> String -> Q Exp
t_newVector Type
typ1 String
suffix
       Dec
f2 <- forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkMember String
"begin" Type -> String -> Q Exp
t_begin Type
typ1 String
suffix
       Dec
f3 <- forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkMember String
"end" Type -> String -> Q Exp
t_end Type
typ1 String
suffix
       Dec
f4 <- forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkMember String
"push_back" Type -> String -> Q Exp
t_push_back Type
typ1 String
suffix
       Dec
f5 <- forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkMember String
"pop_back" Type -> String -> Q Exp
t_pop_back Type
typ1 String
suffix
       Dec
f6 <- forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkMember String
"at" Type -> String -> Q Exp
t_at Type
typ1 String
suffix
       Dec
f7 <- forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkMember String
"size" Type -> String -> Q Exp
t_size Type
typ1 String
suffix
       Dec
f8 <- forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkDelete String
"deleteVector" Type -> String -> Q Exp
t_deleteVector Type
typ1 String
suffix
       Q () -> Q ()
addModFinalizer
         (ForeignSrcLang -> String -> Q ()
addForeignSource ForeignSrcLang
LangCxx
            (String
"\n#include \"MacroPatternMatch.h\"\n\n\n#include \"vector\"\n\n\n#define Vector_new(callmod, tp1) \\\nextern \"C\" {\\\nvoid* Vector_new_##tp1 (  );}\\\ninline void* Vector_new_##tp1 (  ) {\\\nreturn static_cast<void*>(new std::vector<tp1>());\\\n}\\\nauto a_##callmod##_Vector_new_##tp1=Vector_new_##tp1;\n\n\n#define Vector_begin(callmod, tp1) \\\nextern \"C\" {\\\nvoid* Vector_begin_##tp1 ( void* p );}\\\ninline void* Vector_begin_##tp1 ( void* p ) {\\\nstd::vector<tp1>::iterator* r=new std::vector<tp1>::iterator((static_cast<std::vector<tp1>*>(p))->begin());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_Vector_begin_##tp1=Vector_begin_##tp1;\n\n\n#define Vector_end(callmod, tp1) \\\nextern \"C\" {\\\nvoid* Vector_end_##tp1 ( void* p );}\\\ninline void* Vector_end_##tp1 ( void* p ) {\\\nstd::vector<tp1>::iterator* r=new std::vector<tp1>::iterator((static_cast<std::vector<tp1>*>(p))->end());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_Vector_end_##tp1=Vector_end_##tp1;\n\n\n#define Vector_push_back(callmod, tp1) \\\nextern \"C\" {\\\nvoid Vector_push_back_##tp1 ( void* p, tp1##_p x );}\\\ninline void Vector_push_back_##tp1 ( void* p, tp1##_p x ) {\\\n(static_cast<std::vector<tp1>*>(p))->push_back(*(from_nonconst_to_nonconst<tp1, tp1##_t>(x)));\\\n}\\\nauto a_##callmod##_Vector_push_back_##tp1=Vector_push_back_##tp1;\n\n\n#define Vector_pop_back(callmod, tp1) \\\nextern \"C\" {\\\nvoid Vector_pop_back_##tp1 ( void* p );}\\\ninline void Vector_pop_back_##tp1 ( void* p ) {\\\n(static_cast<std::vector<tp1>*>(p))->pop_back();\\\n}\\\nauto a_##callmod##_Vector_pop_back_##tp1=Vector_pop_back_##tp1;\n\n\n#define Vector_at(callmod, tp1) \\\nextern \"C\" {\\\ntp1##_p Vector_at_##tp1 ( void* p, int n );}\\\ninline tp1##_p Vector_at_##tp1 ( void* p, int n ) {\\\nreturn from_nonconst_to_nonconst<tp1##_t, tp1>((tp1*)&((static_cast<std::vector<tp1>*>(p))->at(n)));\\\n}\\\nauto a_##callmod##_Vector_at_##tp1=Vector_at_##tp1;\n\n\n#define Vector_size(callmod, tp1) \\\nextern \"C\" {\\\nint Vector_size_##tp1 ( void* p );}\\\ninline int Vector_size_##tp1 ( void* p ) {\\\nreturn (static_cast<std::vector<tp1>*>(p))->size();\\\n}\\\nauto a_##callmod##_Vector_size_##tp1=Vector_size_##tp1;\n\n\n#define Vector_delete(callmod, tp1) \\\nextern \"C\" {\\\nvoid Vector_delete_##tp1 ( void* p );}\\\ninline void Vector_delete_##tp1 ( void* p ) {\\\ndelete static_cast<std::vector<tp1>*>(p);\\\n}\\\nauto a_##callmod##_Vector_delete_##tp1=Vector_delete_##tp1;\n\n\n#define Vector_new_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid* Vector_new_##tp1 (  );}\\\ninline void* Vector_new_##tp1 (  ) {\\\nreturn static_cast<void*>(new std::vector<tp1>());\\\n}\\\nauto a_##callmod##_Vector_new_##tp1=Vector_new_##tp1;\n\n\n#define Vector_begin_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid* Vector_begin_##tp1 ( void* p );}\\\ninline void* Vector_begin_##tp1 ( void* p ) {\\\nstd::vector<tp1>::iterator* r=new std::vector<tp1>::iterator((static_cast<std::vector<tp1>*>(p))->begin());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_Vector_begin_##tp1=Vector_begin_##tp1;\n\n\n#define Vector_end_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid* Vector_end_##tp1 ( void* p );}\\\ninline void* Vector_end_##tp1 ( void* p ) {\\\nstd::vector<tp1>::iterator* r=new std::vector<tp1>::iterator((static_cast<std::vector<tp1>*>(p))->end());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_Vector_end_##tp1=Vector_end_##tp1;\n\n\n#define Vector_push_back_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid Vector_push_back_##tp1 ( void* p, tp1 x );}\\\ninline void Vector_push_back_##tp1 ( void* p, tp1 x ) {\\\n(static_cast<std::vector<tp1>*>(p))->push_back(x);\\\n}\\\nauto a_##callmod##_Vector_push_back_##tp1=Vector_push_back_##tp1;\n\n\n#define Vector_pop_back_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid Vector_pop_back_##tp1 ( void* p );}\\\ninline void Vector_pop_back_##tp1 ( void* p ) {\\\n(static_cast<std::vector<tp1>*>(p))->pop_back();\\\n}\\\nauto a_##callmod##_Vector_pop_back_##tp1=Vector_pop_back_##tp1;\n\n\n#define Vector_at_s(callmod, tp1) \\\nextern \"C\" {\\\ntp1 Vector_at_##tp1 ( void* p, int n );}\\\ninline tp1 Vector_at_##tp1 ( void* p, int n ) {\\\nreturn (static_cast<std::vector<tp1>*>(p))->at(n);\\\n}\\\nauto a_##callmod##_Vector_at_##tp1=Vector_at_##tp1;\n\n\n#define Vector_size_s(callmod, tp1) \\\nextern \"C\" {\\\nint Vector_size_##tp1 ( void* p );}\\\ninline int Vector_size_##tp1 ( void* p ) {\\\nreturn (static_cast<std::vector<tp1>*>(p))->size();\\\n}\\\nauto a_##callmod##_Vector_size_##tp1=Vector_size_##tp1;\n\n\n#define Vector_delete_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid Vector_delete_##tp1 ( void* p );}\\\ninline void Vector_delete_##tp1 ( void* p ) {\\\ndelete static_cast<std::vector<tp1>*>(p);\\\n}\\\nauto a_##callmod##_Vector_delete_##tp1=Vector_delete_##tp1;\n\n\n#define Vector_instance(callmod, tp1) \\\nVector_new(callmod, tp1)\\\nVector_begin(callmod, tp1)\\\nVector_end(callmod, tp1)\\\nVector_push_back(callmod, tp1)\\\nVector_pop_back(callmod, tp1)\\\nVector_at(callmod, tp1)\\\nVector_size(callmod, tp1)\\\nVector_delete(callmod, tp1)\n\n\n#define Vector_instance_s(callmod, tp1) \\\nVector_new_s(callmod, tp1)\\\nVector_begin_s(callmod, tp1)\\\nVector_end_s(callmod, tp1)\\\nVector_push_back_s(callmod, tp1)\\\nVector_pop_back_s(callmod, tp1)\\\nVector_at_s(callmod, tp1)\\\nVector_size_s(callmod, tp1)\\\nVector_delete_s(callmod, tp1)\n\n"
               forall a. [a] -> [a] -> [a]
++
               let headers :: [HeaderName]
headers = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TemplateParamInfo -> [HeaderName]
tpinfoCxxHeaders [TemplateParamInfo
param1]
                   f :: HeaderName -> String
f HeaderName
x = CMacro Identity -> String
renderCMacro (forall (f :: * -> *). HeaderName -> CMacro f
Include HeaderName
x)
                 in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HeaderName -> String
f [HeaderName]
headers
                 forall a. [a] -> [a] -> [a]
++
                 let nss :: [Namespace]
nss = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TemplateParamInfo -> [Namespace]
tpinfoCxxNamespaces [TemplateParamInfo
param1]
                     f :: Namespace -> String
f Namespace
x = CStatement Identity -> String
renderCStmt (forall (f :: * -> *). Namespace -> CStatement f
UsingNamespace Namespace
x)
                   in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Namespace -> String
f [Namespace]
nss
                   forall a. [a] -> [a] -> [a]
++
                   String
"Vector_instance" forall a. [a] -> [a] -> [a]
++
                     (case IsCPrimitive
isCprim of
                          IsCPrimitive
CPrim -> String
"_s"
                          IsCPrimitive
NonCPrim -> String
"")
                       forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (String
callmod forall a. a -> [a] -> [a]
: [String]
params) forall a. [a] -> [a] -> [a]
++ String
")\n"))
       let lst :: [Dec]
lst = [Dec
f1, Dec
f2, Dec
f3, Dec
f4, Dec
f5, Dec
f6, Dec
f7, Dec
f8]
       forall (f :: * -> *) a. Applicative f => a -> f a
pure [Cxt -> Type -> [Dec] -> Dec
mkInstance [] (Type -> Type -> Type
AppT (String -> Type
con String
"IVector") Type
typ1) [Dec]
lst]