Sync with FPS head.

Mon May  8 10:40:14 EST 2006  Don Stewart <dons@cse.unsw.edu.au>
  * Fix all uses for Int that should be CInt or CSize in ffi imports.
  Spotted by Igloo, dcoutts

Mon May  8 16:09:41 EST 2006  Don Stewart <dons@cse.unsw.edu.au>
  * Import nicer loop/loop fusion rule from ghc-ndp

Mon May  8 17:36:07 EST 2006  Don Stewart <dons@cse.unsw.edu.au>
  * Fix stack leak in split on > 60M strings

Mon May  8 17:50:13 EST 2006  Don Stewart <dons@cse.unsw.edu.au>
  * Try same fix for stack overflow in elemIndices

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
 
- #-}
+  #-}
 

diff --git a/Data/ByteString/Char8.hs b/Data/ByteString/Char8.hs
index a0a3cc4..7b4088c 100644 (file)
--- a/Data/ByteString/Char8.hs
+++ b/Data/ByteString/Char8.hs
@@ -220,7 +220,7 @@ module Data.ByteString.Char8 (
         unpackList,
 #endif
         noAL, NoAL, loopArr, loopAcc, loopSndAcc,
-        loopU, mapEFL, filterEFL,
+        loopU, mapEFL, filterEFL, foldEFL, fuseEFL,
         filterF, mapF
 
     ) where
@@ -254,7 +254,7 @@ import Data.ByteString (ByteString(..)
                        ,unpackList
 #endif
                        ,noAL, NoAL, loopArr, loopAcc, loopSndAcc
-                       ,loopU, mapEFL, filterEFL
+                       ,loopU, mapEFL, filterEFL, foldEFL, fuseEFL
                        ,useAsCString, unsafeUseAsCString
                        )