X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FByteString.hs;h=8e9e919724c3c8fde448ea2ede8bc84511e9ac54;hb=6b1a36a595eddf1e124529646afdb75c76a9966d;hp=06ace6be9eb6842be33dca2e95563527975ce9a1;hpb=4c6a5640f35898d9f3526b98a5b89e6af9d793a9;p=haskell-directory.git diff --git a/Data/ByteString.hs b/Data/ByteString.hs index 06ace6b..8e9e919 100644 --- a/Data/ByteString.hs +++ b/Data/ByteString.hs @@ -1,13 +1,12 @@ -{-# OPTIONS_GHC -cpp -fffi -fglasgow-exts #-} --- --- Module : ByteString +{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-} +-- | +-- Module : Data.ByteString -- Copyright : (c) The University of Glasgow 2001, -- (c) David Roundy 2003-2005, -- (c) Simon Marlow 2005 -- (c) Don Stewart 2005-2006 -- (c) Bjorn Bringert 2006 --- --- Array fusion code: +-- Array fusion code: -- (c) 2001,2002 Manuel M T Chakravarty & Gabriele Keller -- (c) 2006 Manuel M T Chakravarty & Roman Leshchinskiy -- @@ -15,69 +14,63 @@ -- -- Maintainer : dons@cse.unsw.edu.au -- Stability : experimental --- Portability : portable, requires ffi and cpp --- Tested with : GHC 6.4.1 and Hugs March 2005 +-- Portability : portable -- - --- --- | A time and space-efficient implementation of byte vectors using +-- A time and space-efficient implementation of byte vectors using -- packed Word8 arrays, suitable for high performance use, both in terms -- of large data quantities, or high speed requirements. Byte vectors --- are encoded as strict Word8 arrays of bytes, held in a ForeignPtr, +-- are encoded as strict 'Word8' arrays of bytes, held in a 'ForeignPtr', -- and can be passed between C and Haskell with little effort. -- -- This module is intended to be imported @qualified@, to avoid name --- clashes with Prelude functions. eg. +-- clashes with "Prelude" functions. eg. -- -- > import qualified Data.ByteString as B -- --- Original GHC implementation by Bryan O\'Sullivan. Rewritten to use --- UArray by Simon Marlow. Rewritten to support slices and use --- ForeignPtr by David Roundy. Polished and extended by Don Stewart. +-- Original GHC implementation by Bryan O\'Sullivan. +-- Rewritten to use 'Data.Array.Unboxed.UArray' by Simon Marlow. +-- Rewritten to support slices and use 'ForeignPtr' by David Roundy. +-- Polished and extended by Don Stewart. -- module Data.ByteString ( -- * The @ByteString@ type - ByteString(..), -- instances: Eq, Ord, Show, Read, Data, Typeable + ByteString, -- abstract, instances: Eq, Ord, Show, Read, Data, Typeable, Monoid -- * Introducing and eliminating 'ByteString's empty, -- :: ByteString - packByte, -- :: Word8 -> ByteString + singleton, -- :: Word8 -> ByteString pack, -- :: [Word8] -> ByteString unpack, -- :: ByteString -> [Word8] - packWith, -- :: (a -> Word8) -> [a] -> ByteString - unpackWith, -- :: (Word8 -> a) -> ByteString -> [a] -- * Basic interface cons, -- :: Word8 -> ByteString -> ByteString snoc, -- :: ByteString -> Word8 -> ByteString - null, -- :: ByteString -> Bool - length, -- :: ByteString -> Int + append, -- :: ByteString -> ByteString -> ByteString head, -- :: ByteString -> Word8 - tail, -- :: ByteString -> ByteString last, -- :: ByteString -> Word8 + tail, -- :: ByteString -> ByteString init, -- :: ByteString -> ByteString - append, -- :: ByteString -> ByteString -> ByteString - - -- * Special ByteStrings - inits, -- :: ByteString -> [ByteString] - tails, -- :: ByteString -> [ByteString] - elems, -- :: ByteString -> [ByteString] + null, -- :: ByteString -> Bool + length, -- :: ByteString -> Int -- * Transformating ByteStrings map, -- :: (Word8 -> Word8) -> ByteString -> ByteString reverse, -- :: ByteString -> ByteString intersperse, -- :: Word8 -> ByteString -> ByteString transpose, -- :: [ByteString] -> [ByteString] - map', -- :: (Word8 -> Word8) -> ByteString -> ByteString - -- * Reducing 'ByteString's + -- * Reducing 'ByteString's (folds) foldl, -- :: (a -> Word8 -> a) -> a -> ByteString -> a - foldr, -- :: (Word8 -> a -> a) -> a -> ByteString -> a + foldl', -- :: (a -> Word8 -> a) -> a -> ByteString -> a foldl1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 + foldl1', -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 + + foldr, -- :: (Word8 -> a -> a) -> a -> ByteString -> a + foldr', -- :: (Word8 -> a -> a) -> a -> ByteString -> a foldr1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 - foldl', -- :: (a -> Word8 -> a) -> a -> ByteString -> a + foldr1', -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 -- ** Special folds concat, -- :: [ByteString] -> ByteString @@ -86,11 +79,23 @@ module Data.ByteString ( all, -- :: (Word8 -> Bool) -> ByteString -> Bool maximum, -- :: ByteString -> Word8 minimum, -- :: ByteString -> Word8 + + -- * Building ByteStrings + -- ** Scans + scanl, -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString + scanl1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString + scanr, -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString + scanr1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString + + -- ** Accumulating maps + mapAccumL, -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) + mapAccumR, -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) mapIndexed, -- :: (Int -> Word8 -> Word8) -> ByteString -> ByteString - -- * Generating and unfolding ByteStrings + -- ** Unfolding ByteStrings replicate, -- :: Int -> Word8 -> ByteString - unfoldrN, -- :: (a -> Maybe (Word8, a)) -> a -> ByteString + unfoldr, -- :: (a -> Maybe (Word8, a)) -> a -> ByteString + unfoldrN, -- :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a) -- * Substrings @@ -100,138 +105,107 @@ module Data.ByteString ( splitAt, -- :: Int -> ByteString -> (ByteString, ByteString) takeWhile, -- :: (Word8 -> Bool) -> ByteString -> ByteString dropWhile, -- :: (Word8 -> Bool) -> ByteString -> ByteString - break, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) span, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) spanEnd, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) - - -- ** Breaking and dropping on specific bytes - breakByte, -- :: Word8 -> ByteString -> (ByteString, ByteString) - spanByte, -- :: Word8 -> ByteString -> (ByteString, ByteString) - breakFirst, -- :: Word8 -> ByteString -> Maybe (ByteString,ByteString) - breakLast, -- :: Word8 -> ByteString -> Maybe (ByteString,ByteString) + break, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) + breakEnd, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) + group, -- :: ByteString -> [ByteString] + groupBy, -- :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString] + inits, -- :: ByteString -> [ByteString] + tails, -- :: ByteString -> [ByteString] -- ** Breaking into many substrings split, -- :: Word8 -> ByteString -> [ByteString] splitWith, -- :: (Word8 -> Bool) -> ByteString -> [ByteString] - tokens, -- :: (Word8 -> Bool) -> ByteString -> [ByteString] - group, -- :: ByteString -> [ByteString] - groupBy, -- :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString] -- ** Joining strings join, -- :: ByteString -> [ByteString] -> ByteString - joinWithByte, -- :: Word8 -> ByteString -> ByteString -> ByteString - -- * Indexing ByteStrings - index, -- :: ByteString -> Int -> Word8 - elemIndex, -- :: Word8 -> ByteString -> Maybe Int - elemIndices, -- :: Word8 -> ByteString -> [Int] - elemIndexLast, -- :: Word8 -> ByteString -> Maybe Int - findIndex, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int - findIndices, -- :: (Word8 -> Bool) -> ByteString -> [Int] - count, -- :: Word8 -> ByteString -> Int + -- * Predicates + isPrefixOf, -- :: ByteString -> ByteString -> Bool + isSuffixOf, -- :: ByteString -> ByteString -> Bool - -- * Ordered ByteStrings - sort, -- :: ByteString -> ByteString + -- ** Search for arbitrary substrings + isSubstringOf, -- :: ByteString -> ByteString -> Bool + findSubstring, -- :: ByteString -> ByteString -> Maybe Int + findSubstrings, -- :: ByteString -> ByteString -> [Int] -- * Searching ByteStrings -- ** Searching by equality -- | These functions use memchr(3) to efficiently search the ByteString - elem, -- :: Word8 -> ByteString -> Bool notElem, -- :: Word8 -> ByteString -> Bool - filterByte, -- :: Word8 -> ByteString -> ByteString - filterNotByte, -- :: Word8 -> ByteString -> ByteString -- ** Searching with a predicate - filter, -- :: (Word8 -> Bool) -> ByteString -> ByteString find, -- :: (Word8 -> Bool) -> ByteString -> Maybe Word8 - filter', -- :: (Word8 -> Bool) -> ByteString -> ByteString - - -- ** Prefixes and suffixes - -- | These functions use memcmp(3) to efficiently compare substrings - isPrefixOf, -- :: ByteString -> ByteString -> Bool - isSuffixOf, -- :: ByteString -> ByteString -> Bool + filter, -- :: (Word8 -> Bool) -> ByteString -> ByteString +-- partition -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) - -- ** Search for arbitrary substrings - isSubstringOf, -- :: ByteString -> ByteString -> Bool - findSubstring, -- :: ByteString -> ByteString -> Maybe Int - findSubstrings, -- :: ByteString -> ByteString -> [Int] + -- * Indexing ByteStrings + index, -- :: ByteString -> Int -> Word8 + elemIndex, -- :: Word8 -> ByteString -> Maybe Int + elemIndices, -- :: Word8 -> ByteString -> [Int] + elemIndexEnd, -- :: Word8 -> ByteString -> Maybe Int + findIndex, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int + findIndices, -- :: (Word8 -> Bool) -> ByteString -> [Int] + count, -- :: Word8 -> ByteString -> Int -- * Zipping and unzipping ByteStrings zip, -- :: ByteString -> ByteString -> [(Word8,Word8)] zipWith, -- :: (Word8 -> Word8 -> c) -> ByteString -> ByteString -> [c] unzip, -- :: [(Word8,Word8)] -> (ByteString,ByteString) - -- * Unchecked access - unsafeHead, -- :: ByteString -> Word8 - unsafeTail, -- :: ByteString -> ByteString - unsafeIndex, -- :: ByteString -> Int -> Word8 + -- * Ordered ByteStrings + sort, -- :: ByteString -> ByteString - -- * Low level introduction and elimination - generate, -- :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString - create, -- :: Int -> (Ptr Word8 -> IO ()) -> ByteString - fromForeignPtr, -- :: ForeignPtr Word8 -> Int -> ByteString - toForeignPtr, -- :: ByteString -> (ForeignPtr Word8, Int, Int) - skipIndex, -- :: ByteString -> Int + -- * Low level CString conversions -- ** Packing CStrings and pointers packCString, -- :: CString -> ByteString packCStringLen, -- :: CString -> ByteString packMallocCString, -- :: CString -> ByteString -#if defined(__GLASGOW_HASKELL__) - packCStringFinalizer, -- :: Ptr Word8 -> Int -> IO () -> IO ByteString - packAddress, -- :: Addr# -> ByteString - unsafePackAddress, -- :: Int -> Addr# -> ByteString - unsafeFinalize, -- :: ByteString -> IO () -#endif - -- ** Using ByteStrings as CStrings useAsCString, -- :: ByteString -> (CString -> IO a) -> IO a - unsafeUseAsCString, -- :: ByteString -> (CString -> IO a) -> IO a - unsafeUseAsCStringLen, -- :: ByteString -> (CStringLen -> IO a) -> IO a + useAsCStringLen, -- :: ByteString -> (CStringLen -> IO a) -> IO a -- ** Copying ByteStrings -- | These functions perform memcpy(3) operations copy, -- :: ByteString -> ByteString - copyCString, -- :: CString -> ByteString - copyCStringLen, -- :: CStringLen -> ByteString + copyCString, -- :: CString -> IO ByteString + copyCStringLen, -- :: CStringLen -> IO ByteString - -- * I\/O with @ByteString@s + -- * I\/O with 'ByteString's -- ** Standard input and output - -#if defined(__GLASGOW_HASKELL__) getLine, -- :: IO ByteString -#endif getContents, -- :: IO ByteString putStr, -- :: ByteString -> IO () putStrLn, -- :: ByteString -> IO () + interact, -- :: (ByteString -> ByteString) -> IO () -- ** Files readFile, -- :: FilePath -> IO ByteString writeFile, -- :: FilePath -> ByteString -> IO () + appendFile, -- :: FilePath -> ByteString -> IO () -- mmapFile, -- :: FilePath -> IO ByteString -- ** I\/O with Handles -#if defined(__GLASGOW_HASKELL__) - getArgs, -- :: IO [ByteString] hGetLine, -- :: Handle -> IO ByteString - hGetNonBlocking, -- :: Handle -> Int -> IO ByteString -#endif hGetContents, -- :: Handle -> IO ByteString hGet, -- :: Handle -> Int -> IO ByteString + hGetNonBlocking, -- :: Handle -> Int -> IO ByteString hPut, -- :: Handle -> ByteString -> IO () + hPutStr, -- :: Handle -> ByteString -> IO () + hPutStrLn, -- :: Handle -> ByteString -> IO () - -- * Fusion utilities #if defined(__GLASGOW_HASKELL__) + -- * Fusion utilities unpackList, -- eek, otherwise it gets thrown away by the simplifier + lengthU, maximumU, minimumU #endif - noAL, NoAL, loopArr, loopAcc, loopSndAcc, - loopU, mapEFL, filterEFL, foldEFL, foldEFL', fuseEFL, - ) where import qualified Prelude as P @@ -240,24 +214,28 @@ import Prelude hiding (reverse,head,tail,last,init,null ,concat,any,take,drop,splitAt,takeWhile ,dropWhile,span,break,elem,filter,maximum ,minimum,all,concatMap,foldl1,foldr1 - ,readFile,writeFile,replicate - ,getContents,getLine,putStr,putStrLn + ,scanl,scanl1,scanr,scanr1 + ,readFile,writeFile,appendFile,replicate + ,getContents,getLine,putStr,putStrLn,interact ,zip,zipWith,unzip,notElem) +import Data.ByteString.Base +import Data.ByteString.Fusion + import qualified Data.List as List -import Data.Char import Data.Word (Word8) import Data.Maybe (listToMaybe) import Data.Array (listArray) import qualified Data.Array as Array ((!)) -- Control.Exception.bracket not available in yhc or nhc -import Control.Exception (bracket) +import Control.Exception (bracket, assert) +import qualified Control.Exception as Exception import Control.Monad (when) import Foreign.C.String (CString, CStringLen) -import Foreign.C.Types (CSize, CInt) +import Foreign.C.Types (CSize) import Foreign.ForeignPtr import Foreign.Marshal.Array import Foreign.Ptr @@ -268,23 +246,22 @@ import System.IO (stdin,stdout,hClose,hFileSize ,hGetBuf,hPutBuf,openBinaryFile ,Handle,IOMode(..)) +import Data.Monoid (Monoid, mempty, mappend, mconcat) + #if !defined(__GLASGOW_HASKELL__) import System.IO.Unsafe +import qualified System.Environment +import qualified System.IO (hGetLine) #endif #if defined(__GLASGOW_HASKELL__) -import Data.Generics (Data(..), Typeable(..)) - import System.IO (hGetBufNonBlocking) import System.IO.Error (isEOFError) -import Foreign.Marshal (alloca) -import qualified Foreign.Concurrent as FC (newForeignPtr) - import GHC.Handle -import GHC.Prim (realWorld#, Addr#, Word#, (+#), writeWord8OffAddr#) -import GHC.Base (build, unsafeChr) +import GHC.Prim (Word#, (+#), writeWord8OffAddr#) +import GHC.Base (build) import GHC.Word hiding (Word8) import GHC.Ptr (Ptr(..)) import GHC.ST (ST(..)) @@ -292,9 +269,6 @@ import GHC.IOBase #endif --- CFILES stuff is Hugs only -{-# CFILES cbits/fpstring.c #-} - -- ----------------------------------------------------------------------------- -- -- Useful macros, until we have bang patterns @@ -308,30 +282,16 @@ import GHC.IOBase -- ----------------------------------------------------------------------------- --- | A space-efficient representation of a Word8 vector, supporting many --- efficient operations. A 'ByteString' contains 8-bit characters only. --- --- Instances of Eq, Ord, Read, Show, Data, Typeable --- -data ByteString = PS {-# UNPACK #-} !(ForeignPtr Word8) - {-# UNPACK #-} !Int - {-# UNPACK #-} !Int - -#if defined(__GLASGOW_HASKELL__) - deriving (Data, Typeable) -#endif - instance Eq ByteString where (==) = eq instance Ord ByteString where compare = compareBytes -instance Show ByteString where - showsPrec p ps r = showsPrec p (unpackWith w2c ps) r - -instance Read ByteString where - readsPrec p str = [ (packWith c2w x, y) | (x, y) <- readsPrec p str ] +instance Monoid ByteString where + mempty = empty + mappend = append + mconcat = concat {- instance Arbitrary PackedString where @@ -356,7 +316,7 @@ compareBytes (PS x1 s1 l1) (PS x2 s2 l2) withForeignPtr x1 $ \p1 -> withForeignPtr x2 $ \p2 -> do i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral $ min l1 l2) - return $ case i `compare` 0 of + return $! case i `compare` 0 of EQ -> l1 `compare` l2 x -> x {-# INLINE compareBytes #-} @@ -390,24 +350,17 @@ cmp p1 p2 n len1 len2 -- ----------------------------------------------------------------------------- -- Introducing and eliminating 'ByteString's --- | /O(1)/ The empty 'ByteString' -empty :: ByteString -empty = inlinePerformIO $ mallocByteString 1 >>= \fp -> return $ PS fp 0 0 -{-# NOINLINE empty #-} - -- | /O(1)/ Convert a 'Word8' into a 'ByteString' -packByte :: Word8 -> ByteString -packByte c = unsafePerformIO $ mallocByteString 2 >>= \fp -> do - withForeignPtr fp $ \p -> poke p c - return $ PS fp 0 1 -{-# INLINE packByte #-} +singleton :: Word8 -> ByteString +singleton c = unsafeCreate 1 $ \p -> poke p c +{-# INLINE [1] singleton #-} -- -- XXX The unsafePerformIO is critical! -- -- Otherwise: -- --- packByte 255 `compare` packByte 127 +-- singleton 255 `compare` singleton 127 -- -- is compiled to: -- @@ -429,14 +382,14 @@ pack :: [Word8] -> ByteString #if !defined(__GLASGOW_HASKELL__) -pack str = create (P.length str) $ \p -> go p str +pack str = unsafeCreate (P.length str) $ \p -> go p str where go _ [] = return () go p (x:xs) = poke p x >> go (p `plusPtr` 1) xs -- less space than pokeElemOff #else /* hack away */ -pack str = create (P.length str) $ \(Ptr p) -> stToIO (go p 0# str) +pack str = unsafeCreate (P.length str) $ \(Ptr p) -> stToIO (go p 0# str) where go _ _ [] = return () go p i (W8# c:cs) = writeByte p i c >> go p (i +# 1#) cs @@ -465,6 +418,22 @@ unpack (PS ps s l) = inlinePerformIO $ withForeignPtr ps $ \p -> unpack ps = build (unpackFoldr ps) {-# INLINE unpack #-} +-- +-- critical this isn't strict in the acc +-- as it will break in the presence of list fusion. this is a known +-- issue with seq and build/foldr rewrite rules, which rely on lazy +-- demanding to avoid bottoms in the list. +-- +unpackFoldr :: ByteString -> (Word8 -> a -> a) -> a -> a +unpackFoldr (PS fp off len) f ch = withPtr fp $ \p -> do + let loop q n _ | q `seq` n `seq` False = undefined -- n.b. + loop _ (-1) acc = return acc + loop q n acc = do + a <- peekByteOff q n + loop q (n-1) (a `f` acc) + loop (p `plusPtr` off) (len-1) ch +{-# INLINE [0] unpackFoldr #-} + unpackList :: ByteString -> [Word8] unpackList (PS fp off len) = withPtr fp $ \p -> do let STRICT3(loop) @@ -475,85 +444,60 @@ unpackList (PS fp off len) = withPtr fp $ \p -> do loop (p `plusPtr` off) (len-1) [] {-# RULES -"unpack-list" [1] forall p . unpackFoldr p (:) [] = unpackList p + "FPS unpack-list" [1] forall p . unpackFoldr p (:) [] = unpackList p #-} -unpackFoldr :: ByteString -> (Word8 -> a -> a) -> a -> a -unpackFoldr (PS fp off len) f ch = withPtr fp $ \p -> do - let STRICT3(loop) - loop _ (-1) acc = return acc - loop q n acc = do - a <- peekByteOff q n - loop q (n-1) (a `f` acc) - loop (p `plusPtr` off) (len-1) ch -{-# INLINE [0] unpackFoldr #-} - #endif ------------------------------------------------------------------------- - --- | /O(n)/ Convert a '[a]' into a 'ByteString' using some --- conversion function -packWith :: (a -> Word8) -> [a] -> ByteString -packWith k str = create (P.length str) $ \p -> go p str - where - STRICT2(go) - go _ [] = return () - go p (x:xs) = poke p (k x) >> go (p `plusPtr` 1) xs -- less space than pokeElemOff -{-# INLINE packWith #-} -{-# SPECIALIZE packWith :: (Char -> Word8) -> [Char] -> ByteString #-} - --- | /O(n)/ Converts a 'ByteString' to a '[a]', using a conversion function. -unpackWith :: (Word8 -> a) -> ByteString -> [a] -unpackWith _ (PS _ _ 0) = [] -unpackWith k (PS ps s l) = inlinePerformIO $ withForeignPtr ps $ \p -> - go (p `plusPtr` s) (l - 1) [] - where - STRICT3(go) - go p 0 acc = peek p >>= \e -> return (k e : acc) - go p n acc = peekByteOff p n >>= \e -> go p (n-1) (k e : acc) -{-# INLINE unpackWith #-} -{-# SPECIALIZE unpackWith :: (Word8 -> Char) -> ByteString -> [Char] #-} - -- --------------------------------------------------------------------- -- Basic interface -- | /O(1)/ Test whether a ByteString is empty. null :: ByteString -> Bool -null (PS _ _ l) = l == 0 +null (PS _ _ l) = assert (l >= 0) $ l <= 0 {-# INLINE null #-} +-- --------------------------------------------------------------------- -- | /O(1)/ 'length' returns the length of a ByteString as an 'Int'. length :: ByteString -> Int -length (PS _ _ l) = l +length (PS _ _ l) = assert (l >= 0) $ l + +-- +-- length/loop fusion. When taking the length of any fuseable loop, +-- rewrite it as a foldl', and thus avoid allocating the result buffer +-- worth around 10% in speed testing. +-- #if defined(__GLASGOW_HASKELL__) {-# INLINE [1] length #-} #endif -{-# +lengthU :: ByteString -> Int +lengthU = foldl' (const . (+1)) (0::Int) +{-# INLINE lengthU #-} --- Translate length into a loop. --- Performace ok, but allocates too much, so disable for now. +{-# RULES - "length/loop" forall f acc s . - length (loopArr (loopU f acc s)) = foldl' (const . (+1)) (0::Int) (loopArr (loopU f acc s)) +-- v2 fusion +"FPS length/loop" forall loop s . + length (loopArr (loopWrapper loop s)) = + lengthU (loopArr (loopWrapper loop s)) #-} +------------------------------------------------------------------------ + -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different -- complexity, as it requires a memcpy. cons :: Word8 -> ByteString -> ByteString -cons c (PS x s l) = create (l+1) $ \p -> withForeignPtr x $ \f -> do +cons c (PS x s l) = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do poke p c memcpy (p `plusPtr` 1) (f `plusPtr` s) (fromIntegral l) {-# INLINE cons #-} --- todo fuse - -- | /O(n)/ Append a byte to the end of a 'ByteString' snoc :: ByteString -> Word8 -> ByteString -snoc (PS x s l) c = create (l+1) $ \p -> withForeignPtr x $ \f -> do +snoc (PS x s l) c = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do memcpy p (f `plusPtr` s) (fromIntegral l) poke (p `plusPtr` l) c {-# INLINE snoc #-} @@ -561,13 +505,15 @@ snoc (PS x s l) c = create (l+1) $ \p -> withForeignPtr x $ \f -> do -- todo fuse -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty. +-- An exception will be thrown in the case of an empty ByteString. head :: ByteString -> Word8 -head ps@(PS x s _) - | null ps = errorEmptyList "head" +head (PS x s l) + | l <= 0 = errorEmptyList "head" | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p s {-# INLINE head #-} -- | /O(1)/ Extract the elements after the head of a ByteString, which must be non-empty. +-- An exception will be thrown in the case of an empty ByteString. tail :: ByteString -> ByteString tail (PS p s l) | l <= 0 = errorEmptyList "tail" @@ -575,6 +521,7 @@ tail (PS p s l) {-# INLINE tail #-} -- | /O(1)/ Extract the last element of a ByteString, which must be finite and non-empty. +-- An exception will be thrown in the case of an empty ByteString. last :: ByteString -> Word8 last ps@(PS x s l) | null ps = errorEmptyList "last" @@ -582,9 +529,10 @@ last ps@(PS x s l) {-# INLINE last #-} -- | /O(1)/ Return all the elements of a 'ByteString' except the last one. +-- An exception will be thrown in the case of an empty ByteString. init :: ByteString -> ByteString -init (PS p s l) - | l <= 0 = errorEmptyList "init" +init ps@(PS p s l) + | null ps = errorEmptyList "init" | otherwise = PS p s (l-1) {-# INLINE init #-} @@ -601,19 +549,24 @@ append xs ys | null xs = ys -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each -- element of @xs@. This function is subject to array fusion. map :: (Word8 -> Word8) -> ByteString -> ByteString -map f = loopArr . loopU (mapEFL f) noAL +#if defined(LOOPU_FUSION) +map f = loopArr . loopU (mapEFL f) NoAcc +#elif defined(LOOPUP_FUSION) +map f = loopArr . loopUp (mapEFL f) NoAcc +#elif defined(LOOPNOACC_FUSION) +map f = loopArr . loopNoAcc (mapEFL f) +#else +map f = loopArr . loopMap f +#endif {-# INLINE map #-} +{- -- | /O(n)/ Like 'map', but not fuseable. The benefit is that it is -- slightly faster for one-shot cases. map' :: (Word8 -> Word8) -> ByteString -> ByteString -map' f (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a -> do - np <- mallocByteString (len+1) - withForeignPtr np $ \p -> do - map_ 0 (a `plusPtr` s) p - return (PS np 0 len) +map' f (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a -> + create len $ map_ 0 (a `plusPtr` s) where - map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO () STRICT3(map_) map_ n p1 p2 @@ -623,15 +576,14 @@ map' f (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a -> do pokeByteOff p2 n (f x) map_ (n+1) p1 p2 {-# INLINE map' #-} +-} -- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order. reverse :: ByteString -> ByteString -reverse (PS x s l) = create l $ \p -> withForeignPtr x $ \f -> +reverse (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> c_reverse p (f `plusPtr` s) (fromIntegral l) -{- -reverse = pack . P.reverse . unpack --} +-- todo, fuseable version -- | /O(n)/ The 'intersperse' function takes a 'Word8' and a -- 'ByteString' and \`intersperses\' that byte between the elements of @@ -640,7 +592,7 @@ reverse = pack . P.reverse . unpack intersperse :: Word8 -> ByteString -> ByteString intersperse c ps@(PS x s l) | length ps < 2 = ps - | otherwise = create (2*l-1) $ \p -> withForeignPtr x $ \f -> + | otherwise = unsafeCreate (2*l-1) $ \p -> withForeignPtr x $ \f -> c_intersperse p (f `plusPtr` s) (fromIntegral l) c {- @@ -660,7 +612,11 @@ transpose ps = P.map pack (List.transpose (P.map unpack ps)) -- ByteString using the binary operator, from left to right. -- This function is subject to array fusion. foldl :: (a -> Word8 -> a) -> a -> ByteString -> a +#if !defined(LOOPU_FUSION) +foldl f z = loopAcc . loopUp (foldEFL f) z +#else foldl f z = loopAcc . loopU (foldEFL f) z +#endif {-# INLINE foldl #-} {- @@ -677,38 +633,65 @@ foldl f v (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr -> lgo (f z c) (p `plusPtr` 1) q -} --- | 'foldl\'' is like foldl, but strict in the accumulator. +-- | 'foldl\'' is like 'foldl', but strict in the accumulator. +-- Though actually foldl is also strict in the accumulator. foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a -foldl' f z = loopAcc . loopU (foldEFL' f) z +foldl' = foldl +-- foldl' f z = loopAcc . loopU (foldEFL' f) z {-# INLINE foldl' #-} -- | 'foldr', applied to a binary operator, a starting value -- (typically the right-identity of the operator), and a ByteString, -- reduces the ByteString using the binary operator, from right to left. foldr :: (Word8 -> a -> a) -> a -> ByteString -> a -foldr k z (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr -> - go (ptr `plusPtr` s) (ptr `plusPtr` (s+l)) +foldr k z = loopAcc . loopDown (foldEFL (flip k)) z +{-# INLINE foldr #-} + +-- | 'foldr\'' is like 'foldr', but strict in the accumulator. +foldr' :: (Word8 -> a -> a) -> a -> ByteString -> a +foldr' k v (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr -> + go v (ptr `plusPtr` (s+l-1)) (ptr `plusPtr` (s-1)) where - STRICT2(go) - go p q | p == q = return z - | otherwise = do c <- peek p - ws <- go (p `plusPtr` 1) q - return $ c `k` ws + STRICT3(go) + go z p q | p == q = return z + | otherwise = do c <- peek p + go (c `k` z) (p `plusPtr` (-1)) q -- tail recursive +{-# INLINE [1] foldr' #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value -- argument, and thus must be applied to non-empty 'ByteStrings'. --- This function is subject to array fusion. +-- This function is subject to array fusion. +-- An exception will be thrown in the case of an empty ByteString. foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1 f ps | null ps = errorEmptyList "foldl1" | otherwise = foldl f (unsafeHead ps) (unsafeTail ps) +{-# INLINE foldl1 #-} + +-- | 'foldl1\'' is like 'foldl1', but strict in the accumulator. +-- An exception will be thrown in the case of an empty ByteString. +foldl1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 +foldl1' f ps + | null ps = errorEmptyList "foldl1'" + | otherwise = foldl' f (unsafeHead ps) (unsafeTail ps) +{-# INLINE foldl1' #-} -- | 'foldr1' is a variant of 'foldr' that has no starting value argument, -- and thus must be applied to non-empty 'ByteString's +-- An exception will be thrown in the case of an empty ByteString. foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldr1 f ps | null ps = errorEmptyList "foldr1" | otherwise = foldr f (last ps) (init ps) +{-# INLINE foldr1 #-} + +-- | 'foldr1\'' is a variant of 'foldr1', but is strict in the +-- accumulator. +foldr1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8 +foldr1' f ps + | null ps = errorEmptyList "foldr1" + | otherwise = foldr' f (last ps) (init ps) +{-# INLINE [1] foldr1' #-} -- --------------------------------------------------------------------- -- Special folds @@ -717,7 +700,7 @@ foldr1 f ps concat :: [ByteString] -> ByteString concat [] = empty concat [ps] = ps -concat xs = create len $ \ptr -> go xs ptr +concat xs = unsafeCreate len $ \ptr -> go xs ptr where len = P.sum . P.map length $ xs STRICT2(go) go [] _ = return () @@ -727,7 +710,9 @@ concat xs = create len $ \ptr -> go xs ptr -- | Map a function over a 'ByteString' and concatenate the results concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString -concatMap f = foldr (append . f) empty +concatMap f = concat . foldr ((:) . f) [] + +-- foldr (append . f) empty -- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if -- any element of the 'ByteString' satisfies the predicate. @@ -757,65 +742,130 @@ all f (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr -> if f c then go (p `plusPtr` 1) q else return False --- todo fuse + +------------------------------------------------------------------------ -- | /O(n)/ 'maximum' returns the maximum value from a 'ByteString' +-- This function will fuse. +-- An exception will be thrown in the case of an empty ByteString. maximum :: ByteString -> Word8 maximum xs@(PS x s l) | null xs = errorEmptyList "maximum" | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> - return $ c_maximum (p `plusPtr` s) (fromIntegral l) -{-# INLINE maximum #-} + c_maximum (p `plusPtr` s) (fromIntegral l) -- | /O(n)/ 'minimum' returns the minimum value from a 'ByteString' +-- This function will fuse. +-- An exception will be thrown in the case of an empty ByteString. minimum :: ByteString -> Word8 minimum xs@(PS x s l) | null xs = errorEmptyList "minimum" | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> - return $ c_minimum (p `plusPtr` s) (fromIntegral l) -{-# INLINE minimum #-} + c_minimum (p `plusPtr` s) (fromIntegral l) --- fusion is too slow here (10x) +-- +-- minimum/maximum/loop fusion. As for length (and other folds), when we +-- see we're applied after a fuseable op, switch from using the C +-- version, to the fuseable version. The result should then avoid +-- allocating a buffer. +-- -{- -maximum xs@(PS x s l) - | null xs = errorEmptyList "maximum" - | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> do - w <- peek p - maximum_ (p `plusPtr` s) 0 l w +#if defined(__GLASGOW_HASKELL__) +{-# INLINE [1] minimum #-} +{-# INLINE [1] maximum #-} +#endif -maximum_ :: Ptr Word8 -> Int -> Int -> Word8 -> IO Word8 -STRICT4(maximum_) -maximum_ ptr n m c - | n >= m = return c - | otherwise = do w <- peekByteOff ptr n - maximum_ ptr (n+1) m (if w > c then w else c) +maximumU :: ByteString -> Word8 +maximumU = foldl1' max +{-# INLINE maximumU #-} -minimum xs@(PS x s l) - | null xs = errorEmptyList "minimum" - | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> do - w <- peek p - minimum_ (p `plusPtr` s) 0 l w - -minimum_ :: Ptr Word8 -> Int -> Int -> Word8 -> IO Word8 -STRICT4(minimum_) -minimum_ ptr n m c - | n >= m = return c - | otherwise = do w <- peekByteOff ptr n - minimum_ ptr (n+1) m (if w < c then w else c) --} +minimumU :: ByteString -> Word8 +minimumU = foldl1' min +{-# INLINE minimumU #-} + +{-# RULES + +"FPS minimum/loop" forall loop s . + minimum (loopArr (loopWrapper loop s)) = + minimumU (loopArr (loopWrapper loop s)) + +"FPS maximum/loop" forall loop s . + maximum (loopArr (loopWrapper loop s)) = + maximumU (loopArr (loopWrapper loop s)) + + #-} + +------------------------------------------------------------------------ + +-- | The 'mapAccumL' function behaves like a combination of 'map' and +-- 'foldl'; it applies a function to each element of a ByteString, +-- passing an accumulating parameter from left to right, and returning a +-- final value of this accumulator together with the new list. +mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) +#if !defined(LOOPU_FUSION) +mapAccumL f z = unSP . loopUp (mapAccumEFL f) z +#else +mapAccumL f z = unSP . loopU (mapAccumEFL f) z +#endif +{-# INLINE mapAccumL #-} + +-- | The 'mapAccumR' function behaves like a combination of 'map' and +-- 'foldr'; it applies a function to each element of a ByteString, +-- passing an accumulating parameter from right to left, and returning a +-- final value of this accumulator together with the new ByteString. +mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) +mapAccumR f z = unSP . loopDown (mapAccumEFL f) z +{-# INLINE mapAccumR #-} -- | /O(n)/ map Word8 functions, provided with the index at each position mapIndexed :: (Int -> Word8 -> Word8) -> ByteString -> ByteString -mapIndexed k (PS ps s l) = create l $ \p -> withForeignPtr ps $ \f -> - go 0 (f `plusPtr` s) p (f `plusPtr` s `plusPtr` l) - where - go :: Int -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () - STRICT4(go) - go n f t p | f == p = return () - | otherwise = do w <- peek f - ((poke t) . k n) w - go (n+1) (f `plusPtr` 1) (t `plusPtr` 1) p +mapIndexed f = loopArr . loopUp (mapIndexEFL f) 0 +{-# INLINE mapIndexed #-} + +-- --------------------------------------------------------------------- +-- Building ByteStrings + +-- | 'scanl' is similar to 'foldl', but returns a list of successive +-- reduced values from the left. This function will fuse. +-- +-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...] +-- +-- Note that +-- +-- > last (scanl f z xs) == foldl f z xs. +scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString +#if !defined(LOOPU_FUSION) +scanl f z ps = loopArr . loopUp (scanEFL f) z $ (ps `snoc` 0) +#else +scanl f z ps = loopArr . loopU (scanEFL f) z $ (ps `snoc` 0) +#endif + + -- n.b. haskell's List scan returns a list one bigger than the + -- input, so we need to snoc here to get some extra space, however, + -- it breaks map/up fusion (i.e. scanl . map no longer fuses) +{-# INLINE scanl #-} + +-- | 'scanl1' is a variant of 'scanl' that has no starting value argument. +-- This function will fuse. +-- +-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...] +scanl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString +scanl1 f ps + | null ps = empty + | otherwise = scanl f (unsafeHead ps) (unsafeTail ps) +{-# INLINE scanl1 #-} + +-- | scanr is the right-to-left dual of scanl. +scanr :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString +scanr f z ps = loopArr . loopDown (scanEFL (flip f)) z $ (0 `cons` ps) -- extra space +{-# INLINE scanr #-} + +-- | 'scanr1' is a variant of 'scanr' that has no starting value argument. +scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString +scanr1 f ps + | null ps = empty + | otherwise = scanr f (last ps) (init ps) -- todo, unsafe versions +{-# INLINE scanr1 #-} -- --------------------------------------------------------------------- -- Unfolds and replicates @@ -827,52 +877,51 @@ mapIndexed k (PS ps s l) = create l $ \p -> withForeignPtr ps $ \f -> -- -- This implemenation uses @memset(3)@ replicate :: Int -> Word8 -> ByteString -replicate w c | w <= 0 = empty - | otherwise = create w $ \ptr -> memset ptr c (fromIntegral w) >> return () - -{- --- About 5x slower -replicate w c = inlinePerformIO $ generate w $ \ptr -> go ptr w - where - STRICT2(go) - go _ 0 = return w - go ptr n = poke ptr c >> go (ptr `plusPtr` 1) (n-1) --} - --- | /O(n)/ The 'unfoldrN' function is analogous to the List \'unfoldr\'. --- 'unfoldrN' builds a ByteString from a seed value. The function takes --- the element and returns 'Nothing' if it is done producing the --- ByteString or returns 'Just' @(a,b)@, in which case, @a@ is a --- prepending to the ByteString and @b@ is used as the next element in a --- recursive call. --- --- To preven unfoldrN having /O(n^2)/ complexity (as prepending a --- character to a ByteString is /O(n)/, this unfoldr requires a maximum --- final size of the ByteString as an argument. 'cons' can then be --- implemented in /O(1)/ (i.e. a 'poke'), and the unfoldr itself has --- linear complexity. The depth of the recursion is limited to this --- size, but may be less. For lazy, infinite unfoldr, use --- 'Data.List.unfoldr' (from 'Data.List'). +replicate w c + | w <= 0 = empty + | otherwise = unsafeCreate w $ \ptr -> + memset ptr c (fromIntegral w) >> return () + +-- | /O(n)/, where /n/ is the length of the result. The 'unfoldr' +-- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a +-- ByteString from a seed value. The function takes the element and +-- returns 'Nothing' if it is done producing the ByteString or returns +-- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string, +-- and @b@ is the seed value for further production. -- -- Examples: -- --- > unfoldrN 10 (\x -> Just (x, chr (ord x + 1))) '0' == "0123456789" --- --- The following equation connects the depth-limited unfoldr to the List unfoldr: --- --- > unfoldrN n == take n $ List.unfoldr -unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> ByteString -unfoldrN i f w - | i <= 0 = empty - | otherwise = inlinePerformIO $ generate i $ \p -> go p w 0 - where - STRICT3(go) - go q c n | n == i = return n -- stop if we reach `i' - | otherwise = case f c of - Nothing -> return n - Just (a,new_c) -> do - poke q a - go (q `plusPtr` 1) new_c (n+1) +-- > unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0 +-- > == pack [0, 1, 2, 3, 4, 5] +-- +unfoldr :: (a -> Maybe (Word8, a)) -> a -> ByteString +unfoldr f = concat . unfoldChunk 32 64 + where unfoldChunk n n' x = + case unfoldrN n f x of + (s, Nothing) -> s : [] + (s, Just x') -> s : unfoldChunk n' (n+n') x' + +-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ByteString from a seed +-- value. However, the length of the result is limited by the first +-- argument to 'unfoldrN'. This function is more efficient than 'unfoldr' +-- when the maximum length of the result is known. +-- +-- The following equation relates 'unfoldrN' and 'unfoldr': +-- +-- > unfoldrN n f s == take n (unfoldr f s) +-- +unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a) +unfoldrN i f x0 + | i < 0 = (empty, Just x0) + | otherwise = unsafePerformIO $ createAndTrim' i $ \p -> go p x0 0 + where STRICT3(go) + go p x n = + case f x of + Nothing -> return (0, n, Nothing) + Just (w,x') + | n == i -> return (0, n, Just x) + | otherwise -> do poke p w + go (p `plusPtr` 1) x' (n+1) -- --------------------------------------------------------------------- -- Substrings @@ -881,7 +930,7 @@ unfoldrN i f w -- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@. take :: Int -> ByteString -> ByteString take n ps@(PS x s l) - | n < 0 = empty + | n <= 0 = empty | n >= l = ps | otherwise = PS x s n {-# INLINE take #-} @@ -891,31 +940,46 @@ take n ps@(PS x s l) drop :: Int -> ByteString -> ByteString drop n ps@(PS x s l) | n <= 0 = ps - | n > l = empty + | n >= l = empty | otherwise = PS x (s+n) (l-n) {-# INLINE drop #-} -- | /O(1)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@. splitAt :: Int -> ByteString -> (ByteString, ByteString) -splitAt n ps = (take n ps, drop n ps) +splitAt n ps@(PS x s l) + | n <= 0 = (empty, ps) + | n >= l = (ps, empty) + | otherwise = (PS x s n, PS x (s+n) (l-n)) {-# INLINE splitAt #-} -- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@, -- returns the longest prefix (possibly empty) of @xs@ of elements that -- satisfy @p@. takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString -takeWhile f ps = take (findIndexOrEnd (not . f) ps) ps +takeWhile f ps = unsafeTake (findIndexOrEnd (not . f) ps) ps {-# INLINE takeWhile #-} -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@. dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString -dropWhile f ps = drop (findIndexOrEnd (not . f) ps) ps +dropWhile f ps = unsafeDrop (findIndexOrEnd (not . f) ps) ps {-# INLINE dropWhile #-} -- | 'break' @p@ is equivalent to @'span' ('not' . p)@. break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) -break p ps = case findIndexOrEnd p ps of n -> (take n ps, drop n ps) -{-# INLINE break #-} +break p ps = case findIndexOrEnd p ps of n -> (unsafeTake n ps, unsafeDrop n ps) +{-# INLINE [1] break #-} + +{-# RULES +"FPS specialise break (x==)" forall x. + break ((==) x) = breakByte x + #-} + +#if __GLASGOW_HASKELL__ >= 605 +{-# RULES +"FPS specialise break (==x)" forall x. + break (==x) = breakByte x + #-} +#endif -- | 'breakByte' breaks its ByteString argument at the first occurence -- of the specified byte. It is more efficient than 'break' as it is @@ -926,9 +990,21 @@ break p ps = case findIndexOrEnd p ps of n -> (take n ps, drop n ps) breakByte :: Word8 -> ByteString -> (ByteString, ByteString) breakByte c p = case elemIndex c p of Nothing -> (p,empty) - Just n -> (take n p, drop n p) + Just n -> (unsafeTake n p, unsafeDrop n p) {-# INLINE breakByte #-} +-- | 'breakEnd' behaves like 'break' but from the end of the 'ByteString' +-- +-- breakEnd p == spanEnd (not.p) +breakEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) +breakEnd p ps = splitAt (findFromEndUntil p ps) ps + +-- | 'span' @p xs@ breaks the ByteString into two segments. It is +-- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ +span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) +span p ps = break (not . p) ps +{-# INLINE [1] span #-} + -- | 'spanByte' breaks its ByteString argument at the first -- occurence of a byte other than its argument. It is more efficient -- than 'span (==)' @@ -943,49 +1019,21 @@ spanByte c ps@(PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> go p i | i >= l = return (ps, empty) | otherwise = do c' <- peekByteOff p i if c /= c' - then return (take i ps, drop i ps) + then return (unsafeTake i ps, unsafeDrop i ps) else go p (i+1) {-# INLINE spanByte #-} --- | /O(n)/ 'breakFirst' breaks the given ByteString on the first --- occurence of @w@. It behaves like 'break', except the delimiter is --- not returned, and @Nothing@ is returned if the delimiter is not in --- the ByteString. I.e. --- --- > breakFirst 'b' "aabbcc" == Just ("aa","bcc") --- --- > breakFirst c xs == --- > let (x,y) = break (== c) xs --- > in if null y then Nothing else Just (x, drop 1 y)) --- -breakFirst :: Word8 -> ByteString -> Maybe (ByteString,ByteString) -breakFirst c p = case elemIndex c p of - Nothing -> Nothing - Just n -> Just (take n p, drop (n+1) p) -{-# INLINE breakFirst #-} - --- | /O(n)/ 'breakLast' behaves like breakFirst, but from the end of the --- ByteString. --- --- > breakLast ('b') (pack "aabbcc") == Just ("aab","cc") --- --- and the following are equivalent: --- --- > breakLast 'c' "abcdef" --- > let (x,y) = break (=='c') (reverse "abcdef") --- > in if null x then Nothing else Just (reverse (drop 1 y), reverse x) --- -breakLast :: Word8 -> ByteString -> Maybe (ByteString,ByteString) -breakLast c p = case elemIndexLast c p of - Nothing -> Nothing - Just n -> Just (take n p, drop (n+1) p) -{-# INLINE breakLast #-} +{-# RULES +"FPS specialise span (x==)" forall x. + span ((==) x) = spanByte x + #-} --- | 'span' @p xs@ breaks the ByteString into two segments. It is --- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@ -span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) -span p ps = break (not . p) ps -{-# INLINE span #-} +#if __GLASGOW_HASKELL__ >= 605 +{-# RULES +"FPS specialise span (==x)" forall x. + span (==x) = spanByte x + #-} +#endif -- | 'spanEnd' behaves like 'span' but from the end of the 'ByteString'. -- We have @@ -1051,7 +1099,7 @@ splitWith p ps = loop p ps -- argument, consuming the delimiter. I.e. -- -- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"] --- > split 'a' "aXaXaXa" == ["","X","X","X"] +-- > split 'a' "aXaXaXa" == ["","X","X","X",""] -- > split 'x' "x" == ["",""] -- -- and @@ -1069,9 +1117,10 @@ split 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 + loop n = + let q = inlinePerformIO $ memchr (ptr `plusPtr` n) + w (fromIntegral (l-n)) + in if q == nullPtr then [PS x (s+n) (l-n)] else let i = q `minusPtr` ptr in PS x (s+n) (i-n) : loop (i+1) @@ -1103,6 +1152,7 @@ split (W8# w#) (PS fp off len) = splitWith' off len fp else splitLoop p (idx'+1) off' len' fp' -} +{- -- | Like 'splitWith', except that sequences of adjacent separators are -- treated as a single separator. eg. -- @@ -1111,6 +1161,7 @@ split (W8# w#) (PS fp off len) = splitWith' off len fp tokens :: (Word8 -> Bool) -> ByteString -> [ByteString] tokens f = P.filter (not.null) . splitWith f {-# INLINE tokens #-} +-} -- | The 'group' function takes a ByteString and returns a list of -- ByteStrings such that the concatenation of the result is equal to the @@ -1133,7 +1184,7 @@ group xs groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString] groupBy k xs | null xs = [] - | otherwise = take n xs : groupBy k (drop n xs) + | otherwise = unsafeTake n xs : groupBy k (unsafeDrop n xs) where n = 1 + findIndexOrEnd (not . k (unsafeHead xs)) (unsafeTail xs) @@ -1141,19 +1192,20 @@ groupBy k xs -- 'ByteString's and concatenates the list after interspersing the first -- argument between each element of the list. join :: ByteString -> [ByteString] -> ByteString -join filler pss = concat (splice pss) - where - splice [] = [] - splice [x] = [x] - splice (x:y:xs) = x:filler:splice (y:xs) -{-# INLINE join #-} +join s = concat . (List.intersperse s) +{-# INLINE [1] join #-} + +{-# RULES +"FPS specialise join c -> joinByte" forall c s1 s2 . + join (singleton c) (s1 : s2 : []) = joinWithByte c s1 s2 + #-} -- -- | /O(n)/ joinWithByte. An efficient way to join to two ByteStrings -- with a char. Around 4 times faster than the generalised join. -- joinWithByte :: Word8 -> ByteString -> ByteString -> ByteString -joinWithByte c f@(PS ffp s l) g@(PS fgp t m) = create len $ \ptr -> +joinWithByte c f@(PS ffp s l) g@(PS fgp t m) = unsafeCreate len $ \ptr -> withForeignPtr ffp $ \fp -> withForeignPtr fgp $ \gp -> do memcpy ptr (fp `plusPtr` s) (fromIntegral l) @@ -1182,20 +1234,20 @@ index ps n elemIndex :: Word8 -> ByteString -> Maybe Int elemIndex c (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do let p' = p `plusPtr` s - q = memchr p' c (fromIntegral l) - return $ if q == nullPtr then Nothing else Just $! q `minusPtr` p' + q <- memchr p' c (fromIntegral l) + return $! if q == nullPtr then Nothing else Just $! q `minusPtr` p' {-# INLINE elemIndex #-} --- | /O(n)/ The 'elemIndexLast' function returns the last index of the +-- | /O(n)/ The 'elemIndexEnd' function returns the last index of the -- element in the given 'ByteString' which is equal to the query -- element, or 'Nothing' if there is no such element. The following -- holds: -- --- > elemIndexLast c xs == +-- > elemIndexEnd c xs == -- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs) -- -elemIndexLast :: Word8 -> ByteString -> Maybe Int -elemIndexLast ch (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> +elemIndexEnd :: Word8 -> ByteString -> Maybe Int +elemIndexEnd ch (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> go (p `plusPtr` s) (l-1) where STRICT2(go) @@ -1204,7 +1256,7 @@ elemIndexLast ch (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> if ch == ch' then return $ Just i else go p (i-1) -{-# INLINE elemIndexLast #-} +{-# INLINE elemIndexEnd #-} -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order. @@ -1214,12 +1266,13 @@ elemIndices w (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do let ptr = p `plusPtr` s STRICT1(loop) - loop n = let q = memchr (ptr `plusPtr` n) w (fromIntegral (l - n)) + loop n = let q = inlinePerformIO $ 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) + return $! loop 0 {-# INLINE elemIndices #-} {- @@ -1239,7 +1292,7 @@ elemIndices c ps = loop 0 ps -- But more efficiently than using length on the intermediate list. count :: Word8 -> ByteString -> Int count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p -> - return $ fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w + fmap fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w {-# INLINE count #-} {- @@ -1252,7 +1305,7 @@ count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p -> go :: Ptr Word8 -> CSize -> Int -> IO Int STRICT3(go) go p l i = do - let q = memchr p w l + q <- memchr p w l if q == nullPtr then return i else do let k = fromIntegral $ q `minusPtr` p @@ -1263,9 +1316,7 @@ count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p -> -- returns the index of the first element in the ByteString -- satisfying the predicate. findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int -findIndex k ps@(PS x s l) - | null ps = Nothing - | otherwise = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0 +findIndex k (PS x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0 where STRICT2(go) go ptr n | n >= l = return Nothing @@ -1302,17 +1353,26 @@ notElem c ps = not (elem c ps) -- returns a ByteString containing those characters that satisfy the -- predicate. This function is subject to array fusion. filter :: (Word8 -> Bool) -> ByteString -> ByteString -filter p = loopArr . loopU (filterEFL p) noAL +#if defined(LOOPU_FUSION) +filter p = loopArr . loopU (filterEFL p) NoAcc +#elif defined(LOOPUP_FUSION) +filter p = loopArr . loopUp (filterEFL p) NoAcc +#elif defined(LOOPNOACC_FUSION) +filter p = loopArr . loopNoAcc (filterEFL p) +#else +filter f = loopArr . loopFilter f +#endif {-# INLINE filter #-} +{- -- | /O(n)/ 'filter\'' is a non-fuseable version of filter, that may be -- around 2x faster for some one-shot applications. filter' :: (Word8 -> Bool) -> ByteString -> ByteString filter' k ps@(PS x s l) | null ps = ps - | otherwise = inlinePerformIO $ generate l $ \p -> withForeignPtr x $ \f -> do + | otherwise = unsafePerformIO $ createAndTrim l $ \p -> withForeignPtr x $ \f -> do t <- go (f `plusPtr` s) p (f `plusPtr` (s + l)) - return (t `minusPtr` p) -- actual length + return $! t `minusPtr` p -- actual length where STRICT3(go) go f t end | f == end = return t @@ -1322,6 +1382,7 @@ filter' k ps@(PS x s l) then poke t w >> go (f `plusPtr` 1) (t `plusPtr` 1) end else go (f `plusPtr` 1) t end {-# INLINE filter' #-} +-} -- -- | /O(n)/ A first order equivalent of /filter . (==)/, for the common @@ -1336,6 +1397,18 @@ filterByte :: Word8 -> ByteString -> ByteString filterByte w ps = replicate (count w ps) w {-# INLINE filterByte #-} +{-# RULES + "FPS specialise filter (== x)" forall x. + filter ((==) x) = filterByte x + #-} + +#if __GLASGOW_HASKELL__ >= 605 +{-# RULES + "FPS specialise filter (== x)" forall x. + filter (== x) = filterByte x + #-} +#endif + -- -- | /O(n)/ A first order equivalent of /filter . (\/=)/, for the common -- case of filtering a single byte out of a list. It is more efficient @@ -1345,9 +1418,21 @@ filterByte w ps = replicate (count w ps) w -- -- filterNotByte is around 2x faster than its filter equivalent. filterNotByte :: Word8 -> ByteString -> ByteString -filterNotByte w = filter' (/= w) +filterNotByte w = filter (/= w) {-# INLINE filterNotByte #-} +{-# RULES +"FPS specialise filter (x /=)" forall x. + filter ((/=) x) = filterNotByte x + #-} + +#if __GLASGOW_HASKELL__ >= 605 +{-# RULES +"FPS specialise filter (/= x)" forall x. + filter (/= x) = filterNotByte x + #-} +#endif + -- | /O(n)/ The 'find' function takes a predicate and a ByteString, -- and returns the first element in matching the predicate, or 'Nothing' -- if there is no such element. @@ -1382,7 +1467,7 @@ isPrefixOf (PS x1 s1 l1) (PS x2 s2 l2) | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 -> withForeignPtr x2 $ \p2 -> do i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral l1) - return (i == 0) + return $! i == 0 -- | /O(n)/ The 'isSuffixOf' function takes two ByteStrings and returns 'True' -- iff the first is a suffix of the second. @@ -1400,7 +1485,7 @@ isSuffixOf (PS x1 s1 l1) (PS x2 s2 l2) | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 -> withForeignPtr x2 $ \p2 -> do i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2 `plusPtr` (l2 - l1)) (fromIntegral l1) - return (i == 0) + return $! i == 0 -- | Check whether one string is a substring of another. @isSubstringOf -- p s@ is equivalent to @not (null (findSubstrings p s))@. @@ -1458,11 +1543,47 @@ zip ps qs -- | 'zipWith' generalises 'zip' by zipping with the function given as -- the first argument, instead of a tupling function. For example, -- @'zipWith' (+)@ is applied to two ByteStrings to produce the list of --- corresponding sums. +-- corresponding sums. zipWith :: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a] zipWith f ps qs | null ps || null qs = [] | otherwise = f (unsafeHead ps) (unsafeHead qs) : zipWith f (unsafeTail ps) (unsafeTail qs) +#if defined(__GLASGOW_HASKELL__) +{-# INLINE [1] zipWith #-} +#endif + +-- +-- | A specialised version of zipWith for the common case of a +-- simultaneous map over two bytestrings, to build a 3rd. Rewrite rules +-- are used to automatically covert zipWith into zipWith' when a pack is +-- performed on the result of zipWith, but we also export it for +-- convenience. +-- +zipWith' :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString +zipWith' f (PS fp s l) (PS fq t m) = inlinePerformIO $ + withForeignPtr fp $ \a -> + withForeignPtr fq $ \b -> + create len $ zipWith_ 0 (a `plusPtr` s) (b `plusPtr` t) + where + zipWith_ :: Int -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () + STRICT4(zipWith_) + zipWith_ n p1 p2 r + | n >= len = return () + | otherwise = do + x <- peekByteOff p1 n + y <- peekByteOff p2 n + pokeByteOff r n (f x y) + zipWith_ (n+1) p1 p2 r + + len = min l m +{-# INLINE zipWith' #-} + +{-# RULES + +"FPS specialise zipWith" forall (f :: Word8 -> Word8 -> Word8) p q . + zipWith f p q = unpack (zipWith' f p q) + + #-} -- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of -- ByteStrings. Note that this performs two 'pack' operations. @@ -1484,21 +1605,15 @@ tails p | null p = [empty] -- less efficent spacewise: tails (PS x s l) = [PS x (s+n) (l-n) | n <- [0..l]] --- | /O(n)/ breaks a ByteString to a list of ByteStrings, one byte each. -elems :: ByteString -> [ByteString] -elems (PS _ _ 0) = [] -elems (PS x s l) = (PS x s 1:elems (PS x (s+1) (l-1))) -{-# INLINE elems #-} - -- --------------------------------------------------------------------- -- ** Ordered 'ByteString's -- | /O(n)/ Sort a ByteString efficiently, using counting sort. sort :: ByteString -> ByteString -sort (PS input s l) = create l $ \p -> allocaArray 256 $ \arr -> do +sort (PS input s l) = unsafeCreate l $ \p -> allocaArray 256 $ \arr -> do memset (castPtr arr) 0 (256 * fromIntegral (sizeOf (undefined :: CSize))) - withForeignPtr input (\x -> countEach arr (x `plusPtr` s) l) + withForeignPtr input (\x -> countOccurrences arr (x `plusPtr` s) l) let STRICT2(go) go 256 _ = return () @@ -1507,30 +1622,13 @@ sort (PS input s l) = create l $ \p -> allocaArray 256 $ \arr -> do go (i + 1) (ptr `plusPtr` (fromIntegral n)) go 0 p --- "countEach counts str l" counts the number of occurences of each Word8 in --- str, and stores the result in counts. -countEach :: Ptr CSize -> Ptr Word8 -> Int -> IO () -STRICT3(countEach) -countEach counts str l = go 0 - where - STRICT1(go) - go i | i == l = return () - | otherwise = do k <- fromIntegral `fmap` peekElemOff str i - x <- peekElemOff counts k - pokeElemOff counts k (x + 1) - go (i + 1) - {- sort :: ByteString -> ByteString -sort (PS x s l) = create l $ \p -> withForeignPtr x $ \f -> do +sort (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> do memcpy p (f `plusPtr` s) l c_qsort p l -- inplace -} -{- -sort = pack . List.sort . unpack --} - -- | The 'sortBy' function is the non-overloaded version of 'sort'. -- -- Try some linear sorts: radix, counting @@ -1540,153 +1638,61 @@ sort = pack . List.sort . unpack -- sortBy f ps = undefined -- --------------------------------------------------------------------- --- --- Extensions to the basic interface --- - --- | A variety of 'head' for non-empty ByteStrings. 'unsafeHead' omits the --- check for the empty case, so there is an obligation on the programmer --- to provide a proof that the ByteString is non-empty. -unsafeHead :: ByteString -> Word8 -unsafeHead (PS x s _) = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p s -{-# INLINE unsafeHead #-} - --- | A variety of 'tail' for non-empty ByteStrings. 'unsafeTail' omits the --- check for the empty case. As with 'unsafeHead', the programmer must --- provide a separate proof that the ByteString is non-empty. -unsafeTail :: ByteString -> ByteString -unsafeTail (PS ps s l) = PS ps (s+1) (l-1) -{-# INLINE unsafeTail #-} - --- | Unsafe 'ByteString' index (subscript) operator, starting from 0, returning a 'Word8' --- This omits the bounds check, which means there is an accompanying --- obligation on the programmer to ensure the bounds are checked in some --- other way. -unsafeIndex :: ByteString -> Int -> Word8 -unsafeIndex (PS x s _) i = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+i) -{-# INLINE unsafeIndex #-} - --- --------------------------------------------------------------------- -- Low level constructors -#if defined(__GLASGOW_HASKELL__) --- | /O(n)/ Pack a null-terminated sequence of bytes, pointed to by an --- Addr\# (an arbitrary machine address assumed to point outside the --- garbage-collected heap) into a @ByteString@. A much faster way to --- create an Addr\# is with an unboxed string literal, than to pack a --- boxed string. A unboxed string literal is compiled to a static @char --- []@ by GHC. Establishing the length of the string requires a call to --- @strlen(3)@, so the Addr# must point to a null-terminated buffer (as --- is the case with "string"# literals in GHC). Use 'unsafePackAddress' --- if you know the length of the string statically. --- --- An example: --- --- > literalFS = packAddress "literal"# --- -packAddress :: Addr# -> ByteString -packAddress addr# = inlinePerformIO $ do - p <- newForeignPtr_ cstr - return $ PS p 0 (fromIntegral $ c_strlen cstr) - where - cstr = Ptr addr# -{-# INLINE packAddress #-} - --- | /O(1)/ 'unsafePackAddress' provides constant-time construction of --- 'ByteStrings' -- which is ideal for string literals. It packs a --- null-terminated sequence of bytes into a 'ByteString', given a raw --- 'Addr\#' to the string, and the length of the string. Make sure the --- length is correct, otherwise use the safer 'packAddress' (where the --- length will be calculated once at runtime). -unsafePackAddress :: Int -> Addr# -> ByteString -unsafePackAddress len addr# = inlinePerformIO $ do - p <- newForeignPtr_ cstr - return $ PS p 0 len - where cstr = Ptr addr# - -#endif - --- | /O(1)/ Build a ByteString from a ForeignPtr -fromForeignPtr :: ForeignPtr Word8 -> Int -> ByteString -fromForeignPtr fp l = PS fp 0 l - --- | /O(1)/ Deconstruct a ForeignPtr from a ByteString -toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int) -toForeignPtr (PS ps s l) = (ps, s, l) - --- | /O(1)/ 'skipIndex' returns the internal skipped index of the --- current 'ByteString' from any larger string it was created from, as --- an 'Int'. -skipIndex :: ByteString -> Int -skipIndex (PS _ s _) = s -{-# INLINE skipIndex #-} - -- | /O(n)/ Build a @ByteString@ from a @CString@. This value will have /no/ -- finalizer associated to it. The ByteString length is calculated using -- /strlen(3)/, and thus the complexity is a /O(n)/. packCString :: CString -> ByteString -packCString cstr = inlinePerformIO $ do +packCString cstr = unsafePerformIO $ do fp <- newForeignPtr_ (castPtr cstr) - return $ PS fp 0 (fromIntegral $ c_strlen cstr) + l <- c_strlen cstr + return $! PS fp 0 (fromIntegral l) -- | /O(1)/ Build a @ByteString@ from a @CStringLen@. This value will -- have /no/ finalizer associated with it. This operation has /O(1)/ -- complexity as we already know the final size, so no /strlen(3)/ is -- required. packCStringLen :: CStringLen -> ByteString -packCStringLen (ptr,len) = inlinePerformIO $ do +packCStringLen (ptr,len) = unsafePerformIO $ do fp <- newForeignPtr_ (castPtr ptr) - return $ PS fp 0 (fromIntegral len) + return $! PS fp 0 (fromIntegral len) -- | /O(n)/ Build a @ByteString@ from a malloced @CString@. This value will -- have a @free(3)@ finalizer associated to it. packMallocCString :: CString -> ByteString -packMallocCString cstr = inlinePerformIO $ do +packMallocCString cstr = unsafePerformIO $ do fp <- newForeignFreePtr (castPtr cstr) - return $ PS fp 0 (fromIntegral $ c_strlen cstr) - -#if defined(__GLASGOW_HASKELL__) --- | /O(1)/ Construct a 'ByteString' given a C Ptr Word8 buffer, a --- length, and an IO action representing a finalizer. This function is --- not available on Hugs. --- -packCStringFinalizer :: Ptr Word8 -> Int -> IO () -> IO ByteString -packCStringFinalizer p l f = do - fp <- FC.newForeignPtr p f - return $ PS fp 0 l - --- | Explicitly run the finaliser associated with a 'ByteString'. --- Further references to this value may generate invalid memory --- references. This operation is unsafe, as there may be other --- 'ByteStrings' referring to the same underlying pages. If you use --- this, you need to have a proof of some kind that all 'ByteString's --- ever generated from the underlying byte array are no longer live. -unsafeFinalize :: ByteString -> IO () -unsafeFinalize (PS p _ _) = finalizeForeignPtr p - -#endif + len <- c_strlen cstr + return $! PS fp 0 (fromIntegral len) --- | /O(n) construction/ Use a @ByteString@ with a function requiring a null-terminated @CString@. --- The @CString@ should not be freed afterwards. This is a memcpy(3). +-- | /O(n) construction/ Use a @ByteString@ with a function requiring a +-- null-terminated @CString@. The @CString@ will be freed +-- automatically. This is a memcpy(3). useAsCString :: ByteString -> (CString -> IO a) -> IO a useAsCString (PS ps s l) = bracket alloc (c_free.castPtr) - where - alloc = withForeignPtr ps $ \p -> do - buf <- c_malloc (fromIntegral l+1) - memcpy (castPtr buf) (castPtr p `plusPtr` s) (fromIntegral l) - poke (buf `plusPtr` l) (0::Word8) - return $ castPtr buf - --- | /O(1) construction/ Use a @ByteString@ with a function requiring a @CString@. --- Warning: modifying the @CString@ will affect the @ByteString@. --- Why is this function unsafe? It relies on the null byte at the end of --- the ByteString to be there. This is /not/ the case if your ByteString --- has been spliced from a larger string (i.e. with take or drop). --- Unless you can guarantee the null byte, you should use the safe --- version, which will copy the string first. --- -unsafeUseAsCString :: ByteString -> (CString -> IO a) -> IO a -unsafeUseAsCString (PS ps s _) ac = withForeignPtr ps $ \p -> ac (castPtr p `plusPtr` s) + where alloc = withForeignPtr ps $ \p -> do + buf <- c_malloc (fromIntegral l+1) + memcpy (castPtr buf) (castPtr p `plusPtr` s) (fromIntegral l) + poke (buf `plusPtr` l) (0::Word8) -- n.b. + return (castPtr buf) + +-- | /O(1) construction/ Use a @ByteString@ with a function requiring a @CStringLen@. +useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a +useAsCStringLen = unsafeUseAsCStringLen + +-- +-- why were we doing this? +-- +-- useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a +-- useAsCStringLen (PS ps s l) = bracket alloc (c_free.castPtr.fst) +-- where +-- alloc = withForeignPtr ps $ \p -> do +-- buf <- c_malloc (fromIntegral l+1) +-- memcpy (castPtr buf) (castPtr p `plusPtr` s) (fromIntegral l) +-- poke (buf `plusPtr` l) (0::Word8) -- n.b. +-- return $! (castPtr buf, l) +-- -- | /O(n)/ Make a copy of the 'ByteString' with its own storage. -- This is mainly useful to allow the rest of the data pointed @@ -1694,76 +1700,52 @@ unsafeUseAsCString (PS ps s _) ac = withForeignPtr ps $ \p -> ac (castPtr p `plu -- if a large string has been read in, and only a small part of it -- is needed in the rest of the program. copy :: ByteString -> ByteString -copy (PS x s l) = create l $ \p -> withForeignPtr x $ \f -> +copy (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> memcpy p (f `plusPtr` s) (fromIntegral l) -- | /O(n)/ Duplicate a CString as a ByteString. Useful if you know the -- CString is going to be deallocated from C land. -copyCString :: CString -> ByteString -copyCString cstr = copyCStringLen (cstr, (fromIntegral $ c_strlen cstr)) +copyCString :: CString -> IO ByteString +copyCString cstr = do + len <- c_strlen cstr + copyCStringLen (cstr, fromIntegral len) -- | /O(n)/ Same as copyCString, but saves a strlen call when the length is known. -copyCStringLen :: CStringLen -> ByteString -copyCStringLen (cstr, len) = inlinePerformIO $ do - fp <- mallocForeignPtrArray (len+1) - withForeignPtr fp $ \p -> do - memcpy p (castPtr cstr) (fromIntegral len) - poke (p `plusPtr` len) (0 :: Word8) - return $! PS fp 0 len - --- | /O(1) construction/ Use a @ByteString@ with a function requiring a @CStringLen@. --- Warning: modifying the @CStringLen@ will affect the @ByteString@. --- This is analogous to unsafeUseAsCString, and comes with the same --- safety requirements. --- -unsafeUseAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a -unsafeUseAsCStringLen (PS ps s l) ac = withForeignPtr ps $ \p -> ac (castPtr p `plusPtr` s,l) - --- | Given the maximum size needed and a function to make the contents --- of a ByteString, generate makes the 'ByteString'. The generating --- function is required to return the actual final size (<= the maximum --- size), and the resulting byte array is realloced to this size. The --- string is padded at the end with a null byte. --- --- generate is the main mechanism for creating custom, efficient --- ByteString functions, using Haskell or C functions to fill the space. --- -generate :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString -generate i f = do - fp <- mallocByteString i - (ptr,n) <- withForeignPtr fp $ \p -> do - i' <- f p - if i' == i - then return (fp,i') - else do fp_ <- mallocByteString i' -- realloc - withForeignPtr fp_ $ \p' -> memcpy p' p (fromIntegral i') - return (fp_,i') - return (PS ptr 0 n) - -{- --- --- On the C malloc heap. Less fun. --- -generate i f = do - p <- mallocArray (i+1) - i' <- f p - p' <- reallocArray p (i'+1) - poke (p' `plusPtr` i') (0::Word8) -- XXX so CStrings work - fp <- newForeignFreePtr p' - return $ PS fp 0 i' --} +copyCStringLen :: CStringLen -> IO ByteString +copyCStringLen (cstr, len) = create len $ \p -> + memcpy p (castPtr cstr) (fromIntegral len) -- --------------------------------------------------------------------- -- line IO -#if defined(__GLASGOW_HASKELL__) - --- | getLine, read a line from stdin. +-- | Read a line from stdin. getLine :: IO ByteString getLine = hGetLine stdin --- | hGetLine. read a ByteString from a handle +{- +-- | Lazily construct a list of lines of ByteStrings. This will be much +-- better on memory consumption than using 'hGetContents >>= lines' +-- If you're considering this, a better choice might be to use +-- Data.ByteString.Lazy +hGetLines :: Handle -> IO [ByteString] +hGetLines h = go + where + go = unsafeInterleaveIO $ do + e <- hIsEOF h + if e + then return [] + else do + x <- hGetLine h + xs <- go + return (x:xs) +-} + +-- | Read a line from a handle + hGetLine :: Handle -> IO ByteString +#if !defined(__GLASGOW_HASKELL__) +hGetLine h = System.IO.hGetLine h >>= return . pack . P.map c2w +#else hGetLine h = wantReadableHandle "Data.ByteString.hGetLine" h $ \ handle_ -> do case haBufferMode handle_ of NoBuffering -> error "no buffering" @@ -1819,12 +1801,11 @@ hGetLine h = wantReadableHandle "Data.ByteString.hGetLine" h $ \ handle_ -> do -- TODO, rewrite to use normal memcpy mkPS :: RawBuffer -> Int -> Int -> IO ByteString -mkPS buf start end = do +mkPS buf start end = let len = end - start - fp <- mallocByteString len - withForeignPtr fp $ \p -> do + in create len $ \p -> do memcpy_ptr_baoff p buf (fromIntegral start) (fromIntegral len) - return (PS fp 0 len) + return () mkBigPS :: Int -> [ByteString] -> IO ByteString mkBigPS _ [ps] = return ps @@ -1837,41 +1818,50 @@ mkBigPS _ pss = return $! concat (P.reverse pss) -- | Outputs a 'ByteString' to the specified 'Handle'. hPut :: Handle -> ByteString -> IO () -hPut _ (PS _ _ 0) = return () -hPut h (PS ps 0 l) = withForeignPtr ps $ \p-> hPutBuf h p l +hPut _ (PS _ _ 0) = return () hPut h (PS ps s l) = withForeignPtr ps $ \p-> hPutBuf h (p `plusPtr` s) l +-- | A synonym for @hPut@, for compatibility +hPutStr :: Handle -> ByteString -> IO () +hPutStr = hPut + +-- | Write a ByteString to a handle, appending a newline byte +hPutStrLn :: Handle -> ByteString -> IO () +hPutStrLn h ps + | length ps < 1024 = hPut h (ps `snoc` 0x0a) + | otherwise = hPut h ps >> hPut h (singleton (0x0a)) -- don't copy + -- | Write a ByteString to stdout putStr :: ByteString -> IO () putStr = hPut stdout -- | Write a ByteString to stdout, appending a newline byte putStrLn :: ByteString -> IO () -putStrLn ps = hPut stdout ps >> hPut stdout nl - where nl = packByte 0x0a +putStrLn = hPutStrLn stdout -- | Read a 'ByteString' directly from the specified 'Handle'. This -- is far more efficient than reading the characters into a 'String' -- and then using 'pack'. hGet :: Handle -> Int -> IO ByteString hGet _ 0 = return empty -hGet h i = do fp <- mallocByteString i - l <- withForeignPtr fp $ \p-> hGetBuf h p i - return $ PS fp 0 l +hGet h i = createAndTrim i $ \p -> hGetBuf h p i -#if defined(__GLASGOW_HASKELL__) -- | hGetNonBlocking is identical to 'hGet', except that it will never block -- waiting for data to become available, instead it returns only whatever data -- is available. hGetNonBlocking :: Handle -> Int -> IO ByteString +#if defined(__GLASGOW_HASKELL__) hGetNonBlocking _ 0 = return empty -hGetNonBlocking h i = do - fp <- mallocByteString i - l <- withForeignPtr fp $ \p -> hGetBufNonBlocking h p i - return $ PS fp 0 l +hGetNonBlocking h i = createAndTrim i $ \p -> hGetBufNonBlocking h p i +#else +hGetNonBlocking = hGet #endif -- | Read entire handle contents into a 'ByteString'. +-- This function reads chunks at a time, doubling the chunksize on each +-- read. The final buffer is then realloced to the appropriate size. For +-- files > half of available memory, this may lead to memory exhaustion. +-- Consider using 'readFile' in this case. -- -- As with 'hGet', the string representation in the file is assumed to -- be ISO-8859-1. @@ -1884,7 +1874,7 @@ hGetContents h = do if i < start_size then do p' <- reallocArray p i fp <- newForeignFreePtr p' - return $ PS fp 0 i + return $! PS fp 0 i else f p start_size where f p s = do @@ -1895,29 +1885,38 @@ hGetContents h = do then do let i' = s + i p'' <- reallocArray p' i' fp <- newForeignFreePtr p'' - return $ PS fp 0 i' + return $! PS fp 0 i' else f p' s' -- | getContents. Equivalent to hGetContents stdin getContents :: IO ByteString getContents = hGetContents stdin +-- | The interact function takes a function of type @ByteString -> ByteString@ +-- as its argument. The entire input from the standard input device is passed +-- to this function as its argument, and the resulting string is output on the +-- standard output device. It's great for writing one line programs! +interact :: (ByteString -> ByteString) -> IO () +interact transformer = putStr . transformer =<< getContents + -- | Read an entire file strictly into a 'ByteString'. This is far more -- efficient than reading the characters into a 'String' and then using -- 'pack'. It also may be more efficient than opening the file and --- reading it using hGet. +-- reading it using hGet. Files are read using 'binary mode' on Windows, +-- for 'text mode' use the Char8 version of this function. readFile :: FilePath -> IO ByteString -readFile f = do - h <- openBinaryFile f ReadMode - l <- hFileSize h - s <- hGet h $ fromIntegral l - hClose h - return s +readFile f = bracket (openBinaryFile f ReadMode) hClose + (\h -> hFileSize h >>= hGet h . fromIntegral) -- | Write a 'ByteString' to a file. writeFile :: FilePath -> ByteString -> IO () -writeFile f ps = bracket (openBinaryFile f WriteMode) hClose - (\h -> hPut h ps) +writeFile f txt = bracket (openBinaryFile f WriteMode) hClose + (\h -> hPut h txt) + +-- | Append a 'ByteString' to a file. +appendFile :: FilePath -> ByteString -> IO () +appendFile f txt = bracket (openBinaryFile f AppendMode) hClose + (\h -> hPut h txt) {- -- @@ -1938,7 +1937,7 @@ writeFile f ps = bracket (openBinaryFile f WriteMode) hClose -- On systems without mmap, this is the same as a readFile. -- mmapFile :: FilePath -> IO ByteString -mmapFile f = mmap f >>= \(fp,l) -> return $ PS fp 0 l +mmapFile f = mmap f >>= \(fp,l) -> return $! PS fp 0 l mmap :: FilePath -> IO (ForeignPtr Word8, Int) mmap f = do @@ -1962,12 +1961,14 @@ mmap f = do else do -- The munmap leads to crashes on OpenBSD. -- maybe there's a use after unmap in there somewhere? + -- Bulat suggests adding the hClose to the + -- finalizer, excellent idea. #if !defined(__OpenBSD__) let unmap = c_munmap p l >> return () #else let unmap = return () #endif - fp <- FC.newForeignPtr p unmap + fp <- newForeignPtr p unmap return fp c_close fd hClose h @@ -1975,57 +1976,21 @@ mmap f = do where mmap_limit = 16*1024 -} -#if defined(__GLASGOW_HASKELL__) --- --- | A ByteString equivalent for getArgs. More efficient for large argument lists --- -getArgs :: IO [ByteString] -getArgs = - alloca $ \ p_argc -> - alloca $ \ p_argv -> do - getProgArgv p_argc p_argv - p <- fromIntegral `fmap` peek p_argc - argv <- peek p_argv - P.map packCString `fmap` peekArray (p - 1) (advancePtr argv 1) -#endif - -- --------------------------------------------------------------------- -- Internal utilities --- Unsafe conversion between 'Word8' and 'Char'. These are nops, and --- silently truncate to 8 bits Chars > '\255'. They are provided as --- convenience for ByteString construction. -w2c :: Word8 -> Char -#if !defined(__GLASGOW_HASKELL__) -w2c = chr . fromIntegral -#else -w2c = unsafeChr . fromIntegral -#endif -{-# INLINE w2c #-} - -c2w :: Char -> Word8 -c2w = fromIntegral . ord -{-# INLINE c2w #-} - --- Wrapper of mallocForeignPtrArray. Any ByteString allocated this way --- is padded with a null byte. -mallocByteString :: Int -> IO (ForeignPtr Word8) -mallocByteString l = do - fp <- mallocForeignPtrArray (l+1) - withForeignPtr fp $ \p -> poke (p `plusPtr` l) (0::Word8) - return fp - --- | A way of creating ForeignPtrs outside the IO monad. The @Int@ --- argument gives the final size of the ByteString. Unlike 'generate' --- the ByteString is not reallocated if the final size is less than the --- estimated size. Also, unlike 'generate' ByteString's created this way --- are managed on the Haskell heap. -create :: Int -> (Ptr Word8 -> IO ()) -> ByteString -create l write_ptr = inlinePerformIO $ do - fp <- mallocByteString (l+1) - withForeignPtr fp $ \p -> write_ptr p - return $ PS fp 0 l -{-# INLINE create #-} +-- | 'findIndexOrEnd' is a variant of findIndex, that returns the length +-- of the string if no element is found, rather than Nothing. +findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int +findIndexOrEnd k (PS x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0 + where + STRICT2(go) + go ptr n | n >= l = return l + | otherwise = do w <- peek ptr + if k w + then return n + else go (ptr `plusPtr` 1) (n+1) +{-# INLINE findIndexOrEnd #-} -- | Perform an operation with a temporary ByteString withPtr :: ForeignPtr a -> (Ptr a -> IO b) -> b @@ -2042,16 +2007,6 @@ moduleError :: String -> String -> a moduleError fun msg = error ("Data.ByteString." ++ fun ++ ':':' ':msg) {-# NOINLINE moduleError #-} --- 'findIndexOrEnd' is a variant of findIndex, that returns the length --- of the string if no element is found, rather than Nothing. -findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int -STRICT2(findIndexOrEnd) -findIndexOrEnd f ps - | null ps = 0 - | f (unsafeHead ps) = 0 - | otherwise = 1 + findIndexOrEnd f (unsafeTail ps) -{-# INLINE findIndexOrEnd #-} - -- Find from the end of the string using predicate findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int STRICT2(findFromEndUntil) @@ -2060,253 +2015,6 @@ findFromEndUntil f ps@(PS x s l) = else if f (last ps) then l else findFromEndUntil f (PS x s (l-1)) --- Just like inlinePerformIO, but we inline it. Big performance gains as --- it exposes lots of things to further inlining --- -{-# INLINE inlinePerformIO #-} -inlinePerformIO :: IO a -> a -#if defined(__GLASGOW_HASKELL__) -inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r -#else -inlinePerformIO = unsafePerformIO -#endif - {-# INLINE newForeignFreePtr #-} newForeignFreePtr :: Ptr Word8 -> IO (ForeignPtr Word8) -#if defined(__GLASGOW_HASKELL__) -newForeignFreePtr p = FC.newForeignPtr p (c_free p) -#else newForeignFreePtr p = newForeignPtr c_free_finalizer p -#endif - --- --------------------------------------------------------------------- --- --- Standard C functions --- - -foreign import ccall unsafe "string.h strlen" c_strlen - :: CString -> CInt - -foreign import ccall unsafe "stdlib.h malloc" c_malloc - :: CInt -> IO (Ptr Word8) - -foreign import ccall unsafe "static stdlib.h free" c_free - :: Ptr Word8 -> IO () - -#if !defined(__GLASGOW_HASKELL__) -foreign import ccall unsafe "static stdlib.h &free" c_free_finalizer - :: FunPtr (Ptr Word8 -> IO ()) -#endif - -foreign import ccall unsafe "string.h memset" memset - :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) - -foreign import ccall unsafe "string.h memchr" memchr - :: Ptr Word8 -> Word8 -> CSize -> Ptr Word8 - -foreign import ccall unsafe "string.h memcmp" memcmp - :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt - -foreign import ccall unsafe "string.h memcpy" memcpy - :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () - --- --------------------------------------------------------------------- --- --- Uses our C code --- - -foreign import ccall unsafe "static fpstring.h reverse" c_reverse - :: Ptr Word8 -> Ptr Word8 -> CInt -> IO () - -foreign import ccall unsafe "static fpstring.h intersperse" c_intersperse - :: Ptr Word8 -> Ptr Word8 -> CInt -> Word8 -> IO () - -foreign import ccall unsafe "static fpstring.h maximum" c_maximum - :: Ptr Word8 -> CInt -> Word8 - -foreign import ccall unsafe "static fpstring.h minimum" c_minimum - :: Ptr Word8 -> CInt -> Word8 - -foreign import ccall unsafe "static fpstring.h count" c_count - :: Ptr Word8 -> CInt -> Word8 -> CInt - --- --------------------------------------------------------------------- --- MMap - -{- -foreign import ccall unsafe "static fpstring.h my_mmap" my_mmap - :: Int -> Int -> IO (Ptr Word8) - -foreign import ccall unsafe "static unistd.h close" c_close - :: Int -> IO Int - -# if !defined(__OpenBSD__) -foreign import ccall unsafe "static sys/mman.h munmap" c_munmap - :: Ptr Word8 -> Int -> IO Int -# endif --} - --- --------------------------------------------------------------------- --- Internal GHC Haskell magic - -#if defined(__GLASGOW_HASKELL__) -foreign import ccall unsafe "RtsAPI.h getProgArgv" - getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO () - -foreign import ccall unsafe "__hscore_memcpy_src_off" - memcpy_ptr_baoff :: Ptr a -> RawBuffer -> CInt -> CSize -> IO (Ptr ()) -#endif - --- --------------------------------------------------------------------- --- --- Functional array fusion for ByteStrings. --- --- From the Data Parallel Haskell project, --- http://www.cse.unsw.edu.au/~chak/project/dph/ --- - --- |Data type for accumulators which can be ignored. The rewrite rules rely on --- the fact that no bottoms of this type are ever constructed; hence, we can --- assume @(_ :: NoAL) `seq` x = x@. --- -data NoAL = NoAL - --- | Special forms of loop arguments --- --- * These are common special cases for the three function arguments of gen --- and loop; we give them special names to make it easier to trigger RULES --- applying in the special cases represented by these arguments. The --- "INLINE [1]" makes sure that these functions are only inlined in the last --- two simplifier phases. --- --- * In the case where the accumulator is not needed, it is better to always --- explicitly return a value `()', rather than just copy the input to the --- output, as the former gives GHC better local information. --- - --- | Element function expressing a mapping only -mapEFL :: (Word8 -> Word8) -> (NoAL -> Word8 -> (NoAL, Maybe Word8)) -mapEFL f = \_ e -> (noAL, (Just $ f e)) -#if defined(__GLASGOW_HASKELL__) -{-# INLINE [1] mapEFL #-} -#endif - --- | Element function implementing a filter function only -filterEFL :: (Word8 -> Bool) -> (NoAL -> Word8 -> (NoAL, Maybe Word8)) -filterEFL p = \_ e -> if p e then (noAL, Just e) else (noAL, Nothing) -#if defined(__GLASGOW_HASKELL__) -{-# INLINE [1] filterEFL #-} -#endif - --- |Element function expressing a reduction only -foldEFL :: (acc -> Word8 -> acc) -> (acc -> Word8 -> (acc, Maybe Word8)) -foldEFL f = \a e -> (f a e, Nothing) -#if defined(__GLASGOW_HASKELL__) -{-# INLINE [1] foldEFL #-} -#endif - --- | A strict foldEFL. -foldEFL' :: (acc -> Word8 -> acc) -> (acc -> Word8 -> (acc, Maybe Word8)) -foldEFL' f = \a e -> let a' = f a e in a' `seq` (a', Nothing) -#if defined(__GLASGOW_HASKELL__) -{-# INLINE [1] foldEFL' #-} -#endif - --- | No accumulator -noAL :: NoAL -noAL = NoAL -#if defined(__GLASGOW_HASKELL__) -{-# INLINE [1] noAL #-} -#endif - --- | Projection functions that are fusion friendly (as in, we determine when --- they are inlined) -loopArr :: (ByteString, acc) -> ByteString -loopArr (arr, _) = arr -#if defined(__GLASGOW_HASKELL__) -{-# INLINE [1] loopArr #-} -#endif - -loopAcc :: (ByteString, acc) -> acc -loopAcc (_, acc) = acc -#if defined(__GLASGOW_HASKELL__) -{-# INLINE [1] loopAcc #-} -#endif - -loopSndAcc :: (ByteString, (acc1, acc2)) -> (ByteString, acc2) -loopSndAcc (arr, (_, acc)) = (arr, acc) -#if defined(__GLASGOW_HASKELL__) -{-# INLINE [1] loopSndAcc #-} -#endif - ------------------------------------------------------------------------- - --- --- size, and then percentage. --- - --- | Iteration over over ByteStrings -loopU :: (acc -> Word8 -> (acc, Maybe Word8)) -- ^ mapping & folding, once per elem - -> acc -- ^ initial acc value - -> ByteString -- ^ input ByteString - -> (ByteString, acc) - -loopU f start (PS z s i) = inlinePerformIO $ withForeignPtr z $ \a -> do - fp <- mallocByteString i - (ptr,n,acc) <- withForeignPtr fp $ \p -> do - (acc, i') <- go (a `plusPtr` s) p start - if i' == i - then return (fp,i',acc) -- no realloc for map - else do fp_ <- mallocByteString i' -- realloc - withForeignPtr fp_ $ \p' -> memcpy p' p (fromIntegral i') - return (fp_,i',acc) - - return (PS ptr 0 n, acc) - where - go p ma = trans 0 0 - where - STRICT3(trans) - trans a_off ma_off acc - | a_off >= i = return (acc, ma_off) - | otherwise = do - x <- peekByteOff p a_off - let (acc', oe) = f acc x - ma_off' <- case oe of - Nothing -> return ma_off - Just e -> do pokeByteOff ma ma_off e - return $ ma_off + 1 - trans (a_off+1) ma_off' acc' - -#if defined(__GLASGOW_HASKELL__) -{-# INLINE [1] loopU #-} -#endif - -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 - -"loop/loop fusion!" forall em1 em2 start1 start2 arr. - loopU em2 start2 (loopArr (loopU em1 start1 arr)) = - loopSndAcc (loopU (em1 `fuseEFL` em2) (start1, start2) arr) - -"loopArr/loopSndAcc" forall x. - loopArr (loopSndAcc x) = loopArr x - -"seq/NoAL" forall (u::NoAL) e. - u `seq` e = e - - #-} -