inline-c 0.5.5.5 → 0.5.5.6

raw patch · 3 files changed

+64/−30 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• inline-c.cabal +1/−1
• src/Language/C/Inline/Internal.hs +56/−27
• test/tests.c +7/−2

@@ -1,5 +1,5 @@ name:                inline-c-version:             0.5.5.5+version:             0.5.5.6 synopsis:            Write Haskell source files including C code inline. No FFI required. description:         See <https://github.com/fpco/inline-c/blob/master/README.md>. license:             MIT

@@ -8,6 +8,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}  module Language.C.Inline.Internal     ( -- * Context handling@@ -48,7 +50,6 @@     ) where  import           Control.Applicative-import           Control.Concurrent.MVar (MVar, newMVar, modifyMVar, readMVar) import           Control.Exception (catch, throwIO) import           Control.Monad (forM, void, msum, unless) import           Control.Monad.State (evalStateT, StateT, get, put)@@ -77,6 +78,13 @@ import qualified Text.PrettyPrint.ANSI.Leijen as PP import           System.Environment (getProgName) +-- We cannot use getQ/putQ before 7.10.3 because of <https://ghc.haskell.org/trac/ghc/ticket/10596>+#define USE_GETQ (__GLASGOW_HASKELL__ >= 710 && defined(__GLASGOW_HASKELL_PATCHLEVEL1__) && __GLASGOW_HASKELL_PATCHLEVEL1__ >= 3)++#if !USE_GETQ+import           Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, readMVar)+#endif+ import           Language.C.Inline.Context import           Language.C.Inline.FunPtr import           Language.C.Inline.HaskellIdentifier@@ -85,8 +93,18 @@ data ModuleState = ModuleState   { msContext :: Context   , msGeneratedNames :: Int-  }+  } deriving (Typeable) +getModuleState :: TH.Q (Maybe ModuleState)+putModuleState :: ModuleState -> TH.Q ()++#if USE_GETQ++getModuleState = TH.getQ+putModuleState = TH.putQ++#else+ -- | Identifier for the current module.  Currently we use the file name. -- Since we're pairing Haskell files with C files, it makes more sense -- to use the file name.  I'm not sure if it's possible to compile two@@ -105,6 +123,18 @@ moduleStatesVar :: MVar (Map.Map ModuleId ModuleState) moduleStatesVar = unsafePerformIO $ newMVar Map.empty +getModuleState = do+  moduleStates <- TH.runIO (readMVar moduleStatesVar)+  moduleId <- getModuleId+  return (Map.lookup moduleId moduleStates)++putModuleState ms = do+  moduleId <- getModuleId+  TH.runIO (modifyMVar_ moduleStatesVar (return . Map.insert moduleId ms))++#endif++ -- | Make sure that 'moduleStatesVar' and the respective C file are up --   to date. initialiseModuleState@@ -114,20 +144,20 @@   -> TH.Q Context initialiseModuleState mbContext = do   mbcFile <- cSourceLoc context-  thisModule <- getModuleId-  TH.runIO $ modifyMVar moduleStatesVar $ \moduleStates -> do-    case Map.lookup thisModule moduleStates of-      Just moduleState -> return (moduleStates, 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.-        forM_ mbcFile $ \cFile -> removeIfExists cFile-        let moduleState = ModuleState-              { msContext = context-              , msGeneratedNames = 0-              }-        return (Map.insert thisModule moduleState moduleStates, 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+      let moduleState = ModuleState+            { msContext = context+            , msGeneratedNames = 0+            }+      putModuleState moduleState+      return context   where     context = fromMaybe baseCtx mbContext @@ -138,13 +168,13 @@  modifyModuleState :: (ModuleState -> (ModuleState, a)) -> TH.Q a modifyModuleState f = do-  thisModule <- getModuleId-  TH.runIO $ modifyMVar moduleStatesVar $ \moduleStates ->-    case Map.lookup thisModule moduleStates of-      Nothing -> fail "inline-c: ModuleState not present"-      Just ms -> do-        let (ms', x) = f ms-        return (Map.insert thisModule ms' moduleStates, x)+  mbModuleState <- getModuleState+  case mbModuleState of+    Nothing -> fail "inline-c: ModuleState not present"+    Just ms -> do+      let (ms', x) = f ms+      putModuleState ms'+      return x  -- $context --@@ -158,9 +188,8 @@ -- module.  Fails if that's not the case. setContext :: Context -> TH.Q () setContext ctx = do-  thisModule <- getModuleId-  moduleStates <- TH.runIO $ readMVar moduleStatesVar-  forM_ (Map.lookup thisModule moduleStates) $ \_ms ->+  mbModuleState <- getModuleState+  forM_ mbModuleState $ \_ms ->     fail "inline-c: The module has already been initialised (setContext)."   void $ initialiseModuleState $ Just ctx @@ -302,7 +331,7 @@ --   TH.Unsafe --   [t| Double -> Double |] --   (quickCParser_ \"double\" parseType)---   [("x", quickCParser_ \"double\") parseType]+--   [("x", quickCParser_ \"double\" parseType)] --   "cos(x)") -- @ inlineExp

@@ -146,7 +146,12 @@ }  -int inline_c_Main_22_a3bae806835fddf243d045e57f2ba979bc7961cc(int foobar_inline_c_0) {-return ( foobar_inline_c_0 );+int inline_c_Main_22_dbf060cb8fa2b86c6c6838ef9b645ac20f38ba79(int _e4_inline_c_0) {+return ( _e4_inline_c_0 );+}+++int inline_c_Main_23_2421969c444755bea2c6f2060e0921ce7f3d16d7(int PreludemaxBound_2e_inline_c_0) {+return ( PreludemaxBound_2e_inline_c_0 ); }