diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,5 @@ # inline-c -[![Build Status](https://travis-ci.org/fpco/inline-c.svg)](https://travis-ci.org/fpco/inline-c) - `inline-c` lets you seamlessly call C libraries and embed high-performance inline C code in Haskell modules. Haskell and C can be freely intermixed in the same source file, and data passed to and @@ -302,51 +300,20 @@ the target C type and the Haskell identifier are mentioned using C declaration syntax. -## How to build - -Each module that uses at least one of the `inline-c` functions gets a C -file associated to it, where the filename of said file will be the same -as the module but with a C extension. This C file must be built after -the Haskell code and linked appropriately. - -If you use cabal, you **must** manually declare each associated C file in -the `c-sources` section of the `.cabal` file and you are good. +## GHCi -For example we might have +Currently `inline-c` does not work in interpreted mode. However, GHCi +can still be used using the `-fobject-code` flag. For speed, we +reccomend passing `-fobject-code -O0`, for example ``` -executable foo - main-is: Main.hs, Foo.hs, Bar.hs - hs-source-dirs: src - - -- IMPORTANT! - -- Here the corresponding C sources must be listed for every module - -- that uses C code. In this example, Main.hs and Bar.hs do, but - -- Foo.hs does not. - c-sources: src/Main.c, src/Bar.c - - -- These flags will be passed to the C compiler - cc-options: -Wall -O2 - -- Libraries to link the code with. - extra-libraries: m - ... +stack ghci --ghci-options='-fobject-code -O0' ``` -Note that currently `cabal repl` is not supported, because the C code is -not compiled and linked appropriately. Type-checking will still be -performed, so `cabal repl` can still be used to develop. - -See `sample-cabal-project` for a working example. - -If we were to compile the above manually we could do: +or ``` -$ ghc -c Main.hs -$ cc -c Main.c -o Main_c.o -$ ghc Foo.hs -$ ghc Bar.hs -$ cc -c Bar.c -o Bar_c.o -$ ghc Main.o Foo.o Bar.o Main_c.o Bar_c.o -lm -o Main +cabal repl --ghc-options='-fobject-code -O0' ``` [ghc-manual-quasiquotation]: diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/examples/gsl-ode.c b/examples/gsl-ode.c deleted file mode 100644 --- a/examples/gsl-ode.c +++ /dev/null @@ -1,50 +0,0 @@ - -#include - -#include - -#include - -int inline_c_Main_0_31a6738e02530b20854a5ca8638293b1032edaf3() { -return ( GSL_SUCCESS ); -} - - -int inline_c_Main_1_a6e274e32d1c2e90339edd389a8b86d3fe8dae07(int (* funIO_inline_c_0)(double t, const double y[], double dydt[], void * params), int dim_c_inline_c_1, double x0_inline_c_2, double xend_inline_c_3, double * fMut_inline_c_4) { - - gsl_odeiv2_system sys = { - funIO_inline_c_0, - // The ODE to solve, converted to function pointer using the `fun` - // anti-quoter - NULL, // We don't provide a Jacobian - dim_c_inline_c_1, // The dimension - NULL // We don't need the parameter pointer - }; - // Create the driver, using some sensible values for the stepping - // function and the tolerances - gsl_odeiv2_driver *d = gsl_odeiv2_driver_alloc_y_new ( - &sys, gsl_odeiv2_step_rk8pd, 1e-6, 1e-6, 0.0); - // Finally, apply the driver. - int status = gsl_odeiv2_driver_apply( - d, &x0_inline_c_2, xend_inline_c_3, fMut_inline_c_4); - // Free the driver - gsl_odeiv2_driver_free(d); - return status; - -} - - -int inline_c_Main_2_189238c774f5c8439b92bfd53fe3cdd4e56f6e81() { -return ( GSL_EMAXITER ); -} - - -int inline_c_Main_3_b4b4adc018e7fe003e77992771fc803668198b63() { -return ( GSL_ENOPROG ); -} - - -int inline_c_Main_4_31a6738e02530b20854a5ca8638293b1032edaf3() { -return ( GSL_SUCCESS ); -} - diff --git a/inline-c.cabal b/inline-c.cabal --- a/inline-c.cabal +++ b/inline-c.cabal @@ -1,12 +1,12 @@ name: inline-c -version: 0.5.6.1 +version: 0.6.0.0 synopsis: Write Haskell source files including C code inline. No FFI required. description: See . license: MIT license-file: LICENSE author: Francesco Mazzoli, Mathieu Boespflug maintainer: francesco@fpcomplete.com -copyright: (c) 2015 FP Complete Corporation +copyright: (c) 2015-2016 FP Complete Corporation, (c) 2017 Francesco Mazzoli category: FFI tested-with: GHC == 7.8.4, GHC == 7.10.1 build-type: Simple @@ -39,13 +39,11 @@ , bytestring , containers , cryptohash - , directory - , filepath , hashable , mtl , parsec >= 3 , parsers - , template-haskell >= 2.9 + , template-haskell >= 2.12.0.0 , transformers >= 0.1.3.0 , unordered-containers , vector @@ -56,7 +54,6 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: tests.hs - c-sources: test/tests.c other-modules: Dummy , Language.C.Inline.ContextSpec , Language.C.Inline.ParseSpec @@ -81,7 +78,6 @@ executable gsl-ode hs-source-dirs: examples main-is: gsl-ode.hs - c-sources: examples/gsl-ode.c default-language: Haskell2010 extra-libraries: gsl gslcblas m ghc-options: -Wall diff --git a/src/Language/C/Inline/Context.hs b/src/Language/C/Inline/Context.hs --- a/src/Language/C/Inline/Context.hs +++ b/src/Language/C/Inline/Context.hs @@ -61,6 +61,7 @@ import Foreign.Ptr (Ptr, FunPtr, freeHaskellFunPtr) import Foreign.Storable (Storable) import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Syntax as TH import qualified Text.Parser.Token as Parser import qualified Data.HashSet as HashSet @@ -141,28 +142,27 @@ -- ^ Needed to convert C types to Haskell types. , ctxAntiQuoters :: AntiQuoters -- ^ Needed to parse and process antiquotations. - , ctxFileExtension :: Maybe String - -- ^ Will determine the extension of the file containing the inline - -- C snippets. , ctxOutput :: Maybe (String -> String) -- ^ This function is used to post-process the functions generated -- from the C snippets. Currently just used to specify C linkage -- when generating C++ code. + , ctxForeignSrcLang :: Maybe TH.ForeignSrcLang + -- ^ TH.LangC by default } instance Monoid Context where mempty = Context { ctxTypesTable = mempty , ctxAntiQuoters = mempty - , ctxFileExtension = Nothing , ctxOutput = Nothing + , ctxForeignSrcLang = Nothing } mappend ctx2 ctx1 = Context { ctxTypesTable = ctxTypesTable ctx1 <> ctxTypesTable ctx2 , ctxAntiQuoters = ctxAntiQuoters ctx1 <> ctxAntiQuoters ctx2 - , ctxFileExtension = ctxFileExtension ctx1 <|> ctxFileExtension ctx2 , ctxOutput = ctxOutput ctx1 <|> ctxOutput ctx2 + , ctxForeignSrcLang = ctxForeignSrcLang ctx1 <|> ctxForeignSrcLang ctx2 } -- | Context useful to work with vanilla C. Used by default. @@ -294,7 +294,7 @@ Just hsType -> return hsType -- | This 'Context' adds support for 'ForeignPtr' arguments. It adds a unique --- marshaller called @fptr-ptr@. For example, @$fptr-ptr:$(int *x)@ extracts the +-- marshaller called @fptr-ptr@. For example, @$fptr-ptr:(int *x)@ extracts the -- bare C pointer out of foreign pointer @x@. fptrCtx :: Context fptrCtx = mempty diff --git a/src/Language/C/Inline/Internal.hs b/src/Language/C/Inline/Internal.hs --- a/src/Language/C/Inline/Internal.hs +++ b/src/Language/C/Inline/Internal.hs @@ -10,6 +10,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE MonoLocalBinds #-} module Language.C.Inline.Internal ( -- * Context handling @@ -50,8 +51,7 @@ ) where import Control.Applicative -import Control.Exception (catch, throwIO) -import Control.Monad (forM, void, msum, unless) +import Control.Monad (forM, void, msum) import Control.Monad.State (evalStateT, StateT, get, put) import Control.Monad.Trans.Class (lift) import qualified Crypto.Hash as CryptoHash @@ -64,9 +64,6 @@ import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Quote as TH import qualified Language.Haskell.TH.Syntax as TH -import System.Directory (removeFile) -import System.FilePath (addExtension, dropExtension) -import System.IO.Error (isDoesNotExistError) import System.IO.Unsafe (unsafePerformIO) import qualified Text.Parsec as Parsec import qualified Text.Parsec.Pos as Parsec @@ -76,7 +73,6 @@ import qualified Text.Parser.Token as Parser import Text.PrettyPrint.ANSI.Leijen ((<+>)) import qualified Text.PrettyPrint.ANSI.Leijen as PP -import System.Environment (getProgName) -- We cannot use getQ/putQ before 7.10.3 because of #define USE_GETQ (__GLASGOW_HASKELL__ > 710 || (__GLASGOW_HASKELL__ == 710 && __GLASGOW_HASKELL_PATCHLEVEL1__ >= 3)) @@ -93,6 +89,7 @@ data ModuleState = ModuleState { msContext :: Context , msGeneratedNames :: Int + , msFileChunks :: [String] } deriving (Typeable) getModuleState :: TH.Q (Maybe ModuleState) @@ -143,18 +140,22 @@ -- 'baseCtx' will be used. -> TH.Q Context initialiseModuleState mbContext = do - mbcFile <- cSourceLoc context mbModuleState <- getModuleState case mbModuleState of Just moduleState -> return (msContext moduleState) Nothing -> do - -- If the file exists and this is the first time we write - -- something from this module (in other words, if we are - -- recompiling the module), kill the file first. - TH.runIO $ forM_ mbcFile $ \cFile -> removeIfExists cFile + -- Add hook to add the file + TH.addModFinalizer $ do + mbMs <- getModuleState + ms <- case mbMs of + Nothing -> fail "inline-c: ModuleState not present (initialiseModuleState)" + Just ms -> return ms + let lang = fromMaybe TH.LangC (ctxForeignSrcLang context) + TH.addForeignFile lang (concat (reverse (msFileChunks ms))) let moduleState = ModuleState { msContext = context , msGeneratedNames = 0 + , msFileChunks = mempty } putModuleState moduleState return context @@ -170,7 +171,7 @@ modifyModuleState f = do mbModuleState <- getModuleState case mbModuleState of - Nothing -> fail "inline-c: ModuleState not present" + Nothing -> fail "inline-c: ModuleState not present (modifyModuleState)" Just ms -> do let (ms', x) = f ms putModuleState ms' @@ -202,36 +203,14 @@ ------------------------------------------------------------------------ -- Emitting --- | Return the path in which to emit C code. Or 'Nothing' if emitting should be --- inhibited, say because we're only type checking the module, not emitting code --- (e.g. with @-fno-code@ or in @haddock@) -cSourceLoc :: Context -> TH.Q (Maybe FilePath) -cSourceLoc ctx = do - prog <- TH.runIO getProgName - -- Hard-code a common case for not generating code. haddock just - -- type-checks, so we do not need to generate the C file again. - -- See issue #24. - let emitCode = prog /= "haddock" - if not emitCode - then return Nothing - else do - thisFile <- TH.loc_filename <$> TH.location - let ext = fromMaybe "c" $ ctxFileExtension ctx - return $ Just $ dropExtension thisFile `addExtension` ext - -removeIfExists :: FilePath -> IO () -removeIfExists fileName = removeFile fileName `catch` handleExists - where - handleExists e = unless (isDoesNotExistError e) $ throwIO e - -- | Simply appends some string to the module's C file. Use with care. emitVerbatim :: String -> TH.DecsQ emitVerbatim s = do - ctx <- getContext - mbCFile <- cSourceLoc ctx - case mbCFile of - Nothing -> return () - Just cFile -> TH.runIO $ appendFile cFile $ "\n" ++ s ++ "\n" + -- Make sure that the 'ModuleState' is initialized + void (initialiseModuleState Nothing) + let chunk = "\n" ++ s ++ "\n" + modifyModuleState $ \ms -> + (ms{msFileChunks = chunk : msFileChunks ms}, ()) return [] ------------------------------------------------------------------------ diff --git a/test/tests.c b/test/tests.c deleted file mode 100644 --- a/test/tests.c +++ /dev/null @@ -1,152 +0,0 @@ - -#include - -#include - -#include - -#include - - -int francescos_mul(int x, int y) { - return x * y; -} - - - int francescos_add(int x, int y) { int z = x + y; return z; } - -int inline_c_Main_0_23225c6b2d15328585f210dc2f989269e95d08ee(int x) { - return x + 3; -} - - -int inline_c_Main_1_7ac34f446e8519c3b967b9fafdc79c95552f35e4() { -return ( 1 + 4 ); -} - - -int inline_c_Main_2_5fdbbe6da0475522165cd251c48497d38f4710fb(int x_inline_c_0, int y_inline_c_1) { -return ( x_inline_c_0 + y_inline_c_1 + 5 ); -} - - -int inline_c_Main_3_856f16273cbef2af269b645953d316cb9426784c(int x_inline_c_0, int y_inline_c_1) { -return ( x_inline_c_0 + 10 + y_inline_c_1 ); -} - - -int inline_c_Main_4_f58397f6204cd35d25406cea930cdd76127e7a8d(int x_inline_c_0, int y_inline_c_1) { -return ( 7 + x_inline_c_0 + y_inline_c_1 ); -} - - -int inline_c_Main_5_f58397f6204cd35d25406cea930cdd76127e7a8d(int x_inline_c_0, int y_inline_c_1) { -return ( 7 + x_inline_c_0 + y_inline_c_1 ); -} - - -void inline_c_Main_6_bbad659b194c6226bc20ec8262bc1c599dddeb28() { - printf("Hello\n") ; -} - - -ptrdiff_t inline_c_Main_7_4475cd73db749194709e394483ff3e5205688ff8(ptrdiff_t x_inline_c_0) { - char a[2]; return &a[1] - &a[0] + x_inline_c_0; -} - - -size_t inline_c_Main_8_9782c357435fb488c3166bf10e839da13328001e() { -return ( sizeof (char) ); -} - - -uintmax_t inline_c_Main_9_c0df91f70bbf1f85671339d1bdc524414e112cc2() { -return ( UINTMAX_MAX ); -} - - -int16_t inline_c_Main_10_9e29ba00e56a81c765067e09a3136fa5232d49a0(int16_t x_inline_c_0) { -return ( 1 + x_inline_c_0 ); -} - - -uint32_t inline_c_Main_11_08a42fa8f755a36db897898b73bb7aab5b1b58e1(uint32_t y_inline_c_0) { -return ( y_inline_c_0 * 7 ); -} - - -int inline_c_Main_12_4ffe4d055df0966eedc85f08247aa8880402694a(int (* ackermannPtr_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { -return ( ackermannPtr_inline_c_0(x_inline_c_1, y_inline_c_2) ); -} - - -int (* inline_c_Main_13_7e6957a671db751a0a5b5e9721b3c45002fab68f())(int , int ) { -return ( &francescos_add ); -} - - -int inline_c_Main_14_55555bbb777d25d03fef0a6d6ce9193474a74a35(int (* ackermann__inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { -return ( ackermann__inline_c_0(x_inline_c_1, y_inline_c_2) ); -} - - -int inline_c_Main_15_4ffe4d055df0966eedc85f08247aa8880402694a(int (* ackermannPtr_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { -return ( ackermannPtr_inline_c_0(x_inline_c_1, y_inline_c_2) ); -} - - -int inline_c_Main_16_b7d965842e65c49fcc08b03f70454988290e61e4(int (* ackermann_inline_c_0)(int , int ), int x_inline_c_1, int y_inline_c_2) { -return ( ackermann_inline_c_0(x_inline_c_1, y_inline_c_2) ); -} - - -double inline_c_Main_17_5dce1654ef6186acdb189a6ce36f0a66660eb346(double (* fun_inline_c_0)(double )) { -return ( fun_inline_c_0(3.0) ); -} - - -int inline_c_Main_18_8d0f093895f51773152915c33b75c7aafd8f4f45(int n_inline_c_0, int * ptr_inline_c_1) { - - int i; - int x = 0; - for (i = 0; i < n_inline_c_0; i++) { - x += ptr_inline_c_1[i]; - } - return x; - -} - - -int inline_c_Main_19_62ce8aade5e693f134c6a5c9add3523edab1a63e(long vec_inline_c_0, int * vec_inline_c_1) { - - int i; - int x = 0; - for (i = 0; i < vec_inline_c_0; i++) { - x += vec_inline_c_1[i]; - } - return x; - -} - - -int inline_c_Main_20_75f1401fb8545756b6d329a5352a252bf52db946(long bs_inline_c_0, char * bs_inline_c_1) { - - int i, bits = 0; - for (i = 0; i < bs_inline_c_0; i++) { - char ch = bs_inline_c_1[i]; - bits += (ch * 01001001001ULL & 042104210421ULL) % 017; - } - return bits; - -} - - -int inline_c_Main_21_6fa3d382d3ab7f6d57eec7fbfe64e87fbc2a0ca9(int x_27_inline_c_0) { -return ( x_27_inline_c_0 ); -} - - -int inline_c_Main_22_a3bae806835fddf243d045e57f2ba979bc7961cc(int foobar_inline_c_0) { -return ( foobar_inline_c_0 ); -} -