{-# LANGUAGE TemplateHaskell #-}
module STD.Map.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.Map.Template
import STD.MapIterator.Template
import STD.Pair.Template

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

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

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

t_insert :: (Type, Type) -> String -> Q Exp
t_insert :: (Type, Type) -> String -> Q Exp
t_insert (Type
typ1, Type
typ2) String
suffix
  = ((Type, Type), String, String -> String, (Type, Type) -> Q Type)
-> Q Exp
forall types.
(types, String, String -> String, types -> Q Type) -> Q Exp
mkTFunc ((Type
typ1, Type
typ2), String
suffix, \ String
n -> String
"Map_insert" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n, (Type, Type) -> Q Type
forall {m :: * -> *} {p}. Quote m => p -> m Type
tyf)
  where tyf :: p -> m Type
tyf p
_
          = let tpk :: m Type
tpk = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
typ1
                tpv :: m Type
tpv = Type -> m Type
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
typ2
              in [t| Map $( tpk ) $( tpv ) -> Pair $( tpk ) $( tpv ) -> IO () |]

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

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

genMapInstanceFor ::
                  IsCPrimitive ->
                    (Q Type, TemplateParamInfo) ->
                      (Q Type, TemplateParamInfo) -> Q [Dec]
genMapInstanceFor :: IsCPrimitive
-> (Q Type, TemplateParamInfo)
-> (Q Type, TemplateParamInfo)
-> Q [Dec]
genMapInstanceFor IsCPrimitive
isCprim (Q Type
qtyp1, TemplateParamInfo
param1) (Q Type
qtyp2, TemplateParamInfo
param2)
  = do let params :: [String]
params = (TemplateParamInfo -> String) -> [TemplateParamInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TemplateParamInfo -> String
tpinfoSuffix [TemplateParamInfo
param1, TemplateParamInfo
param2]
       let suffix :: String
suffix
             = (TemplateParamInfo -> String) -> [TemplateParamInfo] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ TemplateParamInfo
x -> String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TemplateParamInfo -> String
tpinfoSuffix TemplateParamInfo
x) [TemplateParamInfo
param1, TemplateParamInfo
param2]
       String
callmod_ <- (Loc -> String) -> Q Loc -> Q String
forall a b. (a -> b) -> Q a -> Q b
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
       Type
typ2 <- Q Type
qtyp2
       Dec
f1 <- String
-> ((Type, Type) -> String -> Q Exp)
-> (Type, Type)
-> String
-> Q Dec
forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkNew String
"newMap" (Type, Type) -> String -> Q Exp
t_newMap (Type
typ1, Type
typ2) String
suffix
       Dec
f2 <- String
-> ((Type, Type) -> String -> Q Exp)
-> (Type, Type)
-> String
-> Q Dec
forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkMember String
"begin" (Type, Type) -> String -> Q Exp
t_begin (Type
typ1, Type
typ2) String
suffix
       Dec
f3 <- String
-> ((Type, Type) -> String -> Q Exp)
-> (Type, Type)
-> String
-> Q Dec
forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkMember String
"end" (Type, Type) -> String -> Q Exp
t_end (Type
typ1, Type
typ2) String
suffix
       Dec
f4 <- String
-> ((Type, Type) -> String -> Q Exp)
-> (Type, Type)
-> String
-> Q Dec
forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkMember String
"insert" (Type, Type) -> String -> Q Exp
t_insert (Type
typ1, Type
typ2) String
suffix
       Dec
f5 <- String
-> ((Type, Type) -> String -> Q Exp)
-> (Type, Type)
-> String
-> Q Dec
forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkMember String
"size" (Type, Type) -> String -> Q Exp
t_size (Type
typ1, Type
typ2) String
suffix
       Dec
f6 <- String
-> ((Type, Type) -> String -> Q Exp)
-> (Type, Type)
-> String
-> Q Dec
forall types.
String -> (types -> String -> Q Exp) -> types -> String -> Q Dec
mkDelete String
"deleteMap" (Type, Type) -> String -> Q Exp
t_deleteMap (Type
typ1, Type
typ2) String
suffix
       Q () -> Q ()
addModFinalizer
         (ForeignSrcLang -> String -> Q ()
addForeignSource ForeignSrcLang
LangCxx
            (String
"\n#include \"MacroPatternMatch.h\"\n\n\n#include \"map\"\n\n\n#define Map_new(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* Map_new_##tpk##_##tpv (  );}\\\ninline void* Map_new_##tpk##_##tpv (  ) {\\\nreturn static_cast<void*>(new std::map<tpk, tpv>());\\\n}\\\nauto a_##callmod##_Map_new_##tpk##_##tpv=Map_new_##tpk##_##tpv;\n\n\n#define Map_begin(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* Map_begin_##tpk##_##tpv ( void* p );}\\\ninline void* Map_begin_##tpk##_##tpv ( void* p ) {\\\nstd::map<tpk,tpv>::iterator* r=new std::map<tpk,tpv>::iterator((static_cast<std::map<tpk, tpv>*>(p))->begin());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_Map_begin_##tpk##_##tpv=Map_begin_##tpk##_##tpv;\n\n\n#define Map_end(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* Map_end_##tpk##_##tpv ( void* p );}\\\ninline void* Map_end_##tpk##_##tpv ( void* p ) {\\\nstd::map<tpk,tpv>::iterator* r=new std::map<tpk,tpv>::iterator((static_cast<std::map<tpk, tpv>*>(p))->end());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_Map_end_##tpk##_##tpv=Map_end_##tpk##_##tpv;\n\n\n#define Map_insert(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid Map_insert_##tpk##_##tpv ( void* p, void* val );}\\\ninline void Map_insert_##tpk##_##tpv ( void* p, void* val ) {\\\n(static_cast<std::map<tpk, tpv>*>(p))->insert(std::move(*(static_cast<std::pair<tpk, tpv>*>(val))));\\\n}\\\nauto a_##callmod##_Map_insert_##tpk##_##tpv=Map_insert_##tpk##_##tpv;\n\n\n#define Map_size(callmod, tpk, tpv) \\\nextern \"C\" {\\\nint Map_size_##tpk##_##tpv ( void* p );}\\\ninline int Map_size_##tpk##_##tpv ( void* p ) {\\\nreturn (static_cast<std::map<tpk, tpv>*>(p))->size();\\\n}\\\nauto a_##callmod##_Map_size_##tpk##_##tpv=Map_size_##tpk##_##tpv;\n\n\n#define Map_delete(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid Map_delete_##tpk##_##tpv ( void* p );}\\\ninline void Map_delete_##tpk##_##tpv ( void* p ) {\\\ndelete static_cast<std::map<tpk, tpv>*>(p);\\\n}\\\nauto a_##callmod##_Map_delete_##tpk##_##tpv=Map_delete_##tpk##_##tpv;\n\n\n#define Map_new_s(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* Map_new_##tpk##_##tpv (  );}\\\ninline void* Map_new_##tpk##_##tpv (  ) {\\\nreturn static_cast<void*>(new std::map<tpk, tpv>());\\\n}\\\nauto a_##callmod##_Map_new_##tpk##_##tpv=Map_new_##tpk##_##tpv;\n\n\n#define Map_begin_s(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* Map_begin_##tpk##_##tpv ( void* p );}\\\ninline void* Map_begin_##tpk##_##tpv ( void* p ) {\\\nstd::map<tpk,tpv>::iterator* r=new std::map<tpk,tpv>::iterator((static_cast<std::map<tpk, tpv>*>(p))->begin());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_Map_begin_##tpk##_##tpv=Map_begin_##tpk##_##tpv;\n\n\n#define Map_end_s(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* Map_end_##tpk##_##tpv ( void* p );}\\\ninline void* Map_end_##tpk##_##tpv ( void* p ) {\\\nstd::map<tpk,tpv>::iterator* r=new std::map<tpk,tpv>::iterator((static_cast<std::map<tpk, tpv>*>(p))->end());return static_cast<void*>(r);\\\n}\\\nauto a_##callmod##_Map_end_##tpk##_##tpv=Map_end_##tpk##_##tpv;\n\n\n#define Map_insert_s(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid Map_insert_##tpk##_##tpv ( void* p, void* val );}\\\ninline void Map_insert_##tpk##_##tpv ( void* p, void* val ) {\\\n(static_cast<std::map<tpk, tpv>*>(p))->insert(std::move(*(static_cast<std::pair<tpk, tpv>*>(val))));\\\n}\\\nauto a_##callmod##_Map_insert_##tpk##_##tpv=Map_insert_##tpk##_##tpv;\n\n\n#define Map_size_s(callmod, tpk, tpv) \\\nextern \"C\" {\\\nint Map_size_##tpk##_##tpv ( void* p );}\\\ninline int Map_size_##tpk##_##tpv ( void* p ) {\\\nreturn (static_cast<std::map<tpk, tpv>*>(p))->size();\\\n}\\\nauto a_##callmod##_Map_size_##tpk##_##tpv=Map_size_##tpk##_##tpv;\n\n\n#define Map_delete_s(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid Map_delete_##tpk##_##tpv ( void* p );}\\\ninline void Map_delete_##tpk##_##tpv ( void* p ) {\\\ndelete static_cast<std::map<tpk, tpv>*>(p);\\\n}\\\nauto a_##callmod##_Map_delete_##tpk##_##tpv=Map_delete_##tpk##_##tpv;\n\n\n#define Map_instance(callmod, tpk, tpv) \\\nMap_new(callmod, tpk, tpv)\\\nMap_begin(callmod, tpk, tpv)\\\nMap_end(callmod, tpk, tpv)\\\nMap_insert(callmod, tpk, tpv)\\\nMap_size(callmod, tpk, tpv)\\\nMap_delete(callmod, tpk, tpv)\n\n\n#define Map_instance_s(callmod, tpk, tpv) \\\nMap_new_s(callmod, tpk, tpv)\\\nMap_begin_s(callmod, tpk, tpv)\\\nMap_end_s(callmod, tpk, tpv)\\\nMap_insert_s(callmod, tpk, tpv)\\\nMap_size_s(callmod, tpk, tpv)\\\nMap_delete_s(callmod, tpk, tpv)\n\n"
               String -> String -> String
forall a. [a] -> [a] -> [a]
++
               let headers :: [HeaderName]
headers = (TemplateParamInfo -> [HeaderName])
-> [TemplateParamInfo] -> [HeaderName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TemplateParamInfo -> [HeaderName]
tpinfoCxxHeaders [TemplateParamInfo
param1, TemplateParamInfo
param2]
                   f :: HeaderName -> String
f HeaderName
x = CMacro Identity -> String
renderCMacro (HeaderName -> CMacro Identity
forall (f :: * -> *). HeaderName -> CMacro f
Include HeaderName
x)
                 in (HeaderName -> String) -> [HeaderName] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HeaderName -> String
f [HeaderName]
headers
                 String -> String -> String
forall a. [a] -> [a] -> [a]
++
                 let nss :: [Namespace]
nss = (TemplateParamInfo -> [Namespace])
-> [TemplateParamInfo] -> [Namespace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TemplateParamInfo -> [Namespace]
tpinfoCxxNamespaces [TemplateParamInfo
param1, TemplateParamInfo
param2]
                     f :: Namespace -> String
f Namespace
x = CStatement Identity -> String
renderCStmt (Namespace -> CStatement Identity
forall (f :: * -> *). Namespace -> CStatement f
UsingNamespace Namespace
x)
                   in (Namespace -> String) -> [Namespace] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Namespace -> String
f [Namespace]
nss
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++
                   String
"Map_instance" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     (case IsCPrimitive
isCprim of
                          IsCPrimitive
CPrim -> String
"_s"
                          IsCPrimitive
NonCPrim -> String
"")
                       String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (String
callmod String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
params) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")\n"))
       let lst :: [Dec]
lst = [Dec
f1, Dec
f2, Dec
f3, Dec
f4, Dec
f5, Dec
f6]
       [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Cxt -> Type -> [Dec] -> Dec
mkInstance [] (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT (String -> Type
con String
"IMap") Type
typ1) Type
typ2) [Dec]
lst]