TH.hs

{-# LANGUAGE TemplateHaskell #-}
module STD.UniquePtr.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.UniquePtr.Template

t_newUniquePtr0 :: Type -> String -> Q Exp
t_newUniquePtr0 typ1 suffix
  = mkTFunc
      (typ1, suffix, \ n -> "UniquePtr_newUniquePtr0" <> n, tyf)
  where tyf _ = let tp1 = pure typ1 in [t| IO (UniquePtr $( tp1 )) |]

t_newUniquePtr :: Type -> String -> Q Exp
t_newUniquePtr typ1 suffix
  = mkTFunc (typ1, suffix, \ n -> "UniquePtr_new" <> n, tyf)
  where tyf _
          = let tp1 = pure typ1 in [t| $( tp1 ) -> IO (UniquePtr $( tp1 )) |]

t_get :: Type -> String -> Q Exp
t_get typ1 suffix
  = mkTFunc (typ1, suffix, \ n -> "UniquePtr_get" <> n, tyf)
  where tyf _
          = let tp1 = pure typ1 in [t| UniquePtr $( tp1 ) -> IO $( tp1 ) |]

t_release :: Type -> String -> Q Exp
t_release typ1 suffix
  = mkTFunc (typ1, suffix, \ n -> "UniquePtr_release" <> n, tyf)
  where tyf _
          = let tp1 = pure typ1 in [t| UniquePtr $( tp1 ) -> IO $( tp1 ) |]

t_reset :: Type -> String -> Q Exp
t_reset typ1 suffix
  = mkTFunc (typ1, suffix, \ n -> "UniquePtr_reset" <> n, tyf)
  where tyf _
          = let tp1 = pure typ1 in [t| UniquePtr $( tp1 ) -> IO () |]

t_deleteUniquePtr :: Type -> String -> Q Exp
t_deleteUniquePtr typ1 suffix
  = mkTFunc (typ1, suffix, \ n -> "UniquePtr_delete" <> n, tyf)
  where tyf _
          = let tp1 = pure typ1 in [t| UniquePtr $( tp1 ) -> IO () |]

genUniquePtrInstanceFor ::
                        IsCPrimitive -> (Q Type, TemplateParamInfo) -> Q [Dec]
genUniquePtrInstanceFor isCprim (qtyp1, param1)
  = do let params = map tpinfoSuffix [param1]
       let suffix = concatMap (\ x -> "_" ++ tpinfoSuffix x) [param1]
       callmod_ <- fmap loc_module location
       let callmod = dot2_ callmod_
       typ1 <- qtyp1
       f1 <- mkNew "newUniquePtr0" t_newUniquePtr0 typ1 suffix
       f2 <- mkNew "newUniquePtr" t_newUniquePtr typ1 suffix
       f3 <- mkMember "get" t_get typ1 suffix
       f4 <- mkMember "release" t_release typ1 suffix
       f5 <- mkMember "reset" t_reset typ1 suffix
       f6 <- mkDelete "deleteUniquePtr" t_deleteUniquePtr typ1 suffix
       addModFinalizer
         (addForeignSource LangCxx
            ("\n#include \"MacroPatternMatch.h\"\n\n\n#include \"memory\"\n\n\n#define UniquePtr_newUniquePtr0(callmod, tp1) \\\nextern \"C\" {\\\nvoid* UniquePtr_newUniquePtr0_##tp1 (  );}\\\ninline void* UniquePtr_newUniquePtr0_##tp1 (  ) {\\\nreturn static_cast<void*>(new std::unique_ptr<tp1>());\\\n}\\\nauto a_##callmod##_UniquePtr_newUniquePtr0_##tp1=UniquePtr_newUniquePtr0_##tp1;\n\n\n#define UniquePtr_new(callmod, tp1) \\\nextern \"C\" {\\\nvoid* UniquePtr_new_##tp1 ( tp1##_p p );}\\\ninline void* UniquePtr_new_##tp1 ( tp1##_p p ) {\\\nreturn static_cast<void*>(new std::unique_ptr<tp1>(from_nonconst_to_nonconst<tp1, tp1##_t>(p)));\\\n}\\\nauto a_##callmod##_UniquePtr_new_##tp1=UniquePtr_new_##tp1;\n\n\n#define UniquePtr_get(callmod, tp1) \\\nextern \"C\" {\\\ntp1##_p UniquePtr_get_##tp1 ( void* p );}\\\ninline tp1##_p UniquePtr_get_##tp1 ( void* p ) {\\\nreturn from_nonconst_to_nonconst<tp1##_t, tp1>((static_cast<std::unique_ptr<tp1>*>(p))->get());\\\n}\\\nauto a_##callmod##_UniquePtr_get_##tp1=UniquePtr_get_##tp1;\n\n\n#define UniquePtr_release(callmod, tp1) \\\nextern \"C\" {\\\ntp1##_p UniquePtr_release_##tp1 ( void* p );}\\\ninline tp1##_p UniquePtr_release_##tp1 ( void* p ) {\\\nreturn from_nonconst_to_nonconst<tp1##_t, tp1>((static_cast<std::unique_ptr<tp1>*>(p))->release());\\\n}\\\nauto a_##callmod##_UniquePtr_release_##tp1=UniquePtr_release_##tp1;\n\n\n#define UniquePtr_reset(callmod, tp1) \\\nextern \"C\" {\\\nvoid UniquePtr_reset_##tp1 ( void* p );}\\\ninline void UniquePtr_reset_##tp1 ( void* p ) {\\\n(static_cast<std::unique_ptr<tp1>*>(p))->reset();\\\n}\\\nauto a_##callmod##_UniquePtr_reset_##tp1=UniquePtr_reset_##tp1;\n\n\n#define UniquePtr_delete(callmod, tp1) \\\nextern \"C\" {\\\nvoid UniquePtr_delete_##tp1 ( void* p );}\\\ninline void UniquePtr_delete_##tp1 ( void* p ) {\\\ndelete static_cast<std::unique_ptr<tp1>*>(p);\\\n}\\\nauto a_##callmod##_UniquePtr_delete_##tp1=UniquePtr_delete_##tp1;\n\n\n#define UniquePtr_newUniquePtr0_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid* UniquePtr_newUniquePtr0_##tp1 (  );}\\\ninline void* UniquePtr_newUniquePtr0_##tp1 (  ) {\\\nreturn static_cast<void*>(new std::unique_ptr<tp1>());\\\n}\\\nauto a_##callmod##_UniquePtr_newUniquePtr0_##tp1=UniquePtr_newUniquePtr0_##tp1;\n\n\n#define UniquePtr_new_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid* UniquePtr_new_##tp1 ( tp1 p );}\\\ninline void* UniquePtr_new_##tp1 ( tp1 p ) {\\\nreturn static_cast<void*>(new std::unique_ptr<tp1>(p));\\\n}\\\nauto a_##callmod##_UniquePtr_new_##tp1=UniquePtr_new_##tp1;\n\n\n#define UniquePtr_get_s(callmod, tp1) \\\nextern \"C\" {\\\ntp1 UniquePtr_get_##tp1 ( void* p );}\\\ninline tp1 UniquePtr_get_##tp1 ( void* p ) {\\\nreturn (static_cast<std::unique_ptr<tp1>*>(p))->get();\\\n}\\\nauto a_##callmod##_UniquePtr_get_##tp1=UniquePtr_get_##tp1;\n\n\n#define UniquePtr_release_s(callmod, tp1) \\\nextern \"C\" {\\\ntp1 UniquePtr_release_##tp1 ( void* p );}\\\ninline tp1 UniquePtr_release_##tp1 ( void* p ) {\\\nreturn (static_cast<std::unique_ptr<tp1>*>(p))->release();\\\n}\\\nauto a_##callmod##_UniquePtr_release_##tp1=UniquePtr_release_##tp1;\n\n\n#define UniquePtr_reset_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid UniquePtr_reset_##tp1 ( void* p );}\\\ninline void UniquePtr_reset_##tp1 ( void* p ) {\\\n(static_cast<std::unique_ptr<tp1>*>(p))->reset();\\\n}\\\nauto a_##callmod##_UniquePtr_reset_##tp1=UniquePtr_reset_##tp1;\n\n\n#define UniquePtr_delete_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid UniquePtr_delete_##tp1 ( void* p );}\\\ninline void UniquePtr_delete_##tp1 ( void* p ) {\\\ndelete static_cast<std::unique_ptr<tp1>*>(p);\\\n}\\\nauto a_##callmod##_UniquePtr_delete_##tp1=UniquePtr_delete_##tp1;\n\n\n#define UniquePtr_instance(callmod, tp1) \\\nUniquePtr_newUniquePtr0(callmod, tp1)\\\nUniquePtr_new(callmod, tp1)\\\nUniquePtr_get(callmod, tp1)\\\nUniquePtr_release(callmod, tp1)\\\nUniquePtr_reset(callmod, tp1)\\\nUniquePtr_delete(callmod, tp1)\n\n\n#define UniquePtr_instance_s(callmod, tp1) \\\nUniquePtr_newUniquePtr0_s(callmod, tp1)\\\nUniquePtr_new_s(callmod, tp1)\\\nUniquePtr_get_s(callmod, tp1)\\\nUniquePtr_release_s(callmod, tp1)\\\nUniquePtr_reset_s(callmod, tp1)\\\nUniquePtr_delete_s(callmod, tp1)\n\n"
               ++
               let headers = concatMap tpinfoCxxHeaders [param1]
                   f x = renderCMacro (Include x)
                 in concatMap f headers
                 ++
                 let nss = concatMap tpinfoCxxNamespaces [param1]
                     f x = renderCStmt (UsingNamespace x)
                   in concatMap f nss
                   ++
                   "UniquePtr_instance" ++
                     (case isCprim of
                          CPrim -> "_s"
                          NonCPrim -> "")
                       ++ "(" ++ intercalate ", " (callmod : params) ++ ")\n"))
       let lst = [f1, f2, f3, f4, f5, f6]
       pure [mkInstance [] (AppT (con "IUniquePtr") typ1) lst]