Move new utilities into D.B.Internal.Utils

Data/ByteString.hs

@@ -231,6 +231,7 @@ import Prelude hiding           (reverse,head,tail,last,init,null
 import Data.Bits                (finiteBitSize, shiftL, (.|.), (.&.))
 
 import Data.ByteString.Internal
+import Data.ByteString.Internal.Utils
 import Data.ByteString.Lazy.Internal (fromStrict, toStrict)
 import Data.ByteString.Unsafe
 

Data/ByteString/Builder/Internal.hs

@@ -134,6 +134,7 @@ import           Data.Semigroup (Semigroup((<>)))
 
 import qualified Data.ByteString               as S
 import qualified Data.ByteString.Internal      as S
+import qualified Data.ByteString.Internal.Utils as S
 import qualified Data.ByteString.Lazy.Internal as L
 import qualified Data.ByteString.Short.Internal as Sh
 

Data/ByteString/Char8.hs

@@ -276,6 +276,7 @@ import Data.ByteString (null,length,tail,init,append
                        )
 
 import Data.ByteString.Internal
+import Data.ByteString.Internal.Utils
 import Data.ByteString.ReadInt
 import Data.ByteString.ReadNat
 

Data/ByteString/Internal.hs

@@ -48,14 +48,6 @@ module Data.ByteString.Internal (
 
         -- * Low level imperative construction
         empty,
-        createf,
-        createfUptoN,
-        createfUptoN',
-        createfAndTrim,
-        createfAndTrim',
-        unsafeCreatef,
-        unsafeCreatefUptoN,
-        unsafeCreatefUptoN',
         create,
         createUptoN,
         createUptoN',
@@ -74,12 +66,6 @@ module Data.ByteString.Internal (
 
         -- * Utilities
         nullForeignPtr,
-        peekfp,
-        pokefp,
-        peekfpByteOff,
-        pokefpByteOff,
-        minusForeignPtr,
-        memcpyf,
         SizeOverflowException,
         overflowError,
         checkedAdd,
@@ -113,6 +99,7 @@ module Data.ByteString.Internal (
         unsafeWithForeignPtr
   ) where
 
+import Data.ByteString.Internal.Utils
 import Prelude hiding (concat, null)
 import qualified Data.List as List
 
@@ -146,7 +133,7 @@ import Data.Data                (Data(..), mkNoRepType)
 import GHC.Base                 (nullAddr#,realWorld#,unsafeChr)
 import GHC.Exts                 (IsList(..))
 import GHC.CString              (unpackCString#)
-import GHC.Exts                 (Addr#, minusAddr#)
+import GHC.Exts                 (Addr#)
 
 #define TIMES_INT_2_AVAILABLE MIN_VERSION_ghc_prim(0,7,0)
 #if TIMES_INT_2_AVAILABLE
@@ -161,18 +148,12 @@ import GHC.Prim                ( timesWord2#
 import Data.Bits               (finiteBitSize)
 #endif
 
-import GHC.IO                   (IO(IO),unsafeDupablePerformIO)
+import GHC.IO                   (IO(IO))
 import GHC.ForeignPtr           (ForeignPtr(ForeignPtr)
 #if __GLASGOW_HASKELL__ < 900
                                 , newForeignPtr_
 #endif
-                                , mallocPlainForeignPtrBytes)
-
-#if MIN_VERSION_base(4,10,0)
-import GHC.ForeignPtr           (plusForeignPtr)
-#else
-import GHC.Prim                 (plusAddr#)
-#endif
+                                )
 
 #if __GLASGOW_HASKELL__ >= 811
 import GHC.CString              (cstringLength#)
@@ -198,42 +179,6 @@ unsafeWithForeignPtr = withForeignPtr
 -- CFILES stuff is Hugs only
 {-# CFILES cbits/fpstring.c #-}
 
-#if !MIN_VERSION_base(4,10,0)
--- |Advances the given address by the given offset in bytes.
---
--- The new 'ForeignPtr' shares the finalizer of the original,
--- equivalent from a finalization standpoint to just creating another
--- reference to the original. That is, the finalizer will not be
--- called before the new 'ForeignPtr' is unreachable, nor will it be
--- called an additional time due to this call, and the finalizer will
--- be called with the same address that it would have had this call
--- not happened, *not* the new address.
-plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b
-plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr offset) guts
-{-# INLINE [0] plusForeignPtr #-}
-{-# RULES
-"ByteString plusForeignPtr/0" forall fp .
-   plusForeignPtr fp 0 = fp
- #-}
-#endif
-
-minusForeignPtr :: ForeignPtr a -> ForeignPtr b -> Int
-minusForeignPtr (ForeignPtr addr1 _) (ForeignPtr addr2 _)
-  = I# (minusAddr# addr1 addr2)
-
-peekfp :: Storable a => ForeignPtr a -> IO a
-peekfp fp = unsafeWithForeignPtr fp peek
-
-pokefp :: Storable a => ForeignPtr a -> a -> IO ()
-pokefp fp val = unsafeWithForeignPtr fp $ \p -> poke p val
-
-peekfpByteOff :: Storable a => ForeignPtr a -> Int -> IO a
-peekfpByteOff fp off = unsafeWithForeignPtr fp $ \p ->
-  peekByteOff p off
-
-pokefpByteOff :: Storable a => ForeignPtr b -> Int -> a -> IO ()
-pokefpByteOff fp off val = unsafeWithForeignPtr fp $ \p ->
-  pokeByteOff p off val
 
 -- -----------------------------------------------------------------------------
 
@@ -588,80 +533,6 @@ toForeignPtr0 :: ByteString -> (ForeignPtr Word8, Int) -- ^ (ptr, length)
 toForeignPtr0 (BS ps l) = (ps, l)
 {-# INLINE toForeignPtr0 #-}
 
--- | A way of creating ByteStrings outside the IO monad. The @Int@
--- argument gives the final size of the ByteString.
-unsafeCreatef :: Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
-unsafeCreatef l f = unsafeDupablePerformIO (createf l f)
-{-# INLINE unsafeCreatef #-}
-
--- | Like 'unsafeCreatef' but instead of giving the final size of the
--- ByteString, it is just an upper bound. The inner action returns
--- the actual size. Unlike 'createfAndTrim' the ByteString is not
--- reallocated if the final size is less than the estimated size.
-unsafeCreatefUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> ByteString
-unsafeCreatefUptoN l f = unsafeDupablePerformIO (createfUptoN l f)
-{-# INLINE unsafeCreatefUptoN #-}
-
-unsafeCreatefUptoN'
-  :: Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)
-unsafeCreatefUptoN' l f = unsafeDupablePerformIO (createfUptoN' l f)
-{-# INLINE unsafeCreatefUptoN' #-}
-
--- | Create ByteString of size @l@ and use action @f@ to fill its contents.
-createf :: Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
-createf l action = do
-    fp <- mallocByteString l
-    action fp
-    return $! BS fp l
-{-# INLINE createf #-}
-
--- | Given a maximum size @l@ and an action @f@ that fills the 'ByteString'
--- starting at the given 'Ptr' and returns the actual utilized length,
--- @`createfUptoN'` l f@ returns the filled 'ByteString'.
-createfUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
-createfUptoN l action = do
-    fp <- mallocByteString l
-    l' <- action fp
-    assert (l' <= l) $ return $! BS fp l'
-{-# INLINE createfUptoN #-}
-
--- | Like 'createfUptoN', but also returns an additional value created by the
--- action.
-createfUptoN' :: Int -> (ForeignPtr Word8 -> IO (Int, a)) -> IO (ByteString, a)
-createfUptoN' l action = do
-    fp <- mallocByteString l
-    (l', res) <- action fp
-    assert (l' <= l) $ return (BS fp l', res)
-{-# INLINE createfUptoN' #-}
-
--- | Given the maximum size needed and a function to make the contents
--- of a ByteString, createfAndTrim makes the 'ByteString'. The generating
--- function is required to return the actual final size (<= the maximum
--- size), and the resulting byte array is reallocated to this size.
---
--- createfAndTrim is the main mechanism for creating custom, efficient
--- ByteString functions, using Haskell or C functions to fill the space.
---
-createfAndTrim :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
-createfAndTrim l action = do
-    fp <- mallocByteString l
-    l' <- action fp
-    if assert (0 <= l' && l' <= l) $ l' >= l
-        then return $! BS fp l
-        else createf l' $ \fp' -> memcpyf fp' fp l'
-{-# INLINE createfAndTrim #-}
-
-createfAndTrim' :: Int -> (ForeignPtr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
-createfAndTrim' l action = do
-    fp <- mallocByteString l
-    (off, l', res) <- action fp
-    if assert (0 <= l' && l' <= l) $ l' >= l
-        then return (BS fp l, res)
-        else do ps <- createf l' $ \fp' ->
-                        memcpyf fp' (fp `plusForeignPtr` off) l'
-                return (ps, res)
-{-# INLINE createfAndTrim' #-}
-
 
 wrapAction :: (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res
 wrapAction = flip withForeignPtr
@@ -718,13 +589,6 @@ createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
 createAndTrim' l action = createfAndTrim' l (wrapAction action)
 {-# INLINE createAndTrim' #-}
 
-
--- | Wrapper of 'Foreign.ForeignPtr.mallocForeignPtrBytes' with faster implementation for GHC
---
-mallocByteString :: Int -> IO (ForeignPtr a)
-mallocByteString = mallocPlainForeignPtrBytes
-{-# INLINE mallocByteString #-}
-
 ------------------------------------------------------------------------
 -- Implementations for Eq, Ord and Monoid instances
 
@@ -1012,15 +876,6 @@ foreign import ccall unsafe "string.h memcmp" c_memcmp
 memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
 memcmp p q s = c_memcmp p q (fromIntegral s)
 
-foreign import ccall unsafe "string.h memcpy" c_memcpy
-    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
-
-memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
-memcpy p q s = void $ c_memcpy p q (fromIntegral s)
-
-memcpyf :: ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
-memcpyf fp fq s = unsafeWithForeignPtr fp $ \p ->
-                    unsafeWithForeignPtr fq $ \q -> memcpy p q s
 
 {-
 foreign import ccall unsafe "string.h memmove" c_memmove

Data/ByteString/Internal.hs-boot

@@ -0,0 +1,11 @@
+-- allow Data.ByteString.Internal.Utils to use the BS constructor
+
+module Data.ByteString.Internal (
+  ByteString (BS)
+) where
+
+import Foreign.ForeignPtr (ForeignPtr)
+import Data.Word (Word8)
+
+data ByteString = BS {-# UNPACK #-} !(ForeignPtr Word8) -- payload
+                     {-# UNPACK #-} !Int                -- length