From b9756aa906e938841a289c23fd637f19a40f9c5f Mon Sep 17 00:00:00 2001 From: Don Stewart Date: Mon, 8 May 2006 12:23:22 +0000 Subject: [PATCH] Sync with FPS head. Mon May 8 10:40:14 EST 2006 Don Stewart * 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 * Import nicer loop/loop fusion rule from ghc-ndp Mon May 8 17:36:07 EST 2006 Don Stewart * Fix stack leak in split on > 60M strings Mon May 8 17:50:13 EST 2006 Don Stewart * Try same fix for stack overflow in elemIndices --- Data/ByteString.hs | 61 ++++++++++++++++++++++++++-------------------- Data/ByteString/Char8.hs | 4 +-- 2 files changed, 36 insertions(+), 29 deletions(-) diff --git a/Data/ByteString.hs b/Data/ByteString.hs index 85d2054..bf9b04b 100644 --- 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 --- 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 ) -- 1.7.10.4