diff --git a/inline-c-cpp.cabal b/inline-c-cpp.cabal --- a/inline-c-cpp.cabal +++ b/inline-c-cpp.cabal @@ -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 diff --git a/src/Language/C/Inline/Cpp.hs b/src/Language/C/Inline/Cpp.hs --- a/src/Language/C/Inline/Cpp.hs +++ b/src/Language/C/Inline/Cpp.hs @@ -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 + } diff --git a/src/Language/C/Inline/Cpp/Exceptions.hs b/src/Language/C/Inline/Cpp/Exceptions.hs --- a/src/Language/C/Inline/Cpp/Exceptions.hs +++ b/src/Language/C/Inline/Cpp/Exceptions.hs @@ -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(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 ++ ";" , " }" , "}" ] diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -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 "" +C.include "" +C.include "" +C.include "" C.include "" +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* { + return new std::vector(); + } |] :: IO (Ptr (Vector C.CInt)) + [C.block| void { + $(std::vector* pt)->push_back(100); + std::cout << (*$(std::vector* pt))[0] << std::endl; + } |] + + Hspec.it "Template + Namespace" $ do + pt <- [C.block| std::vector* { + return new std::vector(); + } |] :: IO (Ptr (Vector Test)) + [C.block| void { + $(std::vector* pt)->push_back(Test::Test()); + } |] + + Hspec.it "Template with 2 arguments" $ do + pt <- [C.block| std::array* { + return new std::array(); + } |] :: IO (Ptr (Array '(C.CInt,10))) + [C.block| void { + (*$(std::array* pt))[0]=true; + std::cout << (*$(std::array* pt))[0] << std::endl; } |] Hspec.describe "Exception handling" $ do