inline-c-cpp 0.3.0.3 → 0.3.1.0
raw patch · 4 files changed
+129/−6 lines, 4 filesdep +containers
Dependencies added: containers
Files
- inline-c-cpp.cabal +5/−1
- src/Language/C/Inline/Cpp.hs +11/−0
- src/Language/C/Inline/Cpp/Exceptions.hs +46/−3
- test/tests.hs +67/−2
inline-c-cpp.cabal view
@@ -1,5 +1,5 @@ name: inline-c-cpp-version: 0.3.0.3+version: 0.3.1.0 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.@@ -24,6 +24,7 @@ , inline-c >= 0.6.1.0 , template-haskell , safe-exceptions+ , containers hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall -optc-xc++ -optc-std=c++11@@ -41,6 +42,7 @@ , inline-c-cpp , safe-exceptions , hspec+ , containers default-language: Haskell2010 ghc-options: -optc-std=c++11@@ -48,3 +50,5 @@ 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
src/Language/C/Inline/Cpp.hs view
@@ -4,6 +4,7 @@ module Language.C.Inline.Cpp ( module Language.C.Inline , cppCtx+ , cppTypePairs , using ) where @@ -13,7 +14,10 @@ import Language.C.Inline import Language.C.Inline.Context+import qualified Language.C.Types as CT +import qualified Data.Map as Map+ -- | The equivalent of 'C.baseCtx' for C++. It specifies the @.cpp@ -- file extension for the C file, so that g++ will decide to build C++ -- instead of C. See the @.cabal@ test target for an example on how to@@ -22,6 +26,7 @@ cppCtx = baseCtx <> mempty { ctxForeignSrcLang = Just TH.LangCxx , ctxOutput = Just $ \s -> "extern \"C\" {\n" ++ s ++ "\n}"+ , ctxEnableCpp = True } -- | Emits an @using@ directive, e.g.@@ -31,3 +36,9 @@ -- @ using :: String -> TH.DecsQ using s = verbatim $ "using " ++ s ++ ";"+++cppTypePairs :: [(CT.CIdentifier, TH.TypeQ)] -> Context+cppTypePairs typePairs = mempty {+ ctxTypesTable = Map.fromList $ map (\(cpp_sym, haskell_sym) -> (CT.TypeName cpp_sym, haskell_sym)) typePairs+ }
src/Language/C/Inline/Cpp/Exceptions.hs view
@@ -87,8 +87,51 @@ , quoteDec = unsupported } where unsupported _ = fail "Unsupported quasiquotation."- +exceptionalValue :: String -> String+exceptionalValue typeStr =+ case typeStr of+ "void" -> ""+ "char" -> "0"+ "short" -> "0"+ "long" -> "0"+ "int" -> "0"+ "int8_t" -> "0"+ "int16_t" -> "0"+ "int32_t" -> "0"+ "int64_t" -> "0"+ "uint8_t" -> "0"+ "uint16_t" -> "0"+ "uint32_t" -> "0"+ "uint64_t" -> "0"+ "float" -> "0"+ "double" -> "0"+ "bool" -> "0"+ "signed char" -> "0"+ "signed short" -> "0"+ "signed int" -> "0"+ "signed long" -> "0"+ "unsigned char" -> "0"+ "unsigned short" -> "0"+ "unsigned int" -> "0"+ "unsigned long" -> "0"+ "size_t" -> "0"+ "wchar_t" -> "0"+ "ptrdiff_t" -> "0"+ "sig_atomic_t" -> "0"+ "intptr_t" -> "0"+ "uintptr_t" -> "0"+ "intmax_t" -> "0"+ "uintmax_t" -> "0"+ "clock_t" -> "0"+ "time_t" -> "0"+ "useconds_t" -> "0"+ "suseconds_t" -> "0"+ "FILE" -> "0"+ "fpos_t" -> "0"+ "jmp_buf" -> "0"+ _ -> "{}"+ tryBlockQuoteExp :: String -> Q Exp tryBlockQuoteExp blockStr = do let (ty, body) = C.splitTypedC blockStr@@ -130,7 +173,7 @@ , " 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);"- , if ty == "void" then "return;" else "return {};"+ , " return " ++ exceptionalValue ty ++ ";" , " } catch (...) {" , " *__inline_c_cpp_exception_type__ = " ++ show ExTypeOtherException ++ ";" , "#if defined(__GNUC__) || defined(__clang__)"@@ -142,7 +185,7 @@ , "#else" , " *__inline_c_cpp_error_message__ = NULL;" , "#endif"- , if ty == "void" then "return;" else "return {};"+ , " return " ++ exceptionalValue ty ++ ";" , " }" , "}" ]
test/tests.hs view
@@ -1,18 +1,48 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} import Control.Exception.Safe import Control.Monad import qualified Language.C.Inline.Cpp as C+import qualified Language.C.Inline.Context as CC+import qualified Language.C.Types as CT import qualified Language.C.Inline.Cpp.Exceptions as C import qualified Test.Hspec as Hspec+import Foreign.Ptr (Ptr) import Data.List (isInfixOf) -C.context C.cppCtx+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|])+ ]+ C.include "<iostream>"+C.include "<vector>"+C.include "<array>"+C.include "<tuple>" C.include "<stdexcept>"+C.include "test.h" main :: IO () main = Hspec.hspec $ do@@ -21,6 +51,41 @@ let x = 3 [C.block| void { std::cout << "Hello, world!" << $(int x) << std::endl;+ } |]++ Hspec.describe "C++ Types" $ do+ Hspec.it "Hello Namespace" $ do+ pt <- [C.block| Test::Test* {+ return new Test::Test();+ } |] :: IO (Ptr Test)+ [C.block| void {+ std::cout << $(Test::Test* pt)->get() << std::endl;+ } |]++ Hspec.it "Hello Template" $ do+ pt <- [C.block| std::vector<int>* {+ return new std::vector<int>();+ } |] :: IO (Ptr (Vector C.CInt))+ [C.block| void {+ $(std::vector<int>* pt)->push_back(100);+ std::cout << (*$(std::vector<int>* pt))[0] << std::endl;+ } |]++ Hspec.it "Template + Namespace" $ do+ pt <- [C.block| std::vector<Test::Test>* {+ return new std::vector<Test::Test>();+ } |] :: IO (Ptr (Vector Test))+ [C.block| void {+ $(std::vector<Test::Test>* pt)->push_back(Test::Test());+ } |]++ Hspec.it "Template with 2 arguments" $ do+ pt <- [C.block| std::array<int,10>* {+ return new std::array<int,10>();+ } |] :: IO (Ptr (Array '(C.CInt,10)))+ [C.block| void {+ (*$(std::array<int,10>* pt))[0]=true;+ std::cout << (*$(std::array<int,10>* pt))[0] << std::endl; } |] Hspec.describe "Exception handling" $ do