-{-# 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
--
--
-- 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, -- :: Word8 -> ByteString -> ByteString
- null, -- :: ByteString -> Bool
- length, -- :: ByteString -> Int
+ snoc, -- :: ByteString -> Word8 -> ByteString
+ 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
intersperse, -- :: Word8 -> ByteString -> ByteString
transpose, -- :: [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
+ foldr1', -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
-- ** Special folds
concat, -- :: [ByteString] -> 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, -- :: (Word8 -> Maybe (Word8, Word8)) -> Word8 -> ByteString
+ unfoldr, -- :: (a -> Maybe (Word8, a)) -> a -> ByteString
+ unfoldrN, -- :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
-- * Substrings
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
+-- partition -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
- -- ** Prefixes and suffixes
- -- | These functions use memcmp(3) to efficiently compare substrings
- isPrefixOf, -- :: ByteString -> ByteString -> Bool
- isSuffixOf, -- :: ByteString -> ByteString -> Bool
-
- -- ** 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,
- filterF, mapF
-
) where
import qualified Prelude as P
,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
,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(..))
#endif
--- CFILES stuff is Hugs only
-{-# CFILES cbits/fpstring.c #-}
-
-- -----------------------------------------------------------------------------
--
-- Useful macros, until we have bang patterns
-- -----------------------------------------------------------------------------
--- | 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
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 #-}
-- -----------------------------------------------------------------------------
-- 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:
--
#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
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)
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
-{-# INLINE length #-}
+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 #-}
+
+{-# RULES
+
+-- 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
- memcpy (p `plusPtr` 1) (f `plusPtr` s) (fromIntegral l)
+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 #-}
-- 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"
{-# 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"
{-# 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 #-}
-- | /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.
-mapF :: (Word8 -> Word8) -> ByteString -> ByteString
-STRICT2(mapF)
-mapF 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' :: (Word8 -> Word8) -> ByteString -> ByteString
+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_)
x <- peekByteOff p1 n
pokeByteOff p2 n (f x)
map_ (n+1) p1 p2
-{-# INLINE mapF #-}
+{-# 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
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
{-
-- 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 #-}
{-
lgo (f z c) (p `plusPtr` 1) q
-}
+-- | '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' = 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
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 ()
-- | 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.
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
--
-- This implemenation uses @memset(3)@
replicate :: Int -> Word8 -> ByteString
-replicate w c = 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 -> (Word8 -> Maybe (Word8, Word8)) -> Word8 -> ByteString
-unfoldrN i f w = 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
-- 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 #-}
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
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 (==)'
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
#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)
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 #-}
#else
splitWith _ (PS _ _ 0) = []
-splitWith p ps = splitWith' p ps
+splitWith p ps = loop p ps
where
- STRICT2(splitWith')
- splitWith' q qs = if null rest then [chunk]
- else chunk : splitWith' q (unsafeTail rest)
+ STRICT2(loop)
+ loop q qs = if null rest then [chunk]
+ else chunk : loop q (unsafeTail rest)
where (chunk,rest) = break q qs
#endif
-- 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
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 [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
+ 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)
+
+ return (loop 0)
{-# INLINE split #-}
{-
else splitLoop p (idx'+1) off' len' fp'
-}
+{-
-- | Like 'splitWith', except that sequences of adjacent separators are
-- treated as a single separator. eg.
--
--
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
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)
-- '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)
+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)
-- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0.
index :: ByteString -> Int -> Word8
index ps n
- | n < 0 = error $ "ByteString.indexWord8: negative index: " ++ show n
- | n >= length ps = error $ "ByteString.indexWord8: index too large: " ++ show n
- ++ ", length = " ++ show (length ps)
+ | n < 0 = moduleError "index" ("negative index: " ++ show n)
+ | n >= length ps = moduleError "index" ("index too large: " ++ show n
+ ++ ", length = " ++ show (length ps))
| otherwise = ps `unsafeIndex` n
{-# INLINE index #-}
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)
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.
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 = 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
+{-# INLINE elemIndices #-}
{-
-- much slower
-- 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 $ c_count (p `plusPtr` s) (fromIntegral m) w
+ fmap fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w
{-# INLINE count #-}
{-
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
-- 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
-- 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)/ 'filterF' is a non-fuseable version of filter, that may be
+{-
+-- | /O(n)/ 'filter\'' is a non-fuseable version of filter, that may be
-- around 2x faster for some one-shot applications.
-filterF :: (Word8 -> Bool) -> ByteString -> ByteString
-filterF k ps@(PS x s l)
+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
if k w
then poke t w >> go (f `plusPtr` 1) (t `plusPtr` 1) end
else go (f `plusPtr` 1) t end
-{-# INLINE filterF #-}
+{-# INLINE filter' #-}
+-}
--
-- | /O(n)/ A first order equivalent of /filter . (==)/, for the common
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
--
-- filterNotByte is around 2x faster than its filter equivalent.
filterNotByte :: Word8 -> ByteString -> ByteString
-filterNotByte w = filterF (/= 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.
| 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.
| 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))@.
-- | '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.
-- 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 ()
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
-- 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
-- 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
- 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"
-- 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
-- | 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.
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
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
--- | Read an entire file directly into a 'ByteString'. This is far more
+-- | 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 = do
- h <- openBinaryFile f WriteMode
- hPut h ps
- hClose h
+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)
{-
--
-- 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
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
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
-- Common up near identical calls to `error' to reduce the number
-- constant strings created when compiled:
errorEmptyList :: String -> a
-errorEmptyList fun = error ("Data.ByteString." ++ fun ++ ": empty ByteString")
-{-# INLINE errorEmptyList #-}
+errorEmptyList fun = moduleError fun "empty ByteString"
+{-# NOINLINE errorEmptyList #-}
--- '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 #-}
+moduleError :: String -> String -> a
+moduleError fun msg = error ("Data.ByteString." ++ fun ++ ':':' ':msg)
+{-# NOINLINE moduleError #-}
-- Find from the end of the string using predicate
findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int
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 Int
-
-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 -> Int
-
--- ---------------------------------------------------------------------
--- 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))
-{-# INLINE [1] mapEFL #-}
-
--- | 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)
-{-# INLINE [1] filterEFL #-}
-
--- |Element function expressing a reduction only
-foldEFL :: (acc -> Word8 -> acc) -> (acc -> Word8 -> (acc, Maybe Word8))
-foldEFL f = \a e -> (f a e, Nothing)
-{-# INLINE [1] foldEFL #-}
-
--- | No accumulator
-noAL :: NoAL
-noAL = NoAL
-{-# INLINE [1] noAL #-}
-
--- | Projection functions that are fusion friendly (as in, we determine when
--- they are inlined)
-loopArr :: (ByteString, acc) -> ByteString
-loopArr (arr, _) = arr
-{-# INLINE [1] loopArr #-}
-
-loopAcc :: (ByteString, acc) -> acc
-loopAcc (_, acc) = acc
-{-# INLINE [1] loopAcc #-}
-
-loopSndAcc :: (ByteString, (acc1, acc2)) -> (ByteString, acc2)
-loopSndAcc (arr, (_, acc)) = (arr, acc)
-{-# INLINE [1] loopSndAcc #-}
-
-------------------------------------------------------------------------
-
--- | 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'+1) -- realloc
- withForeignPtr fp_ $ \p' -> do
- memcpy p' p (fromIntegral i')
- poke (p' `plusPtr` i') (0::Word8)
- 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'
-
-{-# INLINE [1] loopU #-}
-
-{-# RULES
-
-"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)
-
-"loopArr/loopSndAcc" forall x.
- loopArr (loopSndAcc x) = loopArr x
-
-"seq/NoAL" forall (u::NoAL) e.
- u `seq` e = e
-
- #-}
-
projects / haskell-directory.git / blobdiff