diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,6 @@ +# Changelog for stdcxx + +## 0.7.0.0 + +- Initial Hackage release of stdcxx + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE diff --git a/csrc/STDCppString.cpp b/csrc/STDCppString.cpp new file mode 100644 --- /dev/null +++ b/csrc/STDCppString.cpp @@ -0,0 +1,23 @@ + +#include "MacroPatternMatch.h" + +#include "STDDeletable.h" + +#include "string" + +#include "STDCppString.h" + +using namespace std; + +#define CHECKPROTECT(x,y) FXIS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) + +#define TYPECASTMETHOD(cname,mname,oname) \ + FXIIF( CHECKPROTECT(cname,mname) ) ( \ + (from_nonconst_to_nonconst), \ + (from_nonconst_to_nonconst) ) + +DELETABLE_DEF_VIRT(string) +STRING_DEF_VIRT(string) +STRING_DEF_NONVIRT(string) +STRING_DEF_ACCESSOR(string) + diff --git a/csrc/STDCppString.h b/csrc/STDCppString.h new file mode 100644 --- /dev/null +++ b/csrc/STDCppString.h @@ -0,0 +1,63 @@ + +#ifdef __cplusplus +extern "C" { +#endif + +#pragma once + + +#include "stdcxxType.h" + +#include "STDDeletable.h" + + +#define STRING_DECL_VIRT(Type) \ + + + +#define STRING_DECL_NONVIRT(Type) \ +Type##_p Type##_newCppString ( const char* p );\ +const char* Type##_cppString_c_str ( Type##_p p );\ +string_p Type##_cppString_append ( Type##_p p, string_p str );\ +string_p Type##_cppString_erase ( Type##_p p ); + + +#define STRING_DECL_ACCESSOR(Type) \ + + + +#define STRING_DEF_VIRT(Type) \ + + + +#define STRING_DEF_NONVIRT(Type) \ +Type##_p Type##_newCppString ( const char* p ) {\ +Type* newp=new Type(p);return from_nonconst_to_nonconst(newp);\ +}\ +\ +const char* Type##_cppString_c_str ( Type##_p p ) {\ +return ((TYPECASTMETHOD(Type, cppString_c_str, string))(p))->c_str();\ +}\ +\ +string_p Type##_cppString_append ( Type##_p p, string_p str ) {\ +return from_nonconst_to_nonconst(&(((TYPECASTMETHOD(Type, cppString_append, string))(p))->append(from_nonconstref_to_nonconstref(*(str)))));\ +}\ +\ +string_p Type##_cppString_erase ( Type##_p p ) {\ +return from_nonconst_to_nonconst(&(((TYPECASTMETHOD(Type, cppString_erase, string))(p))->erase()));\ +} + + +#define STRING_DEF_ACCESSOR(Type) \ + + + +DELETABLE_DECL_VIRT(string) +STRING_DECL_VIRT(string) +STRING_DECL_NONVIRT(string) +STRING_DECL_ACCESSOR(string) + +#ifdef __cplusplus +} +#endif + diff --git a/csrc/STDDeletable.cpp b/csrc/STDDeletable.cpp new file mode 100644 --- /dev/null +++ b/csrc/STDDeletable.cpp @@ -0,0 +1,17 @@ + +#include "MacroPatternMatch.h" + +#include "STDDeletable.h" + + + +#define CHECKPROTECT(x,y) FXIS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) + +#define TYPECASTMETHOD(cname,mname,oname) \ + FXIIF( CHECKPROTECT(cname,mname) ) ( \ + (from_nonconst_to_nonconst), \ + (from_nonconst_to_nonconst) ) + +DELETABLE_DEF_NONVIRT(Deletable) +DELETABLE_DEF_ACCESSOR(Deletable) + diff --git a/csrc/STDDeletable.h b/csrc/STDDeletable.h new file mode 100644 --- /dev/null +++ b/csrc/STDDeletable.h @@ -0,0 +1,42 @@ + +#ifdef __cplusplus +extern "C" { +#endif + +#pragma once + + +#include "stdcxxType.h" + + +#define DELETABLE_DECL_VIRT(Type) \ +void Type##_delete ( Type##_p p ); + + +#define DELETABLE_DECL_NONVIRT(Type) \ + + + +#define DELETABLE_DECL_ACCESSOR(Type) \ + + + +#define DELETABLE_DEF_VIRT(Type) \ +void Type##_delete ( Type##_p p ) {\ +delete from_nonconst_to_nonconst(p);\ +} + + +#define DELETABLE_DEF_NONVIRT(Type) \ + + + +#define DELETABLE_DEF_ACCESSOR(Type) \ + + + + +#ifdef __cplusplus +} +#endif + diff --git a/csrc/STDOstream.cpp b/csrc/STDOstream.cpp new file mode 100644 --- /dev/null +++ b/csrc/STDOstream.cpp @@ -0,0 +1,18 @@ + +#include "MacroPatternMatch.h" + +#include "STDOstream.h" + + + +#define CHECKPROTECT(x,y) FXIS_PAREN(IS_ ## x ## _ ## y ## _PROTECTED) + +#define TYPECASTMETHOD(cname,mname,oname) \ + FXIIF( CHECKPROTECT(cname,mname) ) ( \ + (from_nonconst_to_nonconst), \ + (from_nonconst_to_nonconst) ) + +OSTREAM_DEF_VIRT(ostream) +OSTREAM_DEF_NONVIRT(ostream) +OSTREAM_DEF_ACCESSOR(ostream) + diff --git a/csrc/STDOstream.h b/csrc/STDOstream.h new file mode 100644 --- /dev/null +++ b/csrc/STDOstream.h @@ -0,0 +1,43 @@ + +#ifdef __cplusplus +extern "C" { +#endif + +#pragma once + + +#include "stdcxxType.h" + + +#define OSTREAM_DECL_VIRT(Type) \ + + + +#define OSTREAM_DECL_NONVIRT(Type) \ + + + +#define OSTREAM_DECL_ACCESSOR(Type) \ + + + +#define OSTREAM_DEF_VIRT(Type) \ + + + +#define OSTREAM_DEF_NONVIRT(Type) \ + + + +#define OSTREAM_DEF_ACCESSOR(Type) \ + + + +OSTREAM_DECL_VIRT(ostream) +OSTREAM_DECL_NONVIRT(ostream) +OSTREAM_DECL_ACCESSOR(ostream) + +#ifdef __cplusplus +} +#endif + diff --git a/csrc/stdcxxType.h b/csrc/stdcxxType.h new file mode 100644 --- /dev/null +++ b/csrc/stdcxxType.h @@ -0,0 +1,17 @@ + +#ifdef __cplusplus +extern "C" { +#endif + +#pragma once + +// Opaque type definition for $classname +typedef struct Deletable_tag Deletable_t;typedef Deletable_t * Deletable_p;typedef Deletable_t const* const_Deletable_p; +// Opaque type definition for $classname +typedef struct ostream_tag ostream_t;typedef ostream_t * ostream_p;typedef ostream_t const* const_ostream_p; +// Opaque type definition for $classname +typedef struct string_tag string_t;typedef string_t * string_p;typedef string_t const* const_string_p; +#ifdef __cplusplus +} +#endif + diff --git a/src/STD.hs b/src/STD.hs new file mode 100644 --- /dev/null +++ b/src/STD.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI #-} +module STD + (module STD.Deletable, module STD.Ostream, module STD.CppString, + module STD.Ordinary, module STD.Template, module STD.TH) + where +import STD.Deletable +import STD.Ostream +import STD.CppString +import STD.Template +import STD.TH +import STD.Ordinary diff --git a/src/STD/CppString.hs b/src/STD/CppString.hs new file mode 100644 --- /dev/null +++ b/src/STD/CppString.hs @@ -0,0 +1,7 @@ +module STD.CppString + (CppString(..), ICppString, upcastCppString, downcastCppString, + newCppString, cppString_c_str, cppString_append, cppString_erase) + where +import STD.CppString.RawType +import STD.CppString.Interface +import STD.CppString.Implementation diff --git a/src/STD/CppString/Cast.hs b/src/STD/CppString/Cast.hs new file mode 100644 --- /dev/null +++ b/src/STD/CppString/Cast.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} +module STD.CppString.Cast where +import Foreign.Ptr +import FFICXX.Runtime.Cast +import System.IO.Unsafe +import STD.CppString.RawType +import STD.CppString.Interface + +instance (ICppString a, FPtr a) => Castable (a) (Ptr RawCppString) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) + +instance () => Castable (CppString) (Ptr RawCppString) where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/STD/CppString/FFI.hsc b/src/STD/CppString/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/STD/CppString/FFI.hsc @@ -0,0 +1,27 @@ +{-# LANGUAGE ForeignFunctionInterface, InterruptibleFFI #-} +module STD.CppString.FFI where +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import STD.CppString.RawType +import STD.CppString.RawType + +foreign import ccall interruptible "STDCppString.h string_delete" + c_string_delete :: Ptr RawCppString -> IO () + +foreign import ccall interruptible + "STDCppString.h string_newCppString" c_string_newcppstring :: + CString -> IO (Ptr RawCppString) + +foreign import ccall interruptible + "STDCppString.h string_cppString_c_str" c_string_cppstring_c_str :: + Ptr RawCppString -> IO CString + +foreign import ccall interruptible + "STDCppString.h string_cppString_append" c_string_cppstring_append + :: Ptr RawCppString -> Ptr RawCppString -> IO (Ptr RawCppString) + +foreign import ccall interruptible + "STDCppString.h string_cppString_erase" c_string_cppstring_erase :: + Ptr RawCppString -> IO (Ptr RawCppString) diff --git a/src/STD/CppString/Implementation.hs b/src/STD/CppString/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/STD/CppString/Implementation.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TemplateHaskell, + TypeFamilies, TypeSynonymInstances #-} +module STD.CppString.Implementation where +import Data.Monoid +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import System.IO.Unsafe +import FFICXX.Runtime.Cast +import FFICXX.Runtime.CodeGen.Cxx +import FFICXX.Runtime.TH +import STD.CppString.RawType +import STD.CppString.FFI +import STD.CppString.Interface +import STD.CppString.Cast +import STD.CppString.RawType +import STD.CppString.Cast +import STD.CppString.Interface +import STD.Deletable.RawType +import STD.Deletable.Cast +import STD.Deletable.Interface + +instance () => ICppString (CppString) where + +instance () => IDeletable (CppString) where + delete = xform0 c_string_delete + +newCppString :: (Castable c0 CString) => c0 -> IO CppString +newCppString = xform0 c_string_newcppstring + +cppString_c_str :: () => CppString -> IO CString +cppString_c_str = xform0 c_string_cppstring_c_str + +cppString_append :: + (ICppString c0, FPtr c0) => CppString -> c0 -> IO CppString +cppString_append = xform1 c_string_cppstring_append + +cppString_erase :: () => CppString -> IO CppString +cppString_erase = xform0 c_string_cppstring_erase diff --git a/src/STD/CppString/Interface.hs b/src/STD/CppString/Interface.hs new file mode 100644 --- /dev/null +++ b/src/STD/CppString/Interface.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} +module STD.CppString.Interface where +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import FFICXX.Runtime.Cast +import STD.CppString.RawType +import STD.Deletable.Interface + +class (IDeletable a) => ICppString a where + +upcastCppString :: + forall a . (FPtr a, ICppString a) => a -> CppString +upcastCppString h + = let fh = get_fptr h + fh2 :: Ptr RawCppString = castPtr fh + in cast_fptr_to_obj fh2 + +downcastCppString :: + forall a . (FPtr a, ICppString a) => CppString -> a +downcastCppString h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/STD/CppString/RawType.hs b/src/STD/CppString/RawType.hs new file mode 100644 --- /dev/null +++ b/src/STD/CppString/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} +module STD.CppString.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast + +data RawCppString + +newtype CppString = CppString (Ptr RawCppString) + deriving (Eq, Ord, Show) + +instance () => FPtr (CppString) where + type Raw CppString = RawCppString + get_fptr (CppString ptr) = ptr + cast_fptr_to_obj = CppString diff --git a/src/STD/Deletable.hs b/src/STD/Deletable.hs new file mode 100644 --- /dev/null +++ b/src/STD/Deletable.hs @@ -0,0 +1,4 @@ +module STD.Deletable (IDeletable(..)) where +import STD.Deletable.RawType +import STD.Deletable.Interface +import STD.Deletable.Implementation diff --git a/src/STD/Deletable/Cast.hs b/src/STD/Deletable/Cast.hs new file mode 100644 --- /dev/null +++ b/src/STD/Deletable/Cast.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} +module STD.Deletable.Cast where +import Foreign.Ptr +import FFICXX.Runtime.Cast +import System.IO.Unsafe +import STD.Deletable.RawType +import STD.Deletable.Interface diff --git a/src/STD/Deletable/FFI.hsc b/src/STD/Deletable/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/STD/Deletable/FFI.hsc @@ -0,0 +1,8 @@ +{-# LANGUAGE ForeignFunctionInterface, InterruptibleFFI #-} +module STD.Deletable.FFI where +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import STD.Deletable.RawType +import STD.Deletable.RawType diff --git a/src/STD/Deletable/Implementation.hs b/src/STD/Deletable/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/STD/Deletable/Implementation.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TemplateHaskell, + TypeFamilies, TypeSynonymInstances #-} +module STD.Deletable.Implementation where +import Data.Monoid +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import System.IO.Unsafe +import FFICXX.Runtime.Cast +import FFICXX.Runtime.CodeGen.Cxx +import FFICXX.Runtime.TH +import STD.Deletable.RawType +import STD.Deletable.FFI +import STD.Deletable.Interface +import STD.Deletable.Cast +import STD.Deletable.RawType +import STD.Deletable.Cast +import STD.Deletable.Interface diff --git a/src/STD/Deletable/Interface.hs b/src/STD/Deletable/Interface.hs new file mode 100644 --- /dev/null +++ b/src/STD/Deletable/Interface.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} +module STD.Deletable.Interface where +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import FFICXX.Runtime.Cast +import STD.Deletable.RawType + +class () => IDeletable a where + delete :: () => a -> IO () diff --git a/src/STD/Deletable/RawType.hs b/src/STD/Deletable/RawType.hs new file mode 100644 --- /dev/null +++ b/src/STD/Deletable/RawType.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} +module STD.Deletable.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast diff --git a/src/STD/Map/TH.hs b/src/STD/Map/TH.hs new file mode 100644 --- /dev/null +++ b/src/STD/Map/TH.hs @@ -0,0 +1,102 @@ +{-# 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 (typ1, typ2) suffix + = mkTFunc ((typ1, typ2), suffix, \ n -> "Map_new" <> n, tyf) + where tyf _ + = let tpk = pure typ1 + tpv = pure typ2 + in [t| IO (Map $( tpk ) $( tpv )) |] + +t_begin :: (Type, Type) -> String -> Q Exp +t_begin (typ1, typ2) suffix + = mkTFunc ((typ1, typ2), suffix, \ n -> "Map_begin" <> n, tyf) + where tyf _ + = let tpk = pure typ1 + tpv = pure typ2 + in + [t| Map $( tpk ) $( tpv ) -> IO (MapIterator $( tpk ) $( tpv )) |] + +t_end :: (Type, Type) -> String -> Q Exp +t_end (typ1, typ2) suffix + = mkTFunc ((typ1, typ2), suffix, \ n -> "Map_end" <> n, tyf) + where tyf _ + = let tpk = pure typ1 + tpv = pure typ2 + in + [t| Map $( tpk ) $( tpv ) -> IO (MapIterator $( tpk ) $( tpv )) |] + +t_insert :: (Type, Type) -> String -> Q Exp +t_insert (typ1, typ2) suffix + = mkTFunc ((typ1, typ2), suffix, \ n -> "Map_insert" <> n, tyf) + where tyf _ + = let tpk = pure typ1 + tpv = pure typ2 + in [t| Map $( tpk ) $( tpv ) -> Pair $( tpk ) $( tpv ) -> IO () |] + +t_size :: (Type, Type) -> String -> Q Exp +t_size (typ1, typ2) suffix + = mkTFunc ((typ1, typ2), suffix, \ n -> "Map_size" <> n, tyf) + where tyf _ + = let tpk = pure typ1 + tpv = pure typ2 + in [t| Map $( tpk ) $( tpv ) -> IO CInt |] + +t_deleteMap :: (Type, Type) -> String -> Q Exp +t_deleteMap (typ1, typ2) suffix + = mkTFunc ((typ1, typ2), suffix, \ n -> "Map_delete" <> n, tyf) + where tyf _ + = let tpk = pure typ1 + tpv = pure typ2 + in [t| Map $( tpk ) $( tpv ) -> IO () |] + +genMapInstanceFor :: + IsCPrimitive -> + (Q Type, TemplateParamInfo) -> + (Q Type, TemplateParamInfo) -> Q [Dec] +genMapInstanceFor isCprim (qtyp1, param1) (qtyp2, param2) + = do let params = map tpinfoSuffix [param1, param2] + let suffix + = concatMap (\ x -> "_" ++ tpinfoSuffix x) [param1, param2] + callmod_ <- fmap loc_module location + let callmod = dot2_ callmod_ + typ1 <- qtyp1 + typ2 <- qtyp2 + f1 <- mkNew "newMap" t_newMap (typ1, typ2) suffix + f2 <- mkMember "begin" t_begin (typ1, typ2) suffix + f3 <- mkMember "end" t_end (typ1, typ2) suffix + f4 <- mkMember "insert" t_insert (typ1, typ2) suffix + f5 <- mkMember "size" t_size (typ1, typ2) suffix + f6 <- mkDelete "deleteMap" t_deleteMap (typ1, typ2) suffix + addModFinalizer + (addForeignSource LangCxx + ("\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(new std::map());\\\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::iterator* r=new std::map::iterator((static_cast*>(p))->begin());return static_cast(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::iterator* r=new std::map::iterator((static_cast*>(p))->end());return static_cast(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*>(p))->insert(std::move(*(static_cast*>(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*>(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*>(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(new std::map());\\\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::iterator* r=new std::map::iterator((static_cast*>(p))->begin());return static_cast(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::iterator* r=new std::map::iterator((static_cast*>(p))->end());return static_cast(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*>(p))->insert(std::move(*(static_cast*>(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*>(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*>(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" + ++ + let headers = concatMap tpinfoCxxHeaders [param1, param2] + f x = renderCMacro (Include x) + in concatMap f headers + ++ + let nss = concatMap tpinfoCxxNamespaces [param1, param2] + f x = renderCStmt (UsingNamespace x) + in concatMap f nss + ++ + "Map_instance" ++ + (case isCprim of + CPrim -> "_s" + NonCPrim -> "") + ++ "(" ++ intercalate ", " (callmod : params) ++ ")\n")) + let lst = [f1, f2, f3, f4, f5, f6] + pure [mkInstance [] (AppT (AppT (con "IMap") typ1) typ2) lst] diff --git a/src/STD/Map/Template.hs b/src/STD/Map/Template.hs new file mode 100644 --- /dev/null +++ b/src/STD/Map/Template.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleInstances, + MultiParamTypeClasses, TypeFamilies #-} +module STD.Map.Template where +import Foreign.C.Types +import Foreign.Ptr +import FFICXX.Runtime.Cast +import STD.MapIterator.Template +import STD.Pair.Template + +data RawMap tpk tpv + +newtype Map tpk tpv = Map (Ptr (RawMap tpk tpv)) + +class () => IMap tpk tpv where + newMap :: IO (Map tpk tpv) + + begin :: Map tpk tpv -> IO (MapIterator tpk tpv) + + end :: Map tpk tpv -> IO (MapIterator tpk tpv) + + insert :: Map tpk tpv -> Pair tpk tpv -> IO () + + size :: Map tpk tpv -> IO CInt + + deleteMap :: Map tpk tpv -> IO () + +instance () => FPtr (Map tpk tpv) where + type Raw (Map tpk tpv) = RawMap tpk tpv + get_fptr (Map ptr) = ptr + cast_fptr_to_obj = Map + +instance () => Castable (Map tpk tpv) (Ptr (RawMap tpk tpv)) where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/STD/MapIterator/TH.hs b/src/STD/MapIterator/TH.hs new file mode 100644 --- /dev/null +++ b/src/STD/MapIterator/TH.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE TemplateHaskell #-} +module STD.MapIterator.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.MapIterator.Template +import STD.Pair.Template + +t_deRef :: (Type, Type) -> String -> Q Exp +t_deRef (typ1, typ2) suffix + = mkTFunc + ((typ1, typ2), suffix, \ n -> "MapIterator_deRef" <> n, tyf) + where tyf _ + = let tpk = pure typ1 + tpv = pure typ2 + in + [t| MapIterator $( tpk ) $( tpv ) -> IO (Pair $( tpk ) $( tpv )) |] + +t_increment :: (Type, Type) -> String -> Q Exp +t_increment (typ1, typ2) suffix + = mkTFunc + ((typ1, typ2), suffix, \ n -> "MapIterator_increment" <> n, tyf) + where tyf _ + = let tpk = pure typ1 + tpv = pure typ2 + in + [t| + MapIterator $( tpk ) $( tpv ) -> IO (MapIterator $( tpk ) $( tpv )) + |] + +genMapIteratorInstanceFor :: + IsCPrimitive -> + (Q Type, TemplateParamInfo) -> + (Q Type, TemplateParamInfo) -> Q [Dec] +genMapIteratorInstanceFor isCprim (qtyp1, param1) (qtyp2, param2) + = do let params = map tpinfoSuffix [param1, param2] + let suffix + = concatMap (\ x -> "_" ++ tpinfoSuffix x) [param1, param2] + callmod_ <- fmap loc_module location + let callmod = dot2_ callmod_ + typ1 <- qtyp1 + typ2 <- qtyp2 + f1 <- mkMember "deRef" t_deRef (typ1, typ2) suffix + f2 <- mkMember "increment" t_increment (typ1, typ2) suffix + addModFinalizer + (addForeignSource LangCxx + ("\n#include \"MacroPatternMatch.h\"\n\n\n#include \"map\"\n\n\n#define MapIterator_deRef(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* MapIterator_deRef_##tpk##_##tpv ( void* p );}\\\ninline void* MapIterator_deRef_##tpk##_##tpv ( void* p ) {\\\nstd::pair* r=new std::pair((static_cast::iterator*>(p))->operator*());return static_cast(r);\\\n}\\\nauto a_##callmod##_MapIterator_deRef_##tpk##_##tpv=MapIterator_deRef_##tpk##_##tpv;\n\n\n#define MapIterator_increment(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* MapIterator_increment_##tpk##_##tpv ( void* p );}\\\ninline void* MapIterator_increment_##tpk##_##tpv ( void* p ) {\\\nstd::map::iterator* r=new std::map::iterator((static_cast::iterator*>(p))->operator++());return static_cast(r);\\\n}\\\nauto a_##callmod##_MapIterator_increment_##tpk##_##tpv=MapIterator_increment_##tpk##_##tpv;\n\n\n#define MapIterator_deRef_s(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* MapIterator_deRef_##tpk##_##tpv ( void* p );}\\\ninline void* MapIterator_deRef_##tpk##_##tpv ( void* p ) {\\\nstd::pair* r=new std::pair((static_cast::iterator*>(p))->operator*());return static_cast(r);\\\n}\\\nauto a_##callmod##_MapIterator_deRef_##tpk##_##tpv=MapIterator_deRef_##tpk##_##tpv;\n\n\n#define MapIterator_increment_s(callmod, tpk, tpv) \\\nextern \"C\" {\\\nvoid* MapIterator_increment_##tpk##_##tpv ( void* p );}\\\ninline void* MapIterator_increment_##tpk##_##tpv ( void* p ) {\\\nstd::map::iterator* r=new std::map::iterator((static_cast::iterator*>(p))->operator++());return static_cast(r);\\\n}\\\nauto a_##callmod##_MapIterator_increment_##tpk##_##tpv=MapIterator_increment_##tpk##_##tpv;\n\n\n#define MapIterator_instance(callmod, tpk, tpv) \\\nMapIterator_deRef(callmod, tpk, tpv)\\\nMapIterator_increment(callmod, tpk, tpv)\n\n\n#define MapIterator_instance_s(callmod, tpk, tpv) \\\nMapIterator_deRef_s(callmod, tpk, tpv)\\\nMapIterator_increment_s(callmod, tpk, tpv)\n\n" + ++ + let headers = concatMap tpinfoCxxHeaders [param1, param2] + f x = renderCMacro (Include x) + in concatMap f headers + ++ + let nss = concatMap tpinfoCxxNamespaces [param1, param2] + f x = renderCStmt (UsingNamespace x) + in concatMap f nss + ++ + "MapIterator_instance" ++ + (case isCprim of + CPrim -> "_s" + NonCPrim -> "") + ++ "(" ++ intercalate ", " (callmod : params) ++ ")\n")) + let lst = [f1, f2] + pure + [mkInstance [] (AppT (AppT (con "IMapIterator") typ1) typ2) lst] diff --git a/src/STD/MapIterator/Template.hs b/src/STD/MapIterator/Template.hs new file mode 100644 --- /dev/null +++ b/src/STD/MapIterator/Template.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleInstances, + MultiParamTypeClasses, TypeFamilies #-} +module STD.MapIterator.Template where +import Foreign.C.Types +import Foreign.Ptr +import FFICXX.Runtime.Cast +import STD.Pair.Template + +data RawMapIterator tpk tpv + +newtype MapIterator tpk tpv = MapIterator (Ptr + (RawMapIterator tpk tpv)) + +class () => IMapIterator tpk tpv where + deRef :: MapIterator tpk tpv -> IO (Pair tpk tpv) + + increment :: MapIterator tpk tpv -> IO (MapIterator tpk tpv) + +instance () => FPtr (MapIterator tpk tpv) where + type Raw (MapIterator tpk tpv) = RawMapIterator tpk tpv + get_fptr (MapIterator ptr) = ptr + cast_fptr_to_obj = MapIterator + +instance () => + Castable (MapIterator tpk tpv) (Ptr (RawMapIterator tpk tpv)) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/STD/Ordinary.hs b/src/STD/Ordinary.hs new file mode 100644 --- /dev/null +++ b/src/STD/Ordinary.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI #-} +module STD.Ordinary () where +import Foreign.C +import Foreign.Ptr +import FFICXX.Runtime.Cast +import STD.Pair.Template +import STD.Map.Template +import STD.MapIterator.Template +import STD.Vector.Template +import STD.VectorIterator.Template +import STD.UniquePtr.Template +import STD.SharedPtr.Template diff --git a/src/STD/Ostream.hs b/src/STD/Ostream.hs new file mode 100644 --- /dev/null +++ b/src/STD/Ostream.hs @@ -0,0 +1,5 @@ +module STD.Ostream + (Ostream(..), IOstream, upcastOstream, downcastOstream) where +import STD.Ostream.RawType +import STD.Ostream.Interface +import STD.Ostream.Implementation diff --git a/src/STD/Ostream/Cast.hs b/src/STD/Ostream/Cast.hs new file mode 100644 --- /dev/null +++ b/src/STD/Ostream/Cast.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeFamilies, + MultiParamTypeClasses, OverlappingInstances, IncoherentInstances + #-} +module STD.Ostream.Cast where +import Foreign.Ptr +import FFICXX.Runtime.Cast +import System.IO.Unsafe +import STD.Ostream.RawType +import STD.Ostream.Interface + +instance (IOstream a, FPtr a) => Castable (a) (Ptr RawOstream) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) + +instance () => Castable (Ostream) (Ptr RawOstream) where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/STD/Ostream/FFI.hsc b/src/STD/Ostream/FFI.hsc new file mode 100644 --- /dev/null +++ b/src/STD/Ostream/FFI.hsc @@ -0,0 +1,8 @@ +{-# LANGUAGE ForeignFunctionInterface, InterruptibleFFI #-} +module STD.Ostream.FFI where +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import STD.Ostream.RawType +import STD.Ostream.RawType diff --git a/src/STD/Ostream/Implementation.hs b/src/STD/Ostream/Implementation.hs new file mode 100644 --- /dev/null +++ b/src/STD/Ostream/Implementation.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, IncoherentInstances, + MultiParamTypeClasses, OverlappingInstances, TemplateHaskell, + TypeFamilies, TypeSynonymInstances #-} +module STD.Ostream.Implementation where +import Data.Monoid +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import System.IO.Unsafe +import FFICXX.Runtime.Cast +import FFICXX.Runtime.CodeGen.Cxx +import FFICXX.Runtime.TH +import STD.Ostream.RawType +import STD.Ostream.FFI +import STD.Ostream.Interface +import STD.Ostream.Cast +import STD.Ostream.RawType +import STD.Ostream.Cast +import STD.Ostream.Interface + +instance () => IOstream (Ostream) where diff --git a/src/STD/Ostream/Interface.hs b/src/STD/Ostream/Interface.hs new file mode 100644 --- /dev/null +++ b/src/STD/Ostream/Interface.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE EmptyDataDecls, ExistentialQuantification, + FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, + MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, + TypeSynonymInstances #-} +module STD.Ostream.Interface where +import Data.Word +import Data.Int +import Foreign.C +import Foreign.Ptr +import FFICXX.Runtime.Cast +import STD.Ostream.RawType + +class () => IOstream a where + +upcastOstream :: forall a . (FPtr a, IOstream a) => a -> Ostream +upcastOstream h + = let fh = get_fptr h + fh2 :: Ptr RawOstream = castPtr fh + in cast_fptr_to_obj fh2 + +downcastOstream :: forall a . (FPtr a, IOstream a) => Ostream -> a +downcastOstream h + = let fh = get_fptr h + fh2 = castPtr fh + in cast_fptr_to_obj fh2 diff --git a/src/STD/Ostream/RawType.hs b/src/STD/Ostream/RawType.hs new file mode 100644 --- /dev/null +++ b/src/STD/Ostream/RawType.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, + MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, + EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables #-} +module STD.Ostream.RawType where +import Foreign.Ptr +import FFICXX.Runtime.Cast + +data RawOstream + +newtype Ostream = Ostream (Ptr RawOstream) + deriving (Eq, Ord, Show) + +instance () => FPtr (Ostream) where + type Raw Ostream = RawOstream + get_fptr (Ostream ptr) = ptr + cast_fptr_to_obj = Ostream diff --git a/src/STD/Pair/TH.hs b/src/STD/Pair/TH.hs new file mode 100644 --- /dev/null +++ b/src/STD/Pair/TH.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE TemplateHaskell #-} +module STD.Pair.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.Pair.Template + +t_newPair :: (Type, Type) -> String -> Q Exp +t_newPair (typ1, typ2) suffix + = mkTFunc ((typ1, typ2), suffix, \ n -> "Pair_new" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 + tp2 = pure typ2 + in [t| $( tp1 ) -> $( tp2 ) -> IO (Pair $( tp1 ) $( tp2 )) |] + +t_deletePair :: (Type, Type) -> String -> Q Exp +t_deletePair (typ1, typ2) suffix + = mkTFunc ((typ1, typ2), suffix, \ n -> "Pair_delete" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 + tp2 = pure typ2 + in [t| Pair $( tp1 ) $( tp2 ) -> IO () |] + +t_first_get :: (Type, Type) -> String -> Q Exp +t_first_get (typ1, typ2) suffix + = mkTFunc ((typ1, typ2), suffix, \ n -> "Pair_first_get" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 + tp2 = pure typ2 + in [t| Pair $( tp1 ) $( tp2 ) -> IO $( tp1 ) |] + +t_first_set :: (Type, Type) -> String -> Q Exp +t_first_set (typ1, typ2) suffix + = mkTFunc ((typ1, typ2), suffix, \ n -> "Pair_first_set" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 + tp2 = pure typ2 + in [t| Pair $( tp1 ) $( tp2 ) -> $( tp1 ) -> IO () |] + +t_second_get :: (Type, Type) -> String -> Q Exp +t_second_get (typ1, typ2) suffix + = mkTFunc + ((typ1, typ2), suffix, \ n -> "Pair_second_get" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 + tp2 = pure typ2 + in [t| Pair $( tp1 ) $( tp2 ) -> IO $( tp2 ) |] + +t_second_set :: (Type, Type) -> String -> Q Exp +t_second_set (typ1, typ2) suffix + = mkTFunc + ((typ1, typ2), suffix, \ n -> "Pair_second_set" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 + tp2 = pure typ2 + in [t| Pair $( tp1 ) $( tp2 ) -> $( tp2 ) -> IO () |] + +genPairInstanceFor :: + IsCPrimitive -> + (Q Type, TemplateParamInfo) -> + (Q Type, TemplateParamInfo) -> Q [Dec] +genPairInstanceFor isCprim (qtyp1, param1) (qtyp2, param2) + = do let params = map tpinfoSuffix [param1, param2] + let suffix + = concatMap (\ x -> "_" ++ tpinfoSuffix x) [param1, param2] + callmod_ <- fmap loc_module location + let callmod = dot2_ callmod_ + typ1 <- qtyp1 + typ2 <- qtyp2 + f1 <- mkNew "newPair" t_newPair (typ1, typ2) suffix + f2 <- mkDelete "deletePair" t_deletePair (typ1, typ2) suffix + vf1 <- mkMember "first_get" t_first_get (typ1, typ2) suffix + vf2 <- mkMember "first_set" t_first_set (typ1, typ2) suffix + vf3 <- mkMember "second_get" t_second_get (typ1, typ2) suffix + vf4 <- mkMember "second_set" t_second_set (typ1, typ2) suffix + addModFinalizer + (addForeignSource LangCxx + ("\n#include \"MacroPatternMatch.h\"\n\n\n#include \"utility\"\n\n\n#define Pair_new(callmod, tp1, tp2) \\\nextern \"C\" {\\\nvoid* Pair_new_##tp1##_##tp2 ( tp1##_p x, tp2##_p y );}\\\ninline void* Pair_new_##tp1##_##tp2 ( tp1##_p x, tp2##_p y ) {\\\nreturn static_cast(new std::pair(*(from_nonconst_to_nonconst(x)), *(from_nonconst_to_nonconst(y))));\\\n}\\\nauto a_##callmod##_Pair_new_##tp1##_##tp2=Pair_new_##tp1##_##tp2;\n\n\n#define Pair_delete(callmod, tp1, tp2) \\\nextern \"C\" {\\\nvoid Pair_delete_##tp1##_##tp2 ( void* p );}\\\ninline void Pair_delete_##tp1##_##tp2 ( void* p ) {\\\ndelete static_cast*>(p);\\\n}\\\nauto a_##callmod##_Pair_delete_##tp1##_##tp2=Pair_delete_##tp1##_##tp2;\n\n\n#define Pair_new_s(callmod, tp1, tp2) \\\nextern \"C\" {\\\nvoid* Pair_new_##tp1##_##tp2 ( tp1 x, tp2 y );}\\\ninline void* Pair_new_##tp1##_##tp2 ( tp1 x, tp2 y ) {\\\nreturn static_cast(new std::pair(x, y));\\\n}\\\nauto a_##callmod##_Pair_new_##tp1##_##tp2=Pair_new_##tp1##_##tp2;\n\n\n#define Pair_delete_s(callmod, tp1, tp2) \\\nextern \"C\" {\\\nvoid Pair_delete_##tp1##_##tp2 ( void* p );}\\\ninline void Pair_delete_##tp1##_##tp2 ( void* p ) {\\\ndelete static_cast*>(p);\\\n}\\\nauto a_##callmod##_Pair_delete_##tp1##_##tp2=Pair_delete_##tp1##_##tp2;\n\n\n#define Pair_first_get(callmod, tp1, tp2) \\\nextern \"C\" {\\\ntp1##_p Pair_first_get_##tp1##_##tp2 ( void* p );}\\\ninline tp1##_p Pair_first_get_##tp1##_##tp2 ( void* p ) {\\\nreturn from_nonconst_to_nonconst((tp1*)&((static_cast*>(p))->first));\\\n}\\\nauto a_##callmod##_Pair_first_get_##tp1##_##tp2=Pair_first_get_##tp1##_##tp2;\n\n\n#define Pair_first_set(callmod, tp1, tp2) \\\nextern \"C\" {\\\nvoid Pair_first_set_##tp1##_##tp2 ( void* p, tp1##_p value );}\\\ninline void Pair_first_set_##tp1##_##tp2 ( void* p, tp1##_p value ) {\\\n((static_cast*>(p))->first)=value;\\\n}\\\nauto a_##callmod##_Pair_first_set_##tp1##_##tp2=Pair_first_set_##tp1##_##tp2;\n\n\n#define Pair_second_get(callmod, tp1, tp2) \\\nextern \"C\" {\\\ntp2##_p Pair_second_get_##tp1##_##tp2 ( void* p );}\\\ninline tp2##_p Pair_second_get_##tp1##_##tp2 ( void* p ) {\\\nreturn from_nonconst_to_nonconst((tp2*)&((static_cast*>(p))->second));\\\n}\\\nauto a_##callmod##_Pair_second_get_##tp1##_##tp2=Pair_second_get_##tp1##_##tp2;\n\n\n#define Pair_second_set(callmod, tp1, tp2) \\\nextern \"C\" {\\\nvoid Pair_second_set_##tp1##_##tp2 ( void* p, tp2##_p value );}\\\ninline void Pair_second_set_##tp1##_##tp2 ( void* p, tp2##_p value ) {\\\n((static_cast*>(p))->second)=value;\\\n}\\\nauto a_##callmod##_Pair_second_set_##tp1##_##tp2=Pair_second_set_##tp1##_##tp2;\n\n\n#define Pair_first_get_s(callmod, tp1, tp2) \\\nextern \"C\" {\\\ntp1 Pair_first_get_##tp1##_##tp2 ( void* p );}\\\ninline tp1 Pair_first_get_##tp1##_##tp2 ( void* p ) {\\\nreturn (static_cast*>(p))->first;\\\n}\\\nauto a_##callmod##_Pair_first_get_##tp1##_##tp2=Pair_first_get_##tp1##_##tp2;\n\n\n#define Pair_first_set_s(callmod, tp1, tp2) \\\nextern \"C\" {\\\nvoid Pair_first_set_##tp1##_##tp2 ( void* p, tp1 value );}\\\ninline void Pair_first_set_##tp1##_##tp2 ( void* p, tp1 value ) {\\\n((static_cast*>(p))->first)=value;\\\n}\\\nauto a_##callmod##_Pair_first_set_##tp1##_##tp2=Pair_first_set_##tp1##_##tp2;\n\n\n#define Pair_second_get_s(callmod, tp1, tp2) \\\nextern \"C\" {\\\ntp2 Pair_second_get_##tp1##_##tp2 ( void* p );}\\\ninline tp2 Pair_second_get_##tp1##_##tp2 ( void* p ) {\\\nreturn (static_cast*>(p))->second;\\\n}\\\nauto a_##callmod##_Pair_second_get_##tp1##_##tp2=Pair_second_get_##tp1##_##tp2;\n\n\n#define Pair_second_set_s(callmod, tp1, tp2) \\\nextern \"C\" {\\\nvoid Pair_second_set_##tp1##_##tp2 ( void* p, tp2 value );}\\\ninline void Pair_second_set_##tp1##_##tp2 ( void* p, tp2 value ) {\\\n((static_cast*>(p))->second)=value;\\\n}\\\nauto a_##callmod##_Pair_second_set_##tp1##_##tp2=Pair_second_set_##tp1##_##tp2;\n\n\n#define Pair_instance(callmod, tp1, tp2) \\\nPair_new(callmod, tp1, tp2)\\\nPair_delete(callmod, tp1, tp2)\\\nPair_first_get(callmod, tp1, tp2)\\\nPair_first_set(callmod, tp1, tp2)\\\nPair_second_get(callmod, tp1, tp2)\\\nPair_second_set(callmod, tp1, tp2)\n\n\n#define Pair_instance_s(callmod, tp1, tp2) \\\nPair_new_s(callmod, tp1, tp2)\\\nPair_delete_s(callmod, tp1, tp2)\\\nPair_first_get_s(callmod, tp1, tp2)\\\nPair_first_set_s(callmod, tp1, tp2)\\\nPair_second_get_s(callmod, tp1, tp2)\\\nPair_second_set_s(callmod, tp1, tp2)\n\n" + ++ + let headers = concatMap tpinfoCxxHeaders [param1, param2] + f x = renderCMacro (Include x) + in concatMap f headers + ++ + let nss = concatMap tpinfoCxxNamespaces [param1, param2] + f x = renderCStmt (UsingNamespace x) + in concatMap f nss + ++ + "Pair_instance" ++ + (case isCprim of + CPrim -> "_s" + NonCPrim -> "") + ++ "(" ++ intercalate ", " (callmod : params) ++ ")\n")) + let lst = [f1, f2, vf1, vf2, vf3, vf4] + pure [mkInstance [] (AppT (AppT (con "IPair") typ1) typ2) lst] diff --git a/src/STD/Pair/Template.hs b/src/STD/Pair/Template.hs new file mode 100644 --- /dev/null +++ b/src/STD/Pair/Template.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleInstances, + MultiParamTypeClasses, TypeFamilies #-} +module STD.Pair.Template where +import Foreign.C.Types +import Foreign.Ptr +import FFICXX.Runtime.Cast + +data RawPair tp1 tp2 + +newtype Pair tp1 tp2 = Pair (Ptr (RawPair tp1 tp2)) + +class () => IPair tp1 tp2 where + newPair :: tp1 -> tp2 -> IO (Pair tp1 tp2) + + deletePair :: Pair tp1 tp2 -> IO () + + first_get :: Pair tp1 tp2 -> IO tp1 + + first_set :: Pair tp1 tp2 -> tp1 -> IO () + + second_get :: Pair tp1 tp2 -> IO tp2 + + second_set :: Pair tp1 tp2 -> tp2 -> IO () + +instance () => FPtr (Pair tp1 tp2) where + type Raw (Pair tp1 tp2) = RawPair tp1 tp2 + get_fptr (Pair ptr) = ptr + cast_fptr_to_obj = Pair + +instance () => Castable (Pair tp1 tp2) (Ptr (RawPair tp1 tp2)) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/STD/SharedPtr/TH.hs b/src/STD/SharedPtr/TH.hs new file mode 100644 --- /dev/null +++ b/src/STD/SharedPtr/TH.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE TemplateHaskell #-} +module STD.SharedPtr.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.SharedPtr.Template + +t_newSharedPtr0 :: Type -> String -> Q Exp +t_newSharedPtr0 typ1 suffix + = mkTFunc + (typ1, suffix, \ n -> "SharedPtr_newSharedPtr0" <> n, tyf) + where tyf _ = let tp1 = pure typ1 in [t| IO (SharedPtr $( tp1 )) |] + +t_newSharedPtr :: Type -> String -> Q Exp +t_newSharedPtr typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "SharedPtr_new" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in [t| $( tp1 ) -> IO (SharedPtr $( tp1 )) |] + +t_get :: Type -> String -> Q Exp +t_get typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "SharedPtr_get" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in [t| SharedPtr $( tp1 ) -> IO $( tp1 ) |] + +t_reset :: Type -> String -> Q Exp +t_reset typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "SharedPtr_reset" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in [t| SharedPtr $( tp1 ) -> IO () |] + +t_use_count :: Type -> String -> Q Exp +t_use_count typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "SharedPtr_use_count" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in [t| SharedPtr $( tp1 ) -> IO CInt |] + +t_deleteSharedPtr :: Type -> String -> Q Exp +t_deleteSharedPtr typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "SharedPtr_delete" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in [t| SharedPtr $( tp1 ) -> IO () |] + +genSharedPtrInstanceFor :: + IsCPrimitive -> (Q Type, TemplateParamInfo) -> Q [Dec] +genSharedPtrInstanceFor 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 "newSharedPtr0" t_newSharedPtr0 typ1 suffix + f2 <- mkNew "newSharedPtr" t_newSharedPtr typ1 suffix + f3 <- mkMember "get" t_get typ1 suffix + f4 <- mkMember "reset" t_reset typ1 suffix + f5 <- mkMember "use_count" t_use_count typ1 suffix + f6 <- mkDelete "deleteSharedPtr" t_deleteSharedPtr typ1 suffix + addModFinalizer + (addForeignSource LangCxx + ("\n#include \"MacroPatternMatch.h\"\n\n\n#include \"memory\"\n\n\n#define SharedPtr_newSharedPtr0(callmod, tp1) \\\nextern \"C\" {\\\nvoid* SharedPtr_newSharedPtr0_##tp1 ( );}\\\ninline void* SharedPtr_newSharedPtr0_##tp1 ( ) {\\\nreturn static_cast(new std::shared_ptr());\\\n}\\\nauto a_##callmod##_SharedPtr_newSharedPtr0_##tp1=SharedPtr_newSharedPtr0_##tp1;\n\n\n#define SharedPtr_new(callmod, tp1) \\\nextern \"C\" {\\\nvoid* SharedPtr_new_##tp1 ( tp1##_p p );}\\\ninline void* SharedPtr_new_##tp1 ( tp1##_p p ) {\\\nreturn static_cast(new std::shared_ptr(from_nonconst_to_nonconst(p)));\\\n}\\\nauto a_##callmod##_SharedPtr_new_##tp1=SharedPtr_new_##tp1;\n\n\n#define SharedPtr_get(callmod, tp1) \\\nextern \"C\" {\\\ntp1##_p SharedPtr_get_##tp1 ( void* p );}\\\ninline tp1##_p SharedPtr_get_##tp1 ( void* p ) {\\\nreturn from_nonconst_to_nonconst((static_cast*>(p))->get());\\\n}\\\nauto a_##callmod##_SharedPtr_get_##tp1=SharedPtr_get_##tp1;\n\n\n#define SharedPtr_reset(callmod, tp1) \\\nextern \"C\" {\\\nvoid SharedPtr_reset_##tp1 ( void* p );}\\\ninline void SharedPtr_reset_##tp1 ( void* p ) {\\\n(static_cast*>(p))->reset();\\\n}\\\nauto a_##callmod##_SharedPtr_reset_##tp1=SharedPtr_reset_##tp1;\n\n\n#define SharedPtr_use_count(callmod, tp1) \\\nextern \"C\" {\\\nint SharedPtr_use_count_##tp1 ( void* p );}\\\ninline int SharedPtr_use_count_##tp1 ( void* p ) {\\\nreturn (static_cast*>(p))->use_count();\\\n}\\\nauto a_##callmod##_SharedPtr_use_count_##tp1=SharedPtr_use_count_##tp1;\n\n\n#define SharedPtr_delete(callmod, tp1) \\\nextern \"C\" {\\\nvoid SharedPtr_delete_##tp1 ( void* p );}\\\ninline void SharedPtr_delete_##tp1 ( void* p ) {\\\ndelete static_cast*>(p);\\\n}\\\nauto a_##callmod##_SharedPtr_delete_##tp1=SharedPtr_delete_##tp1;\n\n\n#define SharedPtr_newSharedPtr0_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid* SharedPtr_newSharedPtr0_##tp1 ( );}\\\ninline void* SharedPtr_newSharedPtr0_##tp1 ( ) {\\\nreturn static_cast(new std::shared_ptr());\\\n}\\\nauto a_##callmod##_SharedPtr_newSharedPtr0_##tp1=SharedPtr_newSharedPtr0_##tp1;\n\n\n#define SharedPtr_new_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid* SharedPtr_new_##tp1 ( tp1 p );}\\\ninline void* SharedPtr_new_##tp1 ( tp1 p ) {\\\nreturn static_cast(new std::shared_ptr(p));\\\n}\\\nauto a_##callmod##_SharedPtr_new_##tp1=SharedPtr_new_##tp1;\n\n\n#define SharedPtr_get_s(callmod, tp1) \\\nextern \"C\" {\\\ntp1 SharedPtr_get_##tp1 ( void* p );}\\\ninline tp1 SharedPtr_get_##tp1 ( void* p ) {\\\nreturn (static_cast*>(p))->get();\\\n}\\\nauto a_##callmod##_SharedPtr_get_##tp1=SharedPtr_get_##tp1;\n\n\n#define SharedPtr_reset_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid SharedPtr_reset_##tp1 ( void* p );}\\\ninline void SharedPtr_reset_##tp1 ( void* p ) {\\\n(static_cast*>(p))->reset();\\\n}\\\nauto a_##callmod##_SharedPtr_reset_##tp1=SharedPtr_reset_##tp1;\n\n\n#define SharedPtr_use_count_s(callmod, tp1) \\\nextern \"C\" {\\\nint SharedPtr_use_count_##tp1 ( void* p );}\\\ninline int SharedPtr_use_count_##tp1 ( void* p ) {\\\nreturn (static_cast*>(p))->use_count();\\\n}\\\nauto a_##callmod##_SharedPtr_use_count_##tp1=SharedPtr_use_count_##tp1;\n\n\n#define SharedPtr_delete_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid SharedPtr_delete_##tp1 ( void* p );}\\\ninline void SharedPtr_delete_##tp1 ( void* p ) {\\\ndelete static_cast*>(p);\\\n}\\\nauto a_##callmod##_SharedPtr_delete_##tp1=SharedPtr_delete_##tp1;\n\n\n#define SharedPtr_instance(callmod, tp1) \\\nSharedPtr_newSharedPtr0(callmod, tp1)\\\nSharedPtr_new(callmod, tp1)\\\nSharedPtr_get(callmod, tp1)\\\nSharedPtr_reset(callmod, tp1)\\\nSharedPtr_use_count(callmod, tp1)\\\nSharedPtr_delete(callmod, tp1)\n\n\n#define SharedPtr_instance_s(callmod, tp1) \\\nSharedPtr_newSharedPtr0_s(callmod, tp1)\\\nSharedPtr_new_s(callmod, tp1)\\\nSharedPtr_get_s(callmod, tp1)\\\nSharedPtr_reset_s(callmod, tp1)\\\nSharedPtr_use_count_s(callmod, tp1)\\\nSharedPtr_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 + ++ + "SharedPtr_instance" ++ + (case isCprim of + CPrim -> "_s" + NonCPrim -> "") + ++ "(" ++ intercalate ", " (callmod : params) ++ ")\n")) + let lst = [f1, f2, f3, f4, f5, f6] + pure [mkInstance [] (AppT (con "ISharedPtr") typ1) lst] diff --git a/src/STD/SharedPtr/Template.hs b/src/STD/SharedPtr/Template.hs new file mode 100644 --- /dev/null +++ b/src/STD/SharedPtr/Template.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleInstances, + MultiParamTypeClasses, TypeFamilies #-} +module STD.SharedPtr.Template where +import Foreign.C.Types +import Foreign.Ptr +import FFICXX.Runtime.Cast + +data RawSharedPtr tp1 + +newtype SharedPtr tp1 = SharedPtr (Ptr (RawSharedPtr tp1)) + +class () => ISharedPtr tp1 where + newSharedPtr0 :: IO (SharedPtr tp1) + + newSharedPtr :: tp1 -> IO (SharedPtr tp1) + + get :: SharedPtr tp1 -> IO tp1 + + reset :: SharedPtr tp1 -> IO () + + use_count :: SharedPtr tp1 -> IO CInt + + deleteSharedPtr :: SharedPtr tp1 -> IO () + +instance () => FPtr (SharedPtr tp1) where + type Raw (SharedPtr tp1) = RawSharedPtr tp1 + get_fptr (SharedPtr ptr) = ptr + cast_fptr_to_obj = SharedPtr + +instance () => Castable (SharedPtr tp1) (Ptr (RawSharedPtr tp1)) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/STD/TH.hs b/src/STD/TH.hs new file mode 100644 --- /dev/null +++ b/src/STD/TH.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI, TemplateHaskell #-} +module STD.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 diff --git a/src/STD/Template.hs b/src/STD/Template.hs new file mode 100644 --- /dev/null +++ b/src/STD/Template.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleInstances, + ForeignFunctionInterface, InterruptibleFFI, MultiParamTypeClasses, + TypeFamilies #-} +module STD.Template () where +import Foreign.C.Types +import Foreign.Ptr +import FFICXX.Runtime.Cast diff --git a/src/STD/UniquePtr/TH.hs b/src/STD/UniquePtr/TH.hs new file mode 100644 --- /dev/null +++ b/src/STD/UniquePtr/TH.hs @@ -0,0 +1,82 @@ +{-# 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(new std::unique_ptr());\\\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(new std::unique_ptr(from_nonconst_to_nonconst(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((static_cast*>(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((static_cast*>(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*>(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*>(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(new std::unique_ptr());\\\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(new std::unique_ptr(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*>(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*>(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*>(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*>(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] diff --git a/src/STD/UniquePtr/Template.hs b/src/STD/UniquePtr/Template.hs new file mode 100644 --- /dev/null +++ b/src/STD/UniquePtr/Template.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleInstances, + MultiParamTypeClasses, TypeFamilies #-} +module STD.UniquePtr.Template where +import Foreign.C.Types +import Foreign.Ptr +import FFICXX.Runtime.Cast + +data RawUniquePtr tp1 + +newtype UniquePtr tp1 = UniquePtr (Ptr (RawUniquePtr tp1)) + +class () => IUniquePtr tp1 where + newUniquePtr0 :: IO (UniquePtr tp1) + + newUniquePtr :: tp1 -> IO (UniquePtr tp1) + + get :: UniquePtr tp1 -> IO tp1 + + release :: UniquePtr tp1 -> IO tp1 + + reset :: UniquePtr tp1 -> IO () + + deleteUniquePtr :: UniquePtr tp1 -> IO () + +instance () => FPtr (UniquePtr tp1) where + type Raw (UniquePtr tp1) = RawUniquePtr tp1 + get_fptr (UniquePtr ptr) = ptr + cast_fptr_to_obj = UniquePtr + +instance () => Castable (UniquePtr tp1) (Ptr (RawUniquePtr tp1)) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/STD/Vector/TH.hs b/src/STD/Vector/TH.hs new file mode 100644 --- /dev/null +++ b/src/STD/Vector/TH.hs @@ -0,0 +1,100 @@ +{-# 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 typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "Vector_new" <> n, tyf) + where tyf _ = let tp1 = pure typ1 in [t| IO (Vector $( tp1 )) |] + +t_begin :: Type -> String -> Q Exp +t_begin typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "Vector_begin" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in + [t| Vector $( tp1 ) -> IO (VectorIterator $( tp1 )) |] + +t_end :: Type -> String -> Q Exp +t_end typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "Vector_end" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in + [t| Vector $( tp1 ) -> IO (VectorIterator $( tp1 )) |] + +t_push_back :: Type -> String -> Q Exp +t_push_back typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "Vector_push_back" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in + [t| Vector $( tp1 ) -> $( tp1 ) -> IO () |] + +t_pop_back :: Type -> String -> Q Exp +t_pop_back typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "Vector_pop_back" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in [t| Vector $( tp1 ) -> IO () |] + +t_at :: Type -> String -> Q Exp +t_at typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "Vector_at" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in + [t| Vector $( tp1 ) -> CInt -> IO $( tp1 ) |] + +t_size :: Type -> String -> Q Exp +t_size typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "Vector_size" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in [t| Vector $( tp1 ) -> IO CInt |] + +t_deleteVector :: Type -> String -> Q Exp +t_deleteVector typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "Vector_delete" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in [t| Vector $( tp1 ) -> IO () |] + +genVectorInstanceFor :: + IsCPrimitive -> (Q Type, TemplateParamInfo) -> Q [Dec] +genVectorInstanceFor 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 "newVector" t_newVector typ1 suffix + f2 <- mkMember "begin" t_begin typ1 suffix + f3 <- mkMember "end" t_end typ1 suffix + f4 <- mkMember "push_back" t_push_back typ1 suffix + f5 <- mkMember "pop_back" t_pop_back typ1 suffix + f6 <- mkMember "at" t_at typ1 suffix + f7 <- mkMember "size" t_size typ1 suffix + f8 <- mkDelete "deleteVector" t_deleteVector typ1 suffix + addModFinalizer + (addForeignSource LangCxx + ("\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(new std::vector());\\\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::iterator* r=new std::vector::iterator((static_cast*>(p))->begin());return static_cast(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::iterator* r=new std::vector::iterator((static_cast*>(p))->end());return static_cast(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*>(p))->push_back(*(from_nonconst_to_nonconst(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*>(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*)&((static_cast*>(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*>(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*>(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(new std::vector());\\\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::iterator* r=new std::vector::iterator((static_cast*>(p))->begin());return static_cast(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::iterator* r=new std::vector::iterator((static_cast*>(p))->end());return static_cast(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*>(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*>(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*>(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*>(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*>(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" + ++ + 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 + ++ + "Vector_instance" ++ + (case isCprim of + CPrim -> "_s" + NonCPrim -> "") + ++ "(" ++ intercalate ", " (callmod : params) ++ ")\n")) + let lst = [f1, f2, f3, f4, f5, f6, f7, f8] + pure [mkInstance [] (AppT (con "IVector") typ1) lst] diff --git a/src/STD/Vector/Template.hs b/src/STD/Vector/Template.hs new file mode 100644 --- /dev/null +++ b/src/STD/Vector/Template.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleInstances, + MultiParamTypeClasses, TypeFamilies #-} +module STD.Vector.Template where +import Foreign.C.Types +import Foreign.Ptr +import FFICXX.Runtime.Cast +import STD.VectorIterator.Template + +data RawVector tp1 + +newtype Vector tp1 = Vector (Ptr (RawVector tp1)) + +class () => IVector tp1 where + newVector :: IO (Vector tp1) + + begin :: Vector tp1 -> IO (VectorIterator tp1) + + end :: Vector tp1 -> IO (VectorIterator tp1) + + push_back :: Vector tp1 -> tp1 -> IO () + + pop_back :: Vector tp1 -> IO () + + at :: Vector tp1 -> CInt -> IO tp1 + + size :: Vector tp1 -> IO CInt + + deleteVector :: Vector tp1 -> IO () + +instance () => FPtr (Vector tp1) where + type Raw (Vector tp1) = RawVector tp1 + get_fptr (Vector ptr) = ptr + cast_fptr_to_obj = Vector + +instance () => Castable (Vector tp1) (Ptr (RawVector tp1)) where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/src/STD/VectorIterator/TH.hs b/src/STD/VectorIterator/TH.hs new file mode 100644 --- /dev/null +++ b/src/STD/VectorIterator/TH.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE TemplateHaskell #-} +module STD.VectorIterator.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.VectorIterator.Template + +t_deRef :: Type -> String -> Q Exp +t_deRef typ1 suffix + = mkTFunc (typ1, suffix, \ n -> "VectorIterator_deRef" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in + [t| VectorIterator $( tp1 ) -> IO $( tp1 ) |] + +t_increment :: Type -> String -> Q Exp +t_increment typ1 suffix + = mkTFunc + (typ1, suffix, \ n -> "VectorIterator_increment" <> n, tyf) + where tyf _ + = let tp1 = pure typ1 in + [t| VectorIterator $( tp1 ) -> IO (VectorIterator $( tp1 )) |] + +genVectorIteratorInstanceFor :: + IsCPrimitive -> (Q Type, TemplateParamInfo) -> Q [Dec] +genVectorIteratorInstanceFor 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 <- mkMember "deRef" t_deRef typ1 suffix + f2 <- mkMember "increment" t_increment typ1 suffix + addModFinalizer + (addForeignSource LangCxx + ("\n#include \"MacroPatternMatch.h\"\n\n\n#include \"vector\"\n\n\n#define VectorIterator_deRef(callmod, tp1) \\\nextern \"C\" {\\\ntp1##_p VectorIterator_deRef_##tp1 ( void* p );}\\\ninline tp1##_p VectorIterator_deRef_##tp1 ( void* p ) {\\\nreturn from_nonconst_to_nonconst((tp1*)&((static_cast::iterator*>(p))->operator*()));\\\n}\\\nauto a_##callmod##_VectorIterator_deRef_##tp1=VectorIterator_deRef_##tp1;\n\n\n#define VectorIterator_increment(callmod, tp1) \\\nextern \"C\" {\\\nvoid* VectorIterator_increment_##tp1 ( void* p );}\\\ninline void* VectorIterator_increment_##tp1 ( void* p ) {\\\nstd::vector::iterator* r=new std::vector::iterator((static_cast::iterator*>(p))->operator++());return static_cast(r);\\\n}\\\nauto a_##callmod##_VectorIterator_increment_##tp1=VectorIterator_increment_##tp1;\n\n\n#define VectorIterator_deRef_s(callmod, tp1) \\\nextern \"C\" {\\\ntp1 VectorIterator_deRef_##tp1 ( void* p );}\\\ninline tp1 VectorIterator_deRef_##tp1 ( void* p ) {\\\nreturn (static_cast::iterator*>(p))->operator*();\\\n}\\\nauto a_##callmod##_VectorIterator_deRef_##tp1=VectorIterator_deRef_##tp1;\n\n\n#define VectorIterator_increment_s(callmod, tp1) \\\nextern \"C\" {\\\nvoid* VectorIterator_increment_##tp1 ( void* p );}\\\ninline void* VectorIterator_increment_##tp1 ( void* p ) {\\\nstd::vector::iterator* r=new std::vector::iterator((static_cast::iterator*>(p))->operator++());return static_cast(r);\\\n}\\\nauto a_##callmod##_VectorIterator_increment_##tp1=VectorIterator_increment_##tp1;\n\n\n#define VectorIterator_instance(callmod, tp1) \\\nVectorIterator_deRef(callmod, tp1)\\\nVectorIterator_increment(callmod, tp1)\n\n\n#define VectorIterator_instance_s(callmod, tp1) \\\nVectorIterator_deRef_s(callmod, tp1)\\\nVectorIterator_increment_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 + ++ + "VectorIterator_instance" ++ + (case isCprim of + CPrim -> "_s" + NonCPrim -> "") + ++ "(" ++ intercalate ", " (callmod : params) ++ ")\n")) + let lst = [f1, f2] + pure [mkInstance [] (AppT (con "IVectorIterator") typ1) lst] diff --git a/src/STD/VectorIterator/Template.hs b/src/STD/VectorIterator/Template.hs new file mode 100644 --- /dev/null +++ b/src/STD/VectorIterator/Template.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleInstances, + MultiParamTypeClasses, TypeFamilies #-} +module STD.VectorIterator.Template where +import Foreign.C.Types +import Foreign.Ptr +import FFICXX.Runtime.Cast + +data RawVectorIterator tp1 + +newtype VectorIterator tp1 = VectorIterator (Ptr + (RawVectorIterator tp1)) + +class () => IVectorIterator tp1 where + deRef :: VectorIterator tp1 -> IO tp1 + + increment :: VectorIterator tp1 -> IO (VectorIterator tp1) + +instance () => FPtr (VectorIterator tp1) where + type Raw (VectorIterator tp1) = RawVectorIterator tp1 + get_fptr (VectorIterator ptr) = ptr + cast_fptr_to_obj = VectorIterator + +instance () => + Castable (VectorIterator tp1) (Ptr (RawVectorIterator tp1)) + where + cast x f = f (castPtr (get_fptr x)) + uncast x f = f (cast_fptr_to_obj (castPtr x)) diff --git a/stdcxx.cabal b/stdcxx.cabal new file mode 100644 --- /dev/null +++ b/stdcxx.cabal @@ -0,0 +1,84 @@ +Cabal-version: 3.0 +Name: stdcxx +Version: 0.7.0.0 +Synopsis: Binding to Standard Template Library C++ +Description: Haskell binding to Standard Template Library generated by fficxx +Homepage: https://github.com/wavewave/fficxx +license: BSD-2-Clause +license-file: LICENSE +Author: Ian-Woo Kim +Maintainer: Ian-Woo Kim +Category: FFI +Tested-with: GHC == 9.0.2 || == 9.2.4 || == 9.4.2 +Build-Type: Simple +Extra-source-files: + ChangeLog.md + csrc/STDDeletable.h + csrc/STDOstream.h + csrc/STDCppString.h + csrc/STDDeletable.cpp + csrc/STDOstream.cpp + csrc/STDCppString.cpp + +Library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall -funbox-strict-fields -fno-warn-unused-do-bind -fno-warn-orphans -fno-warn-unused-imports + cxx-options: -std=c++17 + Build-Depends: base > 4 && < 5, fficxx >= 0.7, fficxx-runtime >= 0.7, template-haskell + Exposed-Modules: + STD + STD.Ordinary + STD.Template + STD.TH + STD.Deletable + STD.Ostream + STD.CppString + STD.Deletable.RawType + STD.Ostream.RawType + STD.CppString.RawType + STD.Deletable.FFI + STD.Ostream.FFI + STD.CppString.FFI + STD.Deletable.Interface + STD.Ostream.Interface + STD.CppString.Interface + STD.Deletable.Cast + STD.Ostream.Cast + STD.CppString.Cast + STD.Deletable.Implementation + STD.Ostream.Implementation + STD.CppString.Implementation + STD.Pair.Template + STD.Map.Template + STD.MapIterator.Template + STD.Vector.Template + STD.VectorIterator.Template + STD.UniquePtr.Template + STD.SharedPtr.Template + STD.Pair.TH + STD.Map.TH + STD.MapIterator.TH + STD.Vector.TH + STD.VectorIterator.TH + STD.UniquePtr.TH + STD.SharedPtr.TH + + Other-Modules: + + + extra-lib-dirs: + extra-libraries: stdc++ + Include-dirs: csrc + pkgconfig-depends: + Install-includes: + stdcxxType.h + STDDeletable.h + STDOstream.h + STDCppString.h + + Cxx-sources: + csrc/STDDeletable.cpp + csrc/STDOstream.cpp + csrc/STDCppString.cpp +