packages feed

inline-c-cpp 0.4.0.2 → 0.4.0.3

raw patch · 7 files changed

+244/−64 lines, 7 filesdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: vector

API changes (from Hackage documentation)

Files

cxx-src/HaskellException.cxx view
@@ -1,6 +1,21 @@- #include "HaskellException.hxx" +// see+// <https://stackoverflow.com/questions/28166565/detect-gcc-as-opposed-to-msvc-clang-with-macro>+// regarding how to detect g++ or clang.+// +// the defined(__clang__) should actually be redundant, since apparently it also+// defines GNUC, but but let's be safe.++#include <cstring>+#include <cstdlib>++#if defined(__GNUC__) || defined(__clang__)+#include <cxxabi.h>+#include <string>+#endif++ HaskellException::HaskellException(std::string renderedExceptionIn, void *haskellExceptionStablePtrIn)   : haskellExceptionStablePtr(new HaskellStablePtr(haskellExceptionStablePtrIn))   , displayExceptionValue(renderedExceptionIn)@@ -15,4 +30,40 @@  const char* HaskellException::what() const noexcept {   return displayExceptionValue.c_str();+}+++// see+// <https://stackoverflow.com/questions/561997/determining-exception-type-after-the-exception-is-caught/47164539#47164539>+// regarding how to show the type of an exception.++#if defined(__GNUC__) || defined(__clang__)+const char* currentExceptionTypeName()+{+  int demangle_status;+  return abi::__cxa_demangle(abi::__cxa_current_exception_type()->name(), 0, 0, &demangle_status);+}+#endif++void setMessageOfStdException(std::exception &e,char** __inline_c_cpp_error_message__){+#if defined(__GNUC__) || defined(__clang__)+  const char* demangle_result = currentExceptionTypeName();+  std::string message = "Exception: " + std::string(e.what()) + "; type: " + std::string(demangle_result);+#else+  std::string message = "Exception: " + std::string(e.what()) + "; type: not available (please use g++ or clang)";+#endif+  size_t message_len = message.size() + 1;+  *__inline_c_cpp_error_message__ = static_cast<char*>(std::malloc(message_len));+  std::memcpy(*__inline_c_cpp_error_message__, message.c_str(), message_len);+}++void setMessageOfOtherException(char** __inline_c_cpp_error_message__){+#if defined(__GNUC__) || defined(__clang__)+  const char* message = currentExceptionTypeName();+  size_t message_len = strlen(message) + 1;+  *__inline_c_cpp_error_message__ = static_cast<char*>(std::malloc(message_len));+  std::memcpy(*__inline_c_cpp_error_message__, message, message_len);+#else+  *__inline_c_cpp_error_message__ = NULL;+#endif }
cxx-src/HaskellStablePtr.cxx view
@@ -1,6 +1,5 @@  #include "HaskellStablePtr.hxx"-#include "HsFFI.h"  HaskellStablePtr::~HaskellStablePtr() {   if (stablePtr != STABLE_PTR_NULL) {
include/HaskellException.hxx view
@@ -4,6 +4,7 @@ #include "HaskellStablePtr.hxx" #include <memory> #include <string>+#include <exception>  /* A representation of a Haskell exception (SomeException), with a precomputed    exception message from Control.Exception.displayException.@@ -25,3 +26,6 @@   virtual const char* what() const noexcept override;  };++void setMessageOfStdException(std::exception &e,char** __inline_c_cpp_error_message__);+void setMessageOfOtherException(char** __inline_c_cpp_error_message__);
inline-c-cpp.cabal view
@@ -1,5 +1,6 @@+cabal-version:       2.2 name:                inline-c-cpp-version:             0.4.0.2+version:             0.4.0.3 synopsis:            Lets you embed C++ code into Haskell. description:         Utilities to inline C++ code into Haskell using inline-c.  See                      tests for example on how to build.@@ -9,16 +10,55 @@ maintainer:          f@mazzo.li copyright:           (c) 2015-2016 FP Complete Corporation, (c) 2017-2019 Francesco Mazzoli category:            FFI-tested-with:         GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5+tested-with:         GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.2 build-type:          Simple-cabal-version:       >=1.10 extra-source-files:  test/*.h  source-repository head   type:     git   location: https://github.com/fpco/inline-c +flag std-vector-example+  description:         Build std::vector example+  default:             False++common cxx-opts+  -- These options are for compilation of C++ _files_. We need to duplicate+  -- these in ghc-options to apply them on inline-c-cpp snippets.+  -- This is partly(?) due to Cabal < 3.2.1.0 not passing cxx-options to+  -- GHC 8.10 correctly. See https://github.com/haskell/cabal/issues/6421+  cxx-options:+    -- Compilers strive to be ABI compatible regardless of the C++ language+    -- version (except perhaps experimental features).+    -- Discussion: https://stackoverflow.com/questions/46746878/is-it-safe-to-link-c17-c14-and-c11-objects/49118876+    -- We only have to raise this if a new inline-c-cpp feature requires us to+    -- bundle C++ code that requires a newer version of the standard.+    -- Generated code in user libraries will be compiled with the language+    -- version configured there.+    -std=c++11+    -Wall+  extra-libraries: stdc++++  if os(darwin)+    -- avoid https://gitlab.haskell.org/ghc/ghc/issues/11829+    ld-options:  -Wl,-keep_dwarf_unwind++  if impl(ghc >= 8.10)+    ghc-options:+      -optcxx-std=c++11+      -optcxx-Wall+  else+    -- On GHC < 8.10, we have to emulate -optcxx by making the C compiler compile+    -- C++. GCC accepts this via -std, whereas Clang requires us to change the+    -- command.+    ghc-options:+      -optc-std=c++11+      -optc-Wall+    if os(darwin)+      ghc-options: -pgmc=clang+++ library+  import:              cxx-opts   exposed-modules:     Language.C.Inline.Cpp                        Language.C.Inline.Cpp.Exceptions   build-depends:       base >=4.7 && <5@@ -28,33 +68,34 @@                      , containers   hs-source-dirs:      src   default-language:    Haskell2010-  ghc-options:         -Wall -optc-xc++ -optc-std=c++11+  ghc-options:         -Wall   include-dirs:        include   install-includes:    HaskellException.hxx HaskellStablePtr.hxx-  extra-libraries:     stdc++-  c-sources:           cxx-src/HaskellException.cxx cxx-src/HaskellStablePtr.cxx-  cc-options:          -Wall -std=c++11-  if os(darwin)-    -- avoid https://gitlab.haskell.org/ghc/ghc/issues/11829-    ld-options:        -Wl,-keep_dwarf_unwind-    ghc-options:       -pgmc=clang+++  cxx-sources:         cxx-src/HaskellException.cxx+                       cxx-src/HaskellStablePtr.cxx  test-suite tests+  import:              cxx-opts   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             tests.hs+  other-modules:       StdVector   build-depends:       base >=4 && <5                      , inline-c                      , inline-c-cpp                      , safe-exceptions                      , hspec                      , containers+                     , template-haskell+                     , vector   default-language:    Haskell2010-  ghc-options:-    -optc-std=c++11-  if os(darwin)-    ghc-options: -pgmc=clang++-  extra-libraries:     stdc++-  cc-options:          -Wall -Werror -optc-xc++ -std=c++11-  if os(darwin)-    ld-options: -Wl,-keep_dwarf_unwind+  cxx-options:         -Werror++  if impl(ghc >= 8.10)+    ghc-options:+      -optcxx-Werror+  -- else+  --   ghc-options:+  --     -- GHC < 8.10 can pass options to the C++ compiler, but it warns+  --     -- so -Werror will not work.+  --     -optc-Werror
src/Language/C/Inline/Cpp/Exceptions.hs view
@@ -161,28 +161,10 @@ tryBlockQuoteExp :: String -> Q Exp tryBlockQuoteExp blockStr = do   let (ty, body) = C.splitTypedC blockStr-  _ <- C.include "<exception>"-  _ <- C.include "<cstring>"-  _ <- C.include "<cstdlib>"   _ <- C.include "HaskellException.hxx"-  -- see-  -- <https://stackoverflow.com/questions/28166565/detect-gcc-as-opposed-to-msvc-clang-with-macro>-  -- regarding how to detect g++ or clang.-  ---  -- the defined(__clang__) should actually be redundant, since apparently it also-  -- defines GNUC, but but let's be safe.-  _ <- C.verbatim $ unlines-    [ "#if defined(__GNUC__) || defined(__clang__)"-    , "#include <cxxabi.h>"-    , "#include <string>"-    , "#endif"-    ]   typePtrVarName <- newName "exTypePtr"   msgPtrVarName <- newName "msgPtr"   haskellExPtrVarName <- newName "haskellExPtr"-  -- see-  -- <https://stackoverflow.com/questions/561997/determining-exception-type-after-the-exception-is-caught/47164539#47164539>-  -- regarding how to show the type of an exception.   let inlineCStr = unlines         [ ty ++ " {"         , "  int* __inline_c_cpp_exception_type__ = $(int* " ++ nameBase typePtrVarName ++ ");"@@ -193,31 +175,14 @@         , "  } catch (HaskellException &e) {"         , "    *__inline_c_cpp_exception_type__ = " ++ show ExTypeHaskellException ++ ";"         , "    *__inline_c_cpp_haskellexception__ = new HaskellException(e);"-        , if ty == "void" then "return;" else "return {};"+        , "    return " ++ exceptionalValue ty ++ ";"         , "  } catch (std::exception &e) {"         , "    *__inline_c_cpp_exception_type__ = " ++ show ExTypeStdException ++ ";"-        , "#if defined(__GNUC__) || defined(__clang__)"-        , "    int demangle_status;"-        , "    const char* demangle_result = abi::__cxa_demangle(abi::__cxa_current_exception_type()->name(), 0, 0, &demangle_status);"-        , "    std::string message = \"Exception: \" + std::string(e.what()) + \"; type: \" + std::string(demangle_result);"-        , "#else"-        , "    std::string message = \"Exception: \" + std::string(e.what()) + \"; type: not available (please use g++ or clang)\";"-        , "#endif"-        , "    size_t message_len = message.size() + 1;"-        , "    *__inline_c_cpp_error_message__ = static_cast<char*>(std::malloc(message_len));"-        , "    std::memcpy(*__inline_c_cpp_error_message__, message.c_str(), message_len);"+        , "    setMessageOfStdException(e,__inline_c_cpp_error_message__);"         , "    return " ++ exceptionalValue ty ++ ";"         , "  } catch (...) {"         , "    *__inline_c_cpp_exception_type__ = " ++ show ExTypeOtherException ++ ";"-        , "#if defined(__GNUC__) || defined(__clang__)"-        , "    int demangle_status;"-        , "    const char* message = abi::__cxa_demangle(abi::__cxa_current_exception_type()->name(), 0, 0, &demangle_status);"-        , "    size_t message_len = strlen(message) + 1;"-        , "    *__inline_c_cpp_error_message__ = static_cast<char*>(std::malloc(message_len));"-        , "    std::memcpy(*__inline_c_cpp_error_message__, message, message_len);"-        , "#else"-        , "    *__inline_c_cpp_error_message__ = NULL;"-        , "#endif"+        , "    setMessageOfOtherException(__inline_c_cpp_error_message__);"         , "    return " ++ exceptionalValue ty ++ ";"         , "  }"         , "}"
+ test/StdVector.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++module StdVector+  ( stdVectorCtx+  , instanceStdVector+  , CStdVector+  , StdVector()+  , StdVector.new+  , size+  , toVector+  , pushBack+  )++where++import qualified Language.C.Inline as C+import qualified Language.C.Inline.Unsafe as CU+import qualified Language.C.Inline.Context as C+import qualified Language.C.Inline.Cpp as C+import qualified Language.C.Types as C+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Storable.Mutable as VSM+import qualified Data.Map.Strict as M+import Control.Monad+import Data.Maybe+import Language.Haskell.TH.Syntax+import Foreign+import Foreign.C+import Language.Haskell.TH+import Data.Proxy+import Control.Exception (mask_)++data CStdVector a++stdVectorCtx :: C.Context+stdVectorCtx = C.cppCtx `mappend` C.cppTypePairs [ ("std::vector", [t| CStdVector |]) ]++newtype StdVector a = StdVector (ForeignPtr (CStdVector a))++class HasStdVector a where+  cNew :: IO (Ptr (CStdVector a))+  cDelete :: FunPtr (Ptr (CStdVector a) -> IO ())+  cSize :: Ptr (CStdVector a) -> IO CSize+  cCopyTo :: Ptr (CStdVector a) -> Ptr a -> IO ()+  cPushBack :: a -> Ptr (CStdVector a) -> IO ()++instanceStdVector :: String -> DecsQ+instanceStdVector cType = fmap concat $ sequence+  [ C.include "<vector>"+  , C.include "<algorithm>"+  , C.substitute+    [ ( "T", \_ -> cType )+    , ( "VEC", \var -> "$(std::vector<" ++ cType ++ ">* " ++ var ++ ")" )+    ] [d|+      instance HasStdVector $(C.getHaskellType False cType) where+        cNew = [CU.exp| std::vector<@T()>* { new std::vector<@T()>() } |]+        cDelete = [C.funPtr| void deleteStdVector(std::vector<@T()>* vec) { delete vec; } |]+        cSize vec = [CU.exp| size_t { @VEC(vec)->size() } |]+        cCopyTo vec dstPtr = [CU.block| void {+          const std::vector<@T()>* vec = @VEC(vec);+          std::copy(vec->begin(), vec->end(), $(@T()* dstPtr));+          } |]+        cPushBack value vec = [CU.exp| void { @VEC(vec)->push_back($(@T() value)) } |]+    |]+  ]++new :: forall a. HasStdVector a => IO (StdVector a)+new = mask_ $ do+  ptr <- cNew @a+  StdVector <$> newForeignPtr cDelete ptr++size :: HasStdVector a => StdVector a -> IO Int+size (StdVector fptr) = fromIntegral <$> withForeignPtr fptr cSize++toVector :: (HasStdVector a, Storable a) => StdVector a -> IO (VS.Vector a)+toVector stdVec@(StdVector stdVecFPtr) = do+  vecSize <- size stdVec+  hsVec <- VSM.new vecSize+  withForeignPtr stdVecFPtr $ \stdVecPtr ->+    VSM.unsafeWith hsVec $ \hsVecPtr ->+      cCopyTo stdVecPtr hsVecPtr+  VS.unsafeFreeze hsVec++pushBack :: HasStdVector a => StdVector a -> a -> IO ()+pushBack (StdVector fptr) value = withForeignPtr fptr (cPushBack value)
test/tests.hs view
@@ -16,6 +16,7 @@ {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications #-}  import           Control.Exception.Safe import           Control.Monad@@ -26,19 +27,20 @@ import           Foreign.C.String (withCString) import           Foreign.StablePtr (StablePtr, newStablePtr, castStablePtrToPtr) import qualified Test.Hspec as Hspec+import           Test.Hspec (shouldBe) import           Foreign.Ptr (Ptr) import           Data.List (isInfixOf) import           Data.Monoid+import qualified StdVector+import qualified Data.Vector.Storable as VS  data Test-data Vector a data Array a  C.context $ C.cppCtx `mappend` C.cppTypePairs [   ("Test::Test", [t|Test|]),-  ("std::vector", [t|Vector|]),   ("std::array", [t|Array|])-  ]+  ] `mappend` StdVector.stdVectorCtx  C.include "<iostream>" C.include "<vector>"@@ -51,6 +53,9 @@   deriving (Eq, Show, Typeable) instance Exception MyCustomException +StdVector.instanceStdVector "int"+StdVector.instanceStdVector "double"+ main :: IO () main = Hspec.hspec $ do   Hspec.describe "Basic C++" $ do@@ -72,7 +77,7 @@     Hspec.it "Hello Template" $ do       pt <- [C.block| std::vector<int>* {           return new std::vector<int>();-        } |] :: IO (Ptr (Vector C.CInt))+        } |] :: IO (Ptr (StdVector.CStdVector C.CInt))       [C.block| void {           $(std::vector<int>* pt)->push_back(100);           std::cout << (*$(std::vector<int>* pt))[0] << std::endl;@@ -81,7 +86,7 @@     Hspec.it "Template + Namespace" $ do       pt <- [C.block| std::vector<Test::Test>* {           return new std::vector<Test::Test>();-        } |] :: IO (Ptr (Vector Test))+        } |] :: IO (Ptr (StdVector.CStdVector Test))       [C.block| void {           $(std::vector<Test::Test>* pt)->push_back(Test::Test());         } |]@@ -239,6 +244,31 @@         |]        result `shouldBeRight` 0xDEADBEEF++  Hspec.describe "Macros" $ do+    Hspec.it "generated std::vector instances work correctly" $ do+      intVec <- StdVector.new @C.CInt+      StdVector.pushBack intVec 4+      StdVector.pushBack intVec 5+      hsIntVec <- StdVector.toVector intVec+      VS.toList hsIntVec `shouldBe` [ 4, 5 ]++      doubleVec <- StdVector.new @C.CDouble+      StdVector.pushBack doubleVec 4.3+      StdVector.pushBack doubleVec 6.7+      hsDoubleVec <- StdVector.toVector doubleVec+      VS.toList hsDoubleVec `shouldBe` [ 4.3, 6.7 ]++  Hspec.it "Template with pointers" $ do+    pt <- [C.block| std::vector<int*>* {+        return new std::vector<int*>();+      } |] :: IO (Ptr (StdVector.CStdVector (Ptr C.CInt)))+    [C.block| void {+        int *a = new int;+        *a = 100;+        $(std::vector<int*>* pt)->push_back(a);+        std::cout << *((*$(std::vector<int*>* pt))[0]) << std::endl;+      } |]  tag :: C.CppException -> String tag (C.CppStdException {}) = "CppStdException"