Sync with FPS head.

[ghc-base.git] / Data / ByteString.hs

diff --git a/Data/ByteString.hs b/Data/ByteString.hs
index 85d2054..bf9b04b 100644 (file)
--- a/Data/ByteString.hs
+++ b/Data/ByteString.hs
@@ -227,7 +227,7 @@ module Data.ByteString (
 #endif
 
         noAL, NoAL, loopArr, loopAcc, loopSndAcc,
-        loopU, mapEFL, filterEFL, foldEFL,
+        loopU, mapEFL, filterEFL, foldEFL, fuseEFL,
         filterF, mapF
 
   ) where
@@ -990,10 +990,11 @@ splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString]
 
 #if defined(__GLASGOW_HASKELL__)
 splitWith _pred (PS _  _   0) = []
-splitWith pred_ (PS fp off len) = splitWith' pred# off len fp
+splitWith pred_ (PS fp off len) = splitWith0 pred# off len fp
   where pred# c# = pred_ (W8# c#)
 
-        splitWith' pred' off' len' fp' = withPtr fp $ \p ->
+        STRICT4(splitWith0)
+        splitWith0 pred' off' len' fp' = withPtr fp $ \p ->
             splitLoop pred' p 0 off' len' fp'
 
         splitLoop :: (Word# -> Bool)
@@ -1009,7 +1010,7 @@ splitWith pred_ (PS fp off len) = splitWith' pred# off len fp
                 w <- peekElemOff p (off'+idx')
                 if pred' (case w of W8# w# -> w#)
                    then return (PS fp' off' idx' :
-                              splitWith' pred' (off'+idx'+1) (len'-idx'-1) fp')
+                              splitWith0 pred' (off'+idx'+1) (len'-idx'-1) fp')
                    else splitLoop pred' p (idx'+1) off' len' fp'
 {-# INLINE splitWith #-}
 
@@ -1048,11 +1049,10 @@ split w (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do
         loop n = do
             let q = memchr (ptr `plusPtr` n) w (fromIntegral (l-n))
             if q == nullPtr
-                then return [PS x (s+n) (l-n)]
-                else do let i = q `minusPtr` ptr
-                        ls <- loop (i+1)
-                        return $! PS x (s+n) (i-n) : ls
-    loop 0
+                then [PS x (s+n) (l-n)]
+                else let i = q `minusPtr` ptr in PS x (s+n) (i-n) : loop (i+1)
+
+    return (loop 0)
 {-# INLINE split #-}
 
 {-
@@ -1189,14 +1189,12 @@ elemIndices w (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do
     let ptr = p `plusPtr` s
 
         STRICT1(loop)
-        loop n = do
-                let q = memchr (ptr `plusPtr` n) w (fromIntegral (l - n))
-                if q == nullPtr
-                    then return []
-                    else do let i = q `minusPtr` ptr
-                            ls <- loop (i+1)
-                            return $! i:ls
-    loop 0
+        loop n = let q = memchr (ptr `plusPtr` n) w (fromIntegral (l - n))
+                 in if q == nullPtr
+                        then []
+                        else let i = q `minusPtr` ptr
+                             in i : loop (i+1)
+    return (loop 0)
 
 {-
 -- much slower
@@ -2192,7 +2190,7 @@ loopU f start (PS z s i) = inlinePerformIO $ withForeignPtr z $ \a -> do
             then return (fp,i,acc)                      -- no realloc for map
             else do fp_ <- mallocByteString (i'+1)      -- realloc
                     withForeignPtr fp_ $ \p' -> do
-                        memcpy p' p (fromIntegral i')
+                        memcpy p' p (fromIntegral i')   -- can't avoid this,  right?
                         poke (p' `plusPtr` i') (0::Word8)
                     return (fp_,i',acc)
 
@@ -2214,17 +2212,26 @@ loopU f start (PS z s i) = inlinePerformIO $ withForeignPtr z $ \a -> do
 
 {-# INLINE [1] loopU #-}
 
+infixr 9 `fuseEFL`
+
+-- |Fuse to flat loop functions
+fuseEFL :: (a1 -> Word8  -> (a1, Maybe Word8))
+        -> (a2 -> Word8  -> (a2, Maybe Word8))
+        -> (a1, a2)
+        -> Word8
+        -> ((a1, a2), Maybe Word8)
+fuseEFL f g (acc1, acc2) e1 =
+    case f acc1 e1 of
+        (acc1', Nothing) -> ((acc1', acc2), Nothing)
+        (acc1', Just e2) ->
+            case g acc2 e2 of
+                (acc2', res) -> ((acc1', acc2'), res)
+
 {-# RULES
 
-"array fusion!" forall em1 em2 start1 start2 arr.
+"Array fusion!" forall em1 em2 start1 start2 arr.
   loopU em2 start2 (loopArr (loopU em1 start1 arr)) =
-    let em (acc1, acc2) e =
-            case em1 acc1 e of
-                (acc1', Nothing) -> ((acc1', acc2), Nothing)
-                (acc1', Just e') ->
-                    case em2 acc2 e' of
-                        (acc2', res) -> ((acc1', acc2'), res)
-    in loopSndAcc (loopU em (start1, start2) arr)
+    loopSndAcc (loopU (em1 `fuseEFL` em2) (start1, start2) arr)
 
 "loopArr/loopSndAcc" forall x.
   loopArr (loopSndAcc x) = loopArr x
@@ -2232,5 +2239,5 @@ loopU f start (PS z s i) = inlinePerformIO $ withForeignPtr z $ \a -> do
 "seq/NoAL" forall (u::NoAL) e.
   u `seq` e = e
 
- #-}
+  #-}