[commit: packages/binary] master: Use accursedUnutterablePerformIO rather than inlinePerformIO. (37983d3)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/binary

On branch  : master
Link       : http://git.haskell.org/packages/binary.git/commitdiff/37983d3eeeed7e332a4931cda066becded3b4fe6

>---------------------------------------------------------------

commit 37983d3eeeed7e332a4931cda066becded3b4fe6
Author: Lennart Kolmodin <kolmodin at gmail.com>
Date:   Sun Dec 20 23:29:38 2015 +0100

    Use accursedUnutterablePerformIO rather than inlinePerformIO.
    
    Let's share the address space with a malevolent agent of chaos.


>---------------------------------------------------------------

37983d3eeeed7e332a4931cda066becded3b4fe6
 binary.cabal                    |  3 ++-
 src/Data/Binary/Builder/Base.hs |  4 ++--
 src/Data/Binary/Get/Internal.hs |  5 +++--
 src/Data/Binary/Internal.hs     | 15 +++++++++++++++
 4 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/binary.cabal b/binary.cabal
index 25c7c7c..f772d27 100644
--- a/binary.cabal
+++ b/binary.cabal
@@ -41,7 +41,8 @@ library
                    Data.Binary.Builder.Internal
 
   other-modules:   Data.Binary.Builder.Base,
-                   Data.Binary.Class
+                   Data.Binary.Class,
+                   Data.Binary.Internal
 
   if impl(ghc >= 7.2.1)
     cpp-options: -DGENERICS
diff --git a/src/Data/Binary/Builder/Base.hs b/src/Data/Binary/Builder/Base.hs
index ade8de7..1b1c0b1 100644
--- a/src/Data/Binary/Builder/Base.hs
+++ b/src/Data/Binary/Builder/Base.hs
@@ -74,7 +74,7 @@ import Foreign
 
 import System.IO.Unsafe as IO ( unsafePerformIO )
 
-import Data.ByteString.Internal (inlinePerformIO)
+import Data.Binary.Internal ( accursedUnutterablePerformIO )
 import qualified Data.ByteString.Internal as S
 import qualified Data.ByteString.Lazy.Internal as L
 
@@ -198,7 +198,7 @@ flush = Builder $ \ k buf@(Buffer p o u l) ->
       then k buf
       else let !b  = Buffer p (o+u) 0 l
                !bs = S.PS p o u
-           in return $! L.Chunk bs (inlinePerformIO (k b))
+           in return $! L.Chunk bs (accursedUnutterablePerformIO (k b))
 {-# INLINE [0] flush #-}
 
 ------------------------------------------------------------------------
diff --git a/src/Data/Binary/Get/Internal.hs b/src/Data/Binary/Get/Internal.hs
index 74e8eba..9dcd22c 100644
--- a/src/Data/Binary/Get/Internal.hs
+++ b/src/Data/Binary/Get/Internal.hs
@@ -44,12 +44,13 @@ module Data.Binary.Get.Internal (
 
 import Foreign
 import qualified Data.ByteString as B
-import qualified Data.ByteString.Internal as B
 import qualified Data.ByteString.Unsafe as B
 
 import Control.Applicative
 import Control.Monad
 
+import Data.Binary.Internal ( accursedUnutterablePerformIO )
+
 #if __GLASGOW_HASKELL__ < 704 && !defined(__HADDOCK__)
 -- needed for (# unboxing #) with magic hash
 -- Do we still need these? Works without on modern GHCs.
@@ -415,5 +416,5 @@ unsafeReadN !n f = C $ \inp ks -> do
 
 readNWith :: Int -> (Ptr a -> IO a) -> Get a
 readNWith n f = do
-    readN n $ \s -> B.inlinePerformIO $ B.unsafeUseAsCString s (f . castPtr)
+    readN n $ \s -> accursedUnutterablePerformIO $ B.unsafeUseAsCString s (f . castPtr)
 {-# INLINE readNWith #-}
diff --git a/src/Data/Binary/Internal.hs b/src/Data/Binary/Internal.hs
new file mode 100644
index 0000000..d04b728
--- /dev/null
+++ b/src/Data/Binary/Internal.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE CPP #-}
+
+module Data.Binary.Internal 
+ ( accursedUnutterablePerformIO ) where
+
+#if MIN_VERSION_bytestring(0,10,6)
+import Data.ByteString.Internal( accursedUnutterablePerformIO )
+#else
+import Data.ByteString.Internal( inlinePerformIO )
+
+{-# INLINE accursedUnutterablePerformIO #-}
+-- | You must be truly desperate to come to me for help.
+accursedUnutterablePerformIO :: IO a -> a
+accursedUnutterablePerformIO = inlinePerformIO
+#endif