bytestring 0.10.4.1 → 0.10.6.0
raw patch · 22 files changed
+311/−816 lines, 22 filesdep ~basedep ~deepseqPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: base, deepseq
API changes (from Hackage documentation)
- Data.ByteString.Builder: instance IsString Builder
+ Data.ByteString.Builder: instance Data.String.IsString Data.ByteString.Builder.Internal.Builder
+ Data.ByteString.Lazy: elemIndexEnd :: Word8 -> ByteString -> Maybe Int64
+ Data.ByteString.Lazy.Char8: isSuffixOf :: ByteString -> ByteString -> Bool
Files
- Changelog.md +18/−0
- Data/ByteString.hs +150/−295
- Data/ByteString/Builder.hs +3/−1
- Data/ByteString/Builder/ASCII.hs +5/−0
- Data/ByteString/Builder/Internal.hs +10/−3
- Data/ByteString/Builder/Prim/ASCII.hs +4/−0
- Data/ByteString/Builder/Prim/Binary.hs +3/−0
- Data/ByteString/Builder/Prim/Internal/Base16.hs +3/−0
- Data/ByteString/Builder/Prim/Internal/Floating.hs +4/−0
- Data/ByteString/Builder/Prim/Internal/UncheckedShifts.hs +3/−0
- Data/ByteString/Char8.hs +9/−19
- Data/ByteString/Internal.hs +23/−22
- Data/ByteString/Lazy.hs +27/−60
- Data/ByteString/Lazy/Char8.hs +6/−20
- Data/ByteString/Lazy/Internal.hs +2/−0
- Data/ByteString/Short/Internal.hs +8/−5
- Data/ByteString/Unsafe.hs +6/−13
- LICENSE +1/−1
- TODO +0/−71
- bytestring.cabal +5/−11
- tests/Properties.hs +21/−260
- tests/QuickCheckUtils.hs +0/−35
+ Changelog.md view
@@ -0,0 +1,18 @@++0.10.6.0 Duncan Coutts <duncan@community.haskell.org> Mar 2015++ * Rename inlinePerformIO so people don't misuse it+ * Fix a corner case in unfoldrN+ * Export isSuffixOf from D.B.Lazy.Char8+ * Add D.B.Lazy.elemIndexEnd+ * Fix readFile for files with incorrectly reported file size+ * Fix for builder performance with ghc 7.10+ * Fix building with ghc 6.12++0.10.4.1 Duncan Coutts <duncan@community.haskell.org> Nov 2014++ * Fix integer overflow in concatenation functions+ * Fix strictness of lazy bytestring foldl'+ * Numerous minor documentation fixes+ * Various testsuite improvements+
Data/ByteString.hs view
@@ -237,15 +237,13 @@ import Foreign.C.String (CString, CStringLen) import Foreign.C.Types (CSize)+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, touchForeignPtr) #if MIN_VERSION_base(4,5,0)-import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr- ,touchForeignPtr) import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) #else-import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr- ,touchForeignPtr, unsafeForeignPtrToPtr)+import Foreign.ForeignPtr (unsafeForeignPtrToPtr) #endif-import Foreign.Marshal.Alloc (allocaBytes, mallocBytes, reallocBytes, finalizerFree)+import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Marshal.Array (allocaArray) import Foreign.Ptr import Foreign.Storable (Storable(..))@@ -256,7 +254,9 @@ ,IOMode(..)) import System.IO.Error (mkIOError, illegalOperationErrorType) +#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (Monoid(..))+#endif #if !defined(__GLASGOW_HASKELL__) import System.IO.Unsafe@@ -315,17 +315,7 @@ unsafeDupablePerformIO = unsafePerformIO #endif --- ----------------------------------------------------------------------------------- Useful macros, until we have bang patterns--- -#define STRICT1(f) f a | a `seq` False = undefined-#define STRICT2(f) f a b | a `seq` b `seq` False = undefined-#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined-#define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined-#define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined- -- ----------------------------------------------------------------------------- -- Introducing and eliminating 'ByteString's @@ -430,7 +420,7 @@ head :: ByteString -> Word8 head (PS x s l) | l <= 0 = errorEmptyList "head"- | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p s+ | otherwise = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> peekByteOff p s {-# INLINE head #-} -- | /O(1)/ Extract the elements after the head of a ByteString, which must be non-empty.@@ -446,8 +436,8 @@ uncons :: ByteString -> Maybe (Word8, ByteString) uncons (PS x s l) | l <= 0 = Nothing- | otherwise = Just (inlinePerformIO $ withForeignPtr x- $ \p -> peekByteOff p s,+ | otherwise = Just (accursedUnutterablePerformIO $ withForeignPtr x+ $ \p -> peekByteOff p s, PS x (s+1) (l-1)) {-# INLINE uncons #-} @@ -456,7 +446,8 @@ last :: ByteString -> Word8 last ps@(PS x s l) | null ps = errorEmptyList "last"- | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+l-1)+ | otherwise = accursedUnutterablePerformIO $+ withForeignPtr x $ \p -> peekByteOff p (s+l-1) {-# INLINE last #-} -- | /O(1)/ Return all the elements of a 'ByteString' except the last one.@@ -473,8 +464,8 @@ unsnoc (PS x s l) | l <= 0 = Nothing | otherwise = Just (PS x s (l-1),- inlinePerformIO $ withForeignPtr x- $ \p -> peekByteOff p (s+l-1))+ accursedUnutterablePerformIO $+ withForeignPtr x $ \p -> peekByteOff p (s+l-1)) {-# INLINE unsnoc #-} -- | /O(n)/ Append two ByteStrings@@ -492,8 +483,7 @@ create len $ map_ 0 (a `plusPtr` s) where map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO ()- STRICT3(map_)- map_ n p1 p2+ map_ !n !p1 !p2 | n >= len = return () | otherwise = do x <- peekByteOff p1 n@@ -535,7 +525,7 @@ where -- not tail recursive; traverses array right to left go !p !q | p == q = z- | otherwise = let !x = inlinePerformIO $ do+ | otherwise = let !x = accursedUnutterablePerformIO $ do x' <- peek p touchForeignPtr fp return x'@@ -546,7 +536,7 @@ -- foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a foldl' f v (PS fp off len) =- inlinePerformIO $ withForeignPtr fp $ \p ->+ accursedUnutterablePerformIO $ withForeignPtr fp $ \p -> go v (p `plusPtr` off) (p `plusPtr` (off+len)) where -- tail recursive; traverses array left to right@@ -565,7 +555,7 @@ where -- not tail recursive; traverses array left to right go !p !q | p == q = z- | otherwise = let !x = inlinePerformIO $ do+ | otherwise = let !x = accursedUnutterablePerformIO $ do x' <- peek p touchForeignPtr fp return x'@@ -575,7 +565,7 @@ -- | 'foldr'' is like 'foldr', but strict in the accumulator. foldr' :: (Word8 -> a -> a) -> a -> ByteString -> a foldr' k v (PS fp off len) =- inlinePerformIO $ withForeignPtr fp $ \p ->+ accursedUnutterablePerformIO $ withForeignPtr fp $ \p -> go v (p `plusPtr` (off+len-1)) (p `plusPtr` (off-1)) where -- tail recursive; traverses array right to left@@ -635,14 +625,13 @@ -- any element of the 'ByteString' satisfies the predicate. any :: (Word8 -> Bool) -> ByteString -> Bool any _ (PS _ _ 0) = False-any f (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->+any f (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \ptr -> go (ptr `plusPtr` s) (ptr `plusPtr` (s+l)) where- STRICT2(go)- go p q | p == q = return False- | otherwise = do c <- peek p- if f c then return True- else go (p `plusPtr` 1) q+ go !p !q | p == q = return False+ | otherwise = do c <- peek p+ if f c then return True+ else go (p `plusPtr` 1) q {-# INLINE any #-} -- todo fuse@@ -651,15 +640,14 @@ -- if all elements of the 'ByteString' satisfy the predicate. all :: (Word8 -> Bool) -> ByteString -> Bool all _ (PS _ _ 0) = True-all f (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->+all f (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \ptr -> go (ptr `plusPtr` s) (ptr `plusPtr` (s+l)) where- STRICT2(go)- go p q | p == q = return True -- end of list- | otherwise = do c <- peek p- if f c- then go (p `plusPtr` 1) q- else return False+ go !p !q | p == q = return True -- end of list+ | otherwise = do c <- peek p+ if f c+ then go (p `plusPtr` 1) q+ else return False {-# INLINE all #-} ------------------------------------------------------------------------@@ -670,7 +658,7 @@ maximum :: ByteString -> Word8 maximum xs@(PS x s l) | null xs = errorEmptyList "maximum"- | otherwise = inlinePerformIO $ withForeignPtr x $ \p ->+ | otherwise = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> c_maximum (p `plusPtr` s) (fromIntegral l) {-# INLINE maximum #-} @@ -680,7 +668,7 @@ minimum :: ByteString -> Word8 minimum xs@(PS x s l) | null xs = errorEmptyList "minimum"- | otherwise = inlinePerformIO $ withForeignPtr x $ \p ->+ | otherwise = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> c_minimum (p `plusPtr` s) (fromIntegral l) {-# INLINE minimum #-} @@ -696,8 +684,7 @@ acc' <- withForeignPtr gp $ \p -> mapAccumL_ acc 0 (a `plusPtr` o) p return $! (acc', PS gp 0 len) where- STRICT4(mapAccumL_)- mapAccumL_ s n p1 p2+ mapAccumL_ !s !n !p1 !p2 | n >= len = return s | otherwise = do x <- peekByteOff p1 n@@ -716,8 +703,7 @@ acc' <- withForeignPtr gp $ \p -> mapAccumR_ acc (len-1) (a `plusPtr` o) p return $! (acc', PS gp 0 len) where- STRICT4(mapAccumR_)- mapAccumR_ s n p q+ mapAccumR_ !s !n !p !q | n < 0 = return s | otherwise = do x <- peekByteOff p n@@ -745,8 +731,7 @@ poke q v scanl_ v 0 (a `plusPtr` s) (q `plusPtr` 1) where- STRICT4(scanl_)- scanl_ z n p q+ scanl_ !z !n !p !q | n >= len = return () | otherwise = do x <- peekByteOff p n@@ -776,8 +761,7 @@ poke (q `plusPtr` len) v scanr_ v (len-1) (a `plusPtr` s) q where- STRICT4(scanr_)- scanr_ z n p q+ scanr_ !z !n !p !q | n < 0 = return () | otherwise = do x <- peekByteOff p n@@ -841,14 +825,13 @@ 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)+ where+ go !p !x !n+ | n == i = return (0, n, Just x)+ | otherwise = case f x of+ Nothing -> return (0, n, Nothing)+ Just (w,x') -> do poke p w+ go (p `plusPtr` 1) x' (n+1) {-# INLINE unfoldrN #-} -- ---------------------------------------------------------------------@@ -928,6 +911,7 @@ Nothing -> (p,empty) Just n -> (unsafeTake n p, unsafeDrop n p) {-# INLINE breakByte #-}+{-# DEPRECATED breakByte "It is an internal function and should never have been exported. Use 'break (== x)' instead. (There are rewrite rules that handle this special case of 'break'.)" #-} -- | 'breakEnd' behaves like 'break' but from the end of the 'ByteString' -- @@ -950,15 +934,16 @@ -- > span (=='c') "abcd" == spanByte 'c' "abcd" -- spanByte :: Word8 -> ByteString -> (ByteString, ByteString)-spanByte c ps@(PS x s l) = inlinePerformIO $ withForeignPtr x $ \p ->- go (p `plusPtr` s) 0+spanByte c ps@(PS x s l) =+ accursedUnutterablePerformIO $+ withForeignPtr x $ \p ->+ go (p `plusPtr` s) 0 where- STRICT2(go)- go p i | i >= l = return (ps, empty)- | otherwise = do c' <- peekByteOff p i- if c /= c'- then return (unsafeTake i ps, unsafeDrop i ps)- else go p (i+1)+ go !p !i | i >= l = return (ps, empty)+ | otherwise = do c' <- peekByteOff p i+ if c /= c'+ then return (unsafeTake i ps, unsafeDrop i ps)+ else go p (i+1) {-# INLINE spanByte #-} {-# RULES@@ -997,9 +982,10 @@ splitWith pred_ (PS fp off len) = splitWith0 pred# off len fp where pred# c# = pred_ (W8# c#) - STRICT4(splitWith0)- splitWith0 pred' off' len' fp' = withPtr fp $ \p ->- splitLoop pred' p 0 off' len' fp'+ splitWith0 !pred' !off' !len' !fp' =+ accursedUnutterablePerformIO $+ withForeignPtr fp $ \p ->+ splitLoop pred' p 0 off' len' fp' splitLoop :: (Word# -> Bool) -> Ptr Word8@@ -1021,9 +1007,8 @@ splitWith _ (PS _ _ 0) = [] splitWith p ps = loop p ps where- STRICT2(loop)- loop q qs = if null rest then [chunk]- else chunk : loop q (unsafeTail rest)+ loop !q !qs = if null rest then [chunk]+ else chunk : loop q (unsafeTail rest) where (chunk,rest) = break q qs #endif @@ -1047,54 +1032,19 @@ split _ (PS _ _ 0) = [] split w (PS x s l) = loop 0 where- STRICT1(loop)- loop n =- let q = inlinePerformIO $ withForeignPtr x $ \p ->+ loop !n =+ let q = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> memchr (p `plusPtr` (s+n)) w (fromIntegral (l-n)) in if q == nullPtr then [PS x (s+n) (l-n)]- else let i = inlinePerformIO $ withForeignPtr x $ \p ->+ else let i = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> return (q `minusPtr` (p `plusPtr` s)) in PS x (s+n) (i-n) : loop (i+1) {-# INLINE split #-} -{---- slower. but stays inside Haskell.-split _ (PS _ _ 0) = []-split (W8# w#) (PS fp off len) = splitWith' off len fp- where- splitWith' off' len' fp' = withPtr fp $ \p ->- splitLoop p 0 off' len' fp' - splitLoop :: Ptr Word8- -> Int -> Int -> Int- -> ForeignPtr Word8- -> IO [ByteString]-- STRICT5(splitLoop)- splitLoop p idx' off' len' fp'- | idx' >= len' = return [PS fp' off' idx']- | otherwise = do- (W8# x#) <- peekElemOff p (off'+idx')- if word2Int# w# ==# word2Int# x#- then return (PS fp' off' idx' :- splitWith' (off'+idx'+1) (len'-idx'-1) fp')- else splitLoop p (idx'+1) off' len' fp'--}--{---- | Like 'splitWith', except that sequences of adjacent separators are--- treated as a single separator. eg.--- --- > tokens (=='a') "aabbaca" == ["bb","c"]----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 -- argument. Moreover, each sublist in the result contains only equal@@ -1163,7 +1113,7 @@ -- element, or 'Nothing' if there is no such element. -- This implementation uses memchr(3). elemIndex :: Word8 -> ByteString -> Maybe Int-elemIndex c (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do+elemIndex c (PS x s l) = accursedUnutterablePerformIO $ 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'@@ -1178,15 +1128,14 @@ -- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs) -- elemIndexEnd :: Word8 -> ByteString -> Maybe Int-elemIndexEnd ch (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p ->+elemIndexEnd ch (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> go (p `plusPtr` s) (l-1) where- STRICT2(go)- go p i | i < 0 = return Nothing- | otherwise = do ch' <- peekByteOff p i- if ch == ch'- then return $ Just i- else go p (i-1)+ go !p !i | i < 0 = return Nothing+ | otherwise = do ch' <- peekByteOff p i+ if ch == ch'+ then return $ Just i+ else go p (i-1) {-# INLINE elemIndexEnd #-} -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning@@ -1195,66 +1144,37 @@ elemIndices :: Word8 -> ByteString -> [Int] elemIndices w (PS x s l) = loop 0 where- STRICT1(loop)- loop n = let q = inlinePerformIO $ withForeignPtr x $ \p ->+ loop !n = let q = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> memchr (p `plusPtr` (n+s)) w (fromIntegral (l - n))- in if q == nullPtr+ in if q == nullPtr then []- else let i = inlinePerformIO $ withForeignPtr x $ \p ->+ else let i = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> return (q `minusPtr` (p `plusPtr` s)) in i : loop (i+1) {-# INLINE elemIndices #-} -{---- much slower-elemIndices :: Word8 -> ByteString -> [Int]-elemIndices c ps = loop 0 ps- where STRICT2(loop)- loop _ ps' | null ps' = []- loop n ps' | c == unsafeHead ps' = n : loop (n+1) (unsafeTail ps')- | otherwise = loop (n+1) (unsafeTail ps')--}- -- | count returns the number of times its argument appears in the ByteString -- -- > count = length . elemIndices -- -- But more efficiently than using length on the intermediate list. count :: Word8 -> ByteString -> Int-count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p ->+count w (PS x s m) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> fmap fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w {-# INLINE count #-} -{------- around 30% slower----count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p ->- go (p `plusPtr` s) (fromIntegral m) 0- where- go :: Ptr Word8 -> CSize -> Int -> IO Int- STRICT3(go)- go p l i = do- q <- memchr p w l- if q == nullPtr- then return i- else do let k = fromIntegral $ q `minusPtr` p- go (q `plusPtr` 1) (l-k-1) (i+1)--}- -- | The 'findIndex' function takes a predicate and a 'ByteString' and -- returns the index of the first element in the ByteString -- satisfying the predicate. findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int-findIndex k (PS x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0+findIndex k (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0 where- STRICT2(go)- go ptr n | n >= l = return Nothing- | otherwise = do w <- peek ptr- if k w- then return (Just n)- else go (ptr `plusPtr` 1) (n+1)+ go !ptr !n | n >= l = return Nothing+ | otherwise = do w <- peek ptr+ if k w+ then return (Just n)+ else go (ptr `plusPtr` 1) (n+1) {-# INLINE findIndex #-} -- | The 'findIndices' function extends 'findIndex', by returning the@@ -1262,10 +1182,9 @@ findIndices :: (Word8 -> Bool) -> ByteString -> [Int] findIndices p ps = loop 0 ps where- STRICT2(loop)- loop n qs | null qs = []- | p (unsafeHead qs) = n : loop (n+1) (unsafeTail qs)- | otherwise = loop (n+1) (unsafeTail qs)+ loop !n !qs | null qs = []+ | p (unsafeHead qs) = n : loop (n+1) (unsafeTail qs)+ | otherwise = loop (n+1) (unsafeTail qs) -- --------------------------------------------------------------------- -- Searching ByteStrings@@ -1290,11 +1209,10 @@ t <- go (f `plusPtr` s) p (f `plusPtr` (s + l)) return $! t `minusPtr` p -- actual length where- STRICT3(go)- go f t end | f == end = return t- | otherwise = do- w <- peek f- if k w+ go !f !t !end | f == end = return t+ | otherwise = do+ w <- peek f+ if k w then poke t w >> go (f `plusPtr` 1) (t `plusPtr` 1) end else go (f `plusPtr` 1) t end {-# INLINE filter #-}@@ -1334,16 +1252,6 @@ _ -> Nothing {-# INLINE find #-} -{------- fuseable, but we don't want to walk the whole array.--- -find k = foldl findEFL Nothing- where findEFL a@(Just _) _ = a- findEFL _ c | k c = Just c- | otherwise = Nothing--}- -- | /O(n)/ The 'partition' function takes a predicate a ByteString and returns -- the pair of ByteStrings with elements which do and do not satisfy the -- predicate, respectively; i.e.,@@ -1363,7 +1271,7 @@ isPrefixOf (PS x1 s1 l1) (PS x2 s2 l2) | l1 == 0 = True | l2 < l1 = False- | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 ->+ | otherwise = accursedUnutterablePerformIO $ withForeignPtr x1 $ \p1 -> withForeignPtr x2 $ \p2 -> do i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral l1) return $! i == 0@@ -1381,7 +1289,7 @@ isSuffixOf (PS x1 s1 l1) (PS x2 s2 l2) | l1 == 0 = True | l2 < l1 = False- | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 ->+ | otherwise = accursedUnutterablePerformIO $ withForeignPtr x1 $ \p1 -> withForeignPtr x2 $ \p2 -> do i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2 `plusPtr` (l2 - l1)) (fromIntegral l1) return $! i == 0@@ -1425,8 +1333,7 @@ breakSubstring pat src = search 0 src where- STRICT2(search)- search n s+ search !n !s | null s = (src,empty) -- not found | pat `isPrefixOf` s = (take n src,s) | otherwise = search (n+1) (unsafeTail s)@@ -1441,19 +1348,6 @@ {-# DEPRECATED findSubstring "findSubstring is deprecated in favour of breakSubstring." #-} -{--findSubstring pat str = search 0 str- where- STRICT2(search)- search n s- = let x = pat `isPrefixOf` s- in- if null s- then if x then Just n else Nothing- else if x then Just n- else search (n+1) (unsafeTail s)--}- -- | Find the indexes of all (possibly overlapping) occurances of a -- substring in a string. --@@ -1464,37 +1358,13 @@ | null pat = [0 .. length str] | otherwise = search 0 str where- STRICT2(search)- search n s+ search !n !s | null s = [] | pat `isPrefixOf` s = n : search (n+1) (unsafeTail s) | otherwise = search (n+1) (unsafeTail s) {-# DEPRECATED findSubstrings "findSubstrings is deprecated in favour of breakSubstring." #-} -{--{- This function uses the Knuth-Morris-Pratt string matching algorithm. -}--findSubstrings pat@(PS _ _ m) str@(PS _ _ n) = search 0 0- where- patc x = pat `unsafeIndex` x- strc x = str `unsafeIndex` x-- -- maybe we should make kmpNext a UArray before using it in search?- kmpNext = listArray (0,m) (-1:kmpNextL pat (-1))- kmpNextL p _ | null p = []- kmpNextL p j = let j' = next (unsafeHead p) j + 1- ps = unsafeTail p- x = if not (null ps) && unsafeHead ps == patc j'- then kmpNext Array.! j' else j'- in x:kmpNextL ps j'- search i j = match ++ rest -- i: position in string, j: position in pattern- where match = if j == m then [(i - j)] else []- rest = if i == n then [] else search (i+1) (next (strc i) j + 1)- next c j | j >= 0 && (j == m || c /= patc j) = next c (kmpNext Array.! j)- | otherwise = j--}- -- --------------------------------------------------------------------- -- Zipping @@ -1530,8 +1400,7 @@ 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+ zipWith_ !n !p1 !p2 !r | n >= len = return () | otherwise = do x <- peekByteOff p1 n@@ -1577,42 +1446,25 @@ _ <- memset (castPtr arr) 0 (256 * fromIntegral (sizeOf (undefined :: CSize))) withForeignPtr input (\x -> countOccurrences arr (x `plusPtr` s) l) - let STRICT2(go)- go 256 _ = return ()- go i ptr = do n <- peekElemOff arr i- when (n /= 0) $ memset ptr (fromIntegral i) n >> return ()- go (i + 1) (ptr `plusPtr` (fromIntegral n))+ let go 256 !_ = return ()+ go i !ptr = do n <- peekElemOff arr i+ when (n /= 0) $ memset ptr (fromIntegral i) n >> return ()+ go (i + 1) (ptr `plusPtr` (fromIntegral n)) go 0 p where -- | Count the number of occurrences of each byte. -- Used by 'sort' -- countOccurrences :: Ptr CSize -> Ptr Word8 -> Int -> IO ()- STRICT3(countOccurrences)- countOccurrences counts str len = go 0+ countOccurrences !counts !str !len = go 0 where- STRICT1(go)- go i | i == len = return ()- | otherwise = do k <- fromIntegral `fmap` peekElemOff str i- x <- peekElemOff counts k- pokeElemOff counts k (x + 1)- go (i + 1)+ go !i | i == len = 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) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> do- memcpy p (f `plusPtr` s) l- c_qsort p l -- inplace--} --- The 'sortBy' function is the non-overloaded version of 'sort'.------ Try some linear sorts: radix, counting--- Or mergesort.------ sortBy :: (Word8 -> Word8 -> Ordering) -> ByteString -> ByteString--- sortBy f ps = undefined- -- --------------------------------------------------------------------- -- Low level constructors @@ -1692,8 +1544,7 @@ else haveBuf h_ buf 0 [] where - fill h_@Handle__{haByteBuffer,haDevice} buf len xss =- len `seq` do+ fill h_@Handle__{haByteBuffer,haDevice} buf !len xss = do (r,buf') <- Buffered.fillReadBuffer haDevice buf if r == 0 then do writeIORef haByteBuffer buf{ bufR=0, bufL=0 }@@ -1752,8 +1603,7 @@ hGetLineBufferedLoop handle_ ref buf 0 [] hGetLineBufferedLoop handle_ ref- buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } len xss =- len `seq` do+ buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } !len xss = do off <- findEOL r w raw let new_len = len + off - r xs <- mkPS raw r off@@ -1865,7 +1715,7 @@ -- is far more efficient than reading the characters into a 'String' -- and then using 'pack'. First argument is the Handle to read from, -- and the second is the number of bytes to read. It returns the bytes--- read, up to n, or 'null' if EOF has been reached.+-- read, up to n, or 'empty' if EOF has been reached. -- -- 'hGet' is implemented in terms of 'hGetBuf'. --@@ -1930,10 +1780,10 @@ msg = fn ++ ": illegal ByteString size " ++ showsPrec 9 sz [] --- | Read entire handle contents strictly into a 'ByteString'.+-- | Read a handle's entire contents strictly 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+-- This function reads chunks at a time, increasing the chunk size on each+-- read. The final string 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. --@@ -1941,28 +1791,33 @@ -- or if an exception is thrown. -- hGetContents :: Handle -> IO ByteString-hGetContents h = always (hClose h) $ do -- strict, so hClose- let start_size = 1024- p <- mallocBytes start_size- i <- hGetBuf h p start_size- if i < start_size- then do p' <- reallocBytes p i- fp <- newForeignPtr finalizerFree p'- return $! PS fp 0 i- else f p start_size- where- always = flip finally- f p s = do- let s' = 2 * s- p' <- reallocBytes p s'- i <- hGetBuf h (p' `plusPtr` s) s- if i < s- then do let i' = s + i- p'' <- reallocBytes p' i'- fp <- newForeignPtr finalizerFree p''- return $! PS fp 0 i'- else f p' s'+hGetContents hnd = do+ bs <- hGetContentsSizeHint hnd 1024 2048+ `finally` hClose hnd+ -- don't waste too much space for small files:+ if length bs < 900+ then return $! copy bs+ else return bs +hGetContentsSizeHint :: Handle+ -> Int -- ^ first read size+ -> Int -- ^ initial buffer size increment+ -> IO ByteString+hGetContentsSizeHint hnd =+ readChunks []+ where+ readChunks chunks sz sz' = do+ fp <- mallocByteString sz+ readcount <- withForeignPtr fp $ \buf -> hGetBuf hnd buf sz+ let chunk = PS fp 0 readcount+ -- We rely on the hGetBuf behaviour (not hGetBufSome) where it reads up+ -- to the size we ask for, or EOF. So short reads indicate EOF.+ if readcount < sz && sz > 0+ then return $! concat (P.reverse (chunk : chunks))+ else readChunks (chunk : chunks) sz' ((sz+sz') `min` 32752)+ -- we grow the buffer sizes, but not too huge+ -- we concatenate in the end anyway+ -- | getContents. Read stdin strictly. Equivalent to hGetContents stdin -- The 'Handle' is closed after the contents have been read. --@@ -1977,14 +1832,18 @@ 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'.+-- | Read an entire file strictly into a 'ByteString'. -- readFile :: FilePath -> IO ByteString-readFile f = bracket (openBinaryFile f ReadMode) hClose- (\h -> hFileSize h >>= hGet h . fromIntegral)+readFile f =+ bracket (openBinaryFile f ReadMode) hClose $ \h -> do+ filesz <- hFileSize h+ let readsz = (fromIntegral filesz `max` 0) + 1+ hGetContentsSizeHint h readsz (readsz `max` 255)+ -- Our initial size is one bigger than the file size so that in the+ -- typical case we will read the whole file in one go and not have+ -- to allocate any more chunks. We'll still do the right thing if the+ -- file size is 0 or is changed before we do the read. -- | Write a 'ByteString' to a file. writeFile :: FilePath -> ByteString -> IO ()@@ -2002,21 +1861,18 @@ -- | '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+findIndexOrEnd k (PS x s l) =+ accursedUnutterablePerformIO $+ 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)+ 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-withPtr fp io = inlinePerformIO (withForeignPtr fp io)-{-# INLINE withPtr #-}- -- Common up near identical calls to `error' to reduce the number -- constant strings created when compiled: errorEmptyList :: String -> a@@ -2041,7 +1897,6 @@ -- Find from the end of the string using predicate findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int-STRICT2(findFromEndUntil) findFromEndUntil f ps@(PS x s l) = if null ps then 0 else if f (unsafeLast ps) then l
Data/ByteString/Builder.hs view
@@ -266,7 +266,9 @@ -- HADDOCK only imports import qualified Data.ByteString as S (concat)-import Data.Monoid+#if !(MIN_VERSION_base(4,8,0))+import Data.Monoid (Monoid(..))+#endif import Data.Foldable (foldMap) import Data.List (intersperse)
Data/ByteString/Builder/ASCII.hs view
@@ -86,14 +86,19 @@ #if defined(__GLASGOW_HASKELL__) && defined(INTEGER_GMP)++#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (mappend)+# endif import Foreign.C.Types import qualified Data.ByteString.Builder.Prim.Internal as P import Data.ByteString.Builder.Prim.Internal.UncheckedShifts ( caseWordSize_32_64 ) +# if __GLASGOW_HASKELL__ < 710 import GHC.Num (quotRemInteger)+# endif import GHC.Types (Int(..))
Data/ByteString/Builder/Internal.hs view
@@ -129,10 +129,13 @@ ) where import Control.Arrow (second)-import Control.Applicative (Applicative(..), (<$>))--- import Control.Exception (return) +#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid+import Control.Applicative (Applicative(..))+#endif+import Control.Applicative ((<$>))+ import qualified Data.ByteString as S import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy.Internal as L@@ -385,7 +388,11 @@ -- only exported for use in rewriting rules. Use 'mempty' otherwise. {-# INLINE[1] empty #-} empty :: Builder-empty = Builder id+empty = Builder (\cont -> (\range -> cont range))+-- This eta expansion (hopefully) allows GHC to worker-wrapper the+-- 'BufferRange' in the 'empty' base case of loops (since+-- worker-wrapper requires (TODO: verify this) that all paths match+-- against the wrapped argument. -- | Concatenate two 'Builder's. This function is only exported for use in rewriting -- rules. Use 'mappend' otherwise.
Data/ByteString/Builder/Prim/ASCII.hs view
@@ -1,4 +1,8 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface #-}+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif -- | Copyright : (c) 2010 Jasper Van der Jeugt -- (c) 2010 - 2011 Simon Meier -- License : BSD3-style (see LICENSE)
Data/ByteString/Builder/Prim/Binary.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE CPP, BangPatterns #-}+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif -- | Copyright : (c) 2010-2011 Simon Meier -- License : BSD3-style (see LICENSE) --
Data/ByteString/Builder/Prim/Internal/Base16.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE)
Data/ByteString/Builder/Prim/Internal/Floating.hs view
@@ -1,4 +1,8 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif -- | -- Copyright : (c) 2010 Simon Meier --
Data/ByteString/Builder/Prim/Internal/UncheckedShifts.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE CPP, MagicHash #-}+#if __GLASGOW_HASKELL__ >= 703+{-# LANGUAGE Unsafe #-}+#endif -- | -- Copyright : (c) 2010 Simon Meier --
Data/ByteString/Char8.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, BangPatterns #-} #if __GLASGOW_HASKELL__ {-# LANGUAGE MagicHash, UnboxedTuples #-} #endif@@ -266,10 +266,6 @@ #endif import Foreign -#define STRICT1(f) f a | a `seq` False = undefined-#define STRICT2(f) f a b | a `seq` b `seq` False = undefined-#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined-#define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined ------------------------------------------------------------------------ @@ -810,7 +806,7 @@ -- > break isSpace == breakSpace -- breakSpace :: ByteString -> (ByteString,ByteString)-breakSpace (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do+breakSpace (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do i <- firstspace (p `plusPtr` s) 0 l return $! case () of {_ | i == 0 -> (empty, PS x s l)@@ -820,8 +816,7 @@ {-# INLINE breakSpace #-} firstspace :: Ptr Word8 -> Int -> Int -> IO Int-STRICT3(firstspace)-firstspace ptr n m+firstspace !ptr !n !m | n >= m = return n | otherwise = do w <- peekByteOff ptr n if (not . isSpaceWord8) w then firstspace ptr (n+1) m else return n@@ -833,14 +828,13 @@ -- > dropWhile isSpace == dropSpace -- dropSpace :: ByteString -> ByteString-dropSpace (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do+dropSpace (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do i <- firstnonspace (p `plusPtr` s) 0 l return $! if i == l then empty else PS x (s+i) (l-i) {-# INLINE dropSpace #-} firstnonspace :: Ptr Word8 -> Int -> Int -> IO Int-STRICT3(firstnonspace)-firstnonspace ptr n m+firstnonspace !ptr !n !m | n >= m = return n | otherwise = do w <- peekElemOff ptr n if isSpaceWord8 w then firstnonspace ptr (n+1) m else return n@@ -854,13 +848,12 @@ -- but it is more efficient than using multiple reverses. -- dropSpaceEnd :: ByteString -> ByteString-dropSpaceEnd (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do+dropSpaceEnd (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do i <- lastnonspace (p `plusPtr` s) (l-1) return $! if i == (-1) then empty else PS x s (i+1) {-# INLINE dropSpaceEnd #-} lastnonspace :: Ptr Word8 -> Int -> IO Int-STRICT2(lastnonspace) lastnonspace ptr n | n < 0 = return n | otherwise = do w <- peekElemOff ptr n@@ -882,10 +875,9 @@ -- Just as fast, but more complex. Should be much faster, I thought. lines :: ByteString -> [ByteString] lines (PS _ _ 0) = []-lines (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do+lines (PS x s l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do let ptr = p `plusPtr` s - STRICT1(loop) loop n = do let q = memchr (ptr `plusPtr` n) 0x0a (fromIntegral (l-n)) if q == nullPtr@@ -930,8 +922,7 @@ _ -> loop False 0 0 as where loop :: Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString)- STRICT4(loop)- loop neg i n ps+ loop neg !i !n !ps | null ps = end neg i n ps | otherwise = case B.unsafeHead ps of@@ -966,8 +957,7 @@ loop :: Int -> Int -> [Integer] -> ByteString -> (Integer, ByteString)- STRICT4(loop)- loop d acc ns ps+ loop !d !acc ns !ps | null ps = combine d acc ns empty | otherwise = case B.unsafeHead ps of
Data/ByteString/Internal.hs view
@@ -38,6 +38,7 @@ #if defined(__GLASGOW_HASKELL__) unsafePackAddress, #endif+ checkedSum, -- * Low level imperative construction create, -- :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString@@ -53,7 +54,6 @@ toForeignPtr, -- :: ByteString -> (ForeignPtr Word8, Int, Int) -- * Utilities- inlinePerformIO, -- :: IO a -> a nullForeignPtr, -- :: ForeignPtr Word8 -- * Standard C Functions@@ -73,8 +73,11 @@ c_count, -- :: Ptr Word8 -> CInt -> Word8 -> IO CInt -- * Chars- w2c, c2w, isSpaceWord8, isSpaceChar8+ w2c, c2w, isSpaceWord8, isSpaceChar8, + -- * Deprecated and unmentionable+ accursedUnutterablePerformIO, -- :: IO a -> a+ inlinePerformIO -- :: IO a -> a ) where import Prelude hiding (concat)@@ -90,8 +93,10 @@ #endif import Foreign.C.String (CString) +#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (Monoid(..))-import Control.DeepSeq (NFData)+#endif+import Control.DeepSeq (NFData(rnf)) #if MIN_VERSION_base(3,0,0) import Data.String (IsString(..))@@ -170,17 +175,7 @@ assertS s False = error ("assertion failed at "++s) #endif --- ----------------------------------------------------------------------------------- Useful macros, until we have bang patterns--- -#define STRICT1(f) f a | a `seq` False = undefined-#define STRICT2(f) f a b | a `seq` b `seq` False = undefined-#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined-#define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined-#define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined- -- ----------------------------------------------------------------------------- -- | A space-efficient representation of a 'Word8' vector, supporting many@@ -209,7 +204,8 @@ mappend = append mconcat = concat -instance NFData ByteString+instance NFData ByteString where+ rnf (PS _ _ _) = () instance Show ByteString where showsPrec p ps r = showsPrec p (unpackChars ps) r@@ -246,7 +242,7 @@ {-# RULES "ByteString packChars/packAddress" forall s .- packChars (unpackCString# s) = inlinePerformIO (unsafePackAddress s)+ packChars (unpackCString# s) = accursedUnutterablePerformIO (unsafePackAddress s) #-} #endif @@ -355,7 +351,7 @@ unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8] unpackAppendBytesStrict (PS fp off len) xs =- inlinePerformIO $ withForeignPtr fp $ \base -> do+ accursedUnutterablePerformIO $ withForeignPtr fp $ \base -> do loop (base `plusPtr` (off-1)) (base `plusPtr` (off-1+len)) xs where loop !sentinal !p acc@@ -365,7 +361,7 @@ unpackAppendCharsStrict :: ByteString -> [Char] -> [Char] unpackAppendCharsStrict (PS fp off len) xs =- inlinePerformIO $ withForeignPtr fp $ \base ->+ accursedUnutterablePerformIO $ withForeignPtr fp $ \base -> loop (base `plusPtr` (off-1)) (base `plusPtr` (off-1+len)) xs where loop !sentinal !p acc@@ -508,7 +504,7 @@ compareBytes :: ByteString -> ByteString -> Ordering compareBytes (PS _ _ 0) (PS _ _ 0) = EQ -- short cut for empty strings compareBytes (PS fp1 off1 len1) (PS fp2 off2 len2) =- inlinePerformIO $+ accursedUnutterablePerformIO $ withForeignPtr fp1 $ \p1 -> withForeignPtr fp2 $ \p2 -> do i <- memcmp (p1 `plusPtr` off1) (p2 `plusPtr` off2) (min len1 len2)@@ -617,13 +613,18 @@ -- Yield not to its blasphemous call! Flee traveller! Flee or you will be -- corrupted and devoured! ---{-# INLINE inlinePerformIO #-}-inlinePerformIO :: IO a -> a+{-# INLINE accursedUnutterablePerformIO #-}+accursedUnutterablePerformIO :: IO a -> a #if defined(__GLASGOW_HASKELL__)-inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r+accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r #else-inlinePerformIO = unsafePerformIO+accursedUnutterablePerformIO = unsafePerformIO #endif++inlinePerformIO :: IO a -> a+inlinePerformIO = accursedUnutterablePerformIO+{-# INLINE inlinePerformIO #-}+{-# DEPRECATED inlinePerformIO "If you think you know what you are doing, use 'unsafePerformIO'. If you are sure you know what you are doing, use 'unsafeDupablePerformIO'. If you enjoy sharing an address space with a malevolent agent of chaos, try 'accursedUnutterablePerformIO'." #-} -- --------------------------------------------------------------------- --
Data/ByteString/Lazy.hs view
@@ -166,6 +166,7 @@ -- * Indexing ByteStrings index, -- :: ByteString -> Int64 -> Word8 elemIndex, -- :: Word8 -> ByteString -> Maybe Int64+ elemIndexEnd, -- :: Word8 -> ByteString -> Maybe Int64 elemIndices, -- :: Word8 -> ByteString -> [Int64] findIndex, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int64 findIndices, -- :: (Word8 -> Bool) -> ByteString -> [Int64]@@ -221,7 +222,10 @@ import qualified Data.ByteString.Unsafe as S import Data.ByteString.Lazy.Internal +#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (Monoid(..))+#endif+import Control.Monad (mplus) import Data.Word (Word8) import Data.Int (Int64)@@ -239,17 +243,7 @@ import Foreign.Ptr import Foreign.Storable --- ----------------------------------------------------------------------------------- Useful macros, until we have bang patterns--- -#define STRICT1(f) f a | a `seq` False = undefined-#define STRICT2(f) f a b | a `seq` b `seq` False = undefined-#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined-#define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined-#define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined- -- ----------------------------------------------------------------------------- -- Introducing and eliminating 'ByteString's @@ -295,7 +289,7 @@ toStrict (Chunk c Empty) = c toStrict cs0 = S.unsafeCreate totalLen $ \ptr -> go cs0 ptr where- totalLen = checkedSum "Lazy.toStrict" . L.map S.length . toChunks $ cs0+ totalLen = S.checkedSum "Lazy.toStrict" . L.map S.length . toChunks $ cs0 go Empty !_ = return () go (Chunk (S.PS fp off len) cs) !destptr =@@ -303,18 +297,6 @@ S.memcpy destptr (p `plusPtr` off) len go cs (destptr `plusPtr` len) --- just here in 0.10.4.x, in later version it's exported from .Internal-checkedSum :: String -> [Int] -> Int-checkedSum fun = go 0- where go !a (x:xs)- | ax >= 0 = go ax xs- | otherwise = overflowError fun- where ax = a + x- go a _ = a--overflowError :: String -> a-overflowError fun = error $ "Data.ByteString." ++ fun ++ ": size overflow"- ------------------------------------------------------------------------ {-@@ -489,9 +471,8 @@ -- | 'foldl\'' is like 'foldl', but strict in the accumulator. foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a foldl' f z = go z- where go a _ | a `seq` False = undefined- go a Empty = a- go a (Chunk c cs) = go (S.foldl' f a c) cs+ where go !a Empty = a+ go !a (Chunk c cs) = go (S.foldl' f a c) cs {-# INLINE foldl' #-} -- | 'foldr', applied to a binary operator, a starting value@@ -620,7 +601,7 @@ -- > iterate f x == [x, f x, f (f x), ...] -- iterate :: (Word8 -> Word8) -> Word8 -> ByteString-iterate f = unfoldr (\x -> case f x of x' -> x' `seq` Just (x', x'))+iterate f = unfoldr (\x -> case f x of !x' -> Just (x', x')) -- | @'repeat' x@ is an infinite ByteString, with @x@ the value of every -- element.@@ -830,16 +811,6 @@ comb acc (s:ss) cs = revChunks (s:acc) : comb [] ss cs {-# INLINE split #-} -{---- | Like 'splitWith', except that sequences of adjacent separators are--- treated as a single separator. eg.------ > tokens (=='a') "aabbaca" == ["bb","c"]----tokens :: (Word8 -> Bool) -> ByteString -> [ByteString]-tokens f = L.filter (not.null) . splitWith f--}- -- | The 'group' function takes a ByteString and returns a list of -- ByteStrings such that the concatenation of the result is equal to the -- argument. Moreover, each sublist in the result contains only equal@@ -916,7 +887,6 @@ Nothing -> elemIndex' (n + fromIntegral (S.length c)) cs Just i -> Just (n + fromIntegral i) -{- -- | /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@@ -924,18 +894,16 @@ -- -- > elemIndexEnd c xs == -- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs)----elemIndexEnd :: Word8 -> ByteString -> Maybe Int-elemIndexEnd ch (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p ->- go (p `plusPtr` s) (l-1)++elemIndexEnd :: Word8 -> ByteString -> Maybe Int64+elemIndexEnd w = elemIndexEnd' 0 where- STRICT2(go)- go p i | i < 0 = return Nothing- | otherwise = do ch' <- peekByteOff p i- if ch == ch'- then return $ Just i- else go p (i-1)--}+ elemIndexEnd' _ Empty = Nothing+ elemIndexEnd' n (Chunk c cs) =+ let !n' = n + S.length c+ !i = fmap (fromIntegral . (n +)) $ S.elemIndexEnd w c+ in elemIndexEnd' n' cs `mplus` i+ -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning -- the indices of all elements equal to the query element, in ascending order. -- This implementation uses memchr(3).@@ -1186,8 +1154,7 @@ hGetN :: Int -> Handle -> Int -> IO ByteString hGetN k h n | n > 0 = readChunks n where- STRICT1(readChunks)- readChunks i = do+ readChunks !i = do c <- S.hGet h (min k i) case S.length c of 0 -> return Empty@@ -1205,8 +1172,7 @@ #if defined(__GLASGOW_HASKELL__) hGetNonBlockingN k h n | n > 0= readChunks n where- STRICT1(readChunks)- readChunks i = do+ readChunks !i = do c <- S.hGetNonBlocking h (min k i) case S.length c of 0 -> return Empty@@ -1354,12 +1320,13 @@ -- | 'findIndexOrEnd' is a variant of findIndex, that returns the length -- of the string if no element is found, rather than Nothing. findIndexOrEnd :: (Word8 -> Bool) -> P.ByteString -> Int-findIndexOrEnd k (S.PS x s l) = S.inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0+findIndexOrEnd k (S.PS x s l) =+ S.accursedUnutterablePerformIO $+ 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)+ 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 #-}
Data/ByteString/Lazy/Char8.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, BangPatterns #-} {-# OPTIONS_HADDOCK prune #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-}@@ -129,7 +129,7 @@ -- * Predicates isPrefixOf, -- :: ByteString -> ByteString -> Bool--- isSuffixOf, -- :: ByteString -> ByteString -> Bool+ isSuffixOf, -- :: ByteString -> ByteString -> Bool -- * Searching ByteStrings @@ -197,7 +197,8 @@ import Data.ByteString.Lazy (fromChunks, toChunks, fromStrict, toStrict ,empty,null,length,tail,init,append,reverse,transpose,cycle- ,concat,take,drop,splitAt,intercalate,isPrefixOf,group,inits,tails,copy+ ,concat,take,drop,splitAt,intercalate+ ,isPrefixOf,isSuffixOf,group,inits,tails,copy ,hGetContents, hGet, hPut, getContents ,hGetNonBlocking, hPutNonBlocking ,putStr, hPutStr, interact)@@ -228,12 +229,6 @@ import IO (bracket) #endif -#define STRICT1(f) f a | a `seq` False = undefined-#define STRICT2(f) f a b | a `seq` b `seq` False = undefined-#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined-#define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined-#define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined-#define STRICT5_(f) f a b c d _ | a `seq` b `seq` c `seq` d `seq` False = undefined ------------------------------------------------------------------------ @@ -764,13 +759,6 @@ -- Nothing, otherwise it just returns the int read, and the rest of the -- string. -{---- Faster:--data MaybeS = NothingS- | JustS {-# UNPACK #-} !Int {-# UNPACK #-} !ByteString--}- readInt :: ByteString -> Maybe (Int, ByteString) {-# INLINE readInt #-} readInt Empty = Nothing@@ -781,8 +769,7 @@ where loop :: Bool -> Int -> Int -> S.ByteString -> ByteString -> Maybe (Int, ByteString)- STRICT5_(loop)- loop neg i n c cs+ loop neg !i !n !c cs | B.null c = case cs of Empty -> end neg i n c cs (Chunk c' cs') -> loop neg i n c' cs'@@ -827,8 +814,7 @@ loop :: Int -> Int -> [Integer] -> S.ByteString -> ByteString -> (Integer, ByteString)- STRICT5_(loop)- loop d acc ns c cs+ loop !d !acc ns !c cs | B.null c = case cs of Empty -> combine d acc ns c cs (Chunk c' cs') -> loop d acc ns c' cs'
Data/ByteString/Lazy/Internal.hs view
@@ -53,7 +53,9 @@ import Data.Word (Word8) import Foreign.Storable (Storable(sizeOf)) +#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (Monoid(..))+#endif import Control.DeepSeq (NFData, rnf) #if MIN_VERSION_base(3,0,0)
Data/ByteString/Short/Internal.hs view
@@ -36,7 +36,7 @@ createFromPtr, copyToPtr ) where -import Data.ByteString.Internal (ByteString(..), inlinePerformIO)+import Data.ByteString.Internal (ByteString(..), accursedUnutterablePerformIO) import Data.Typeable (Typeable) import Data.Data (Data(..), mkNoRepType)@@ -108,7 +108,7 @@ -- data ShortByteString = SBS ByteArray# #if !(MIN_VERSION_base(4,3,0))- Int -- ^ Prior to ghc-7.0.x, 'ByteArray#'s reported+ {-# UNPACK #-} !Int -- ^ Prior to ghc-7.0.x, 'ByteArray#'s reported -- their length rounded up to the nearest word. -- This means we have to store the true length -- separately, wasting a word.@@ -136,7 +136,8 @@ mappend = append mconcat = concat -instance NFData ShortByteString+instance NFData ShortByteString where+ rnf (SBS {}) = () instance Show ShortByteString where showsPrec p ps r = showsPrec p (unpackChars ps) r@@ -364,14 +365,16 @@ let !len1 = length sbs1 !len2 = length sbs2 in len1 == len2- && 0 == inlinePerformIO (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len1)+ && 0 == accursedUnutterablePerformIO+ (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len1) compareBytes :: ShortByteString -> ShortByteString -> Ordering compareBytes sbs1 sbs2 = let !len1 = length sbs1 !len2 = length sbs2 !len = min len1 len2- in case inlinePerformIO (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len) of+ in case accursedUnutterablePerformIO+ (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len) of i | i < 0 -> LT | i > 0 -> GT | len2 > len1 -> LT
Data/ByteString/Unsafe.hs view
@@ -2,6 +2,9 @@ #if __GLASGOW_HASKELL__ {-# LANGUAGE MagicHash #-} #endif+#if __GLASGOW_HASKELL__ >= 703+{-# LANGUAGE Unsafe #-}+#endif -- | -- Module : Data.ByteString.Unsafe@@ -81,17 +84,7 @@ assertS s False = error ("assertion failed at "++s) #endif --- ----------------------------------------------------------------------------------- Useful macros, until we have bang patterns--- -#define STRICT1(f) f a | a `seq` False = undefined-#define STRICT2(f) f a b | a `seq` b `seq` False = undefined-#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined-#define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined-#define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined- -- --------------------------------------------------------------------- -- -- Extensions to the basic interface@@ -102,7 +95,7 @@ -- to provide a proof that the ByteString is non-empty. unsafeHead :: ByteString -> Word8 unsafeHead (PS x s l) = assert (l > 0) $- inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p s+ accursedUnutterablePerformIO $ withForeignPtr x $ \p -> peekByteOff p s {-# INLINE unsafeHead #-} -- | A variety of 'tail' for non-empty ByteStrings. 'unsafeTail' omits the@@ -124,7 +117,7 @@ -- provide a separate proof that the ByteString is non-empty. unsafeLast :: ByteString -> Word8 unsafeLast (PS x s l) = assert (l > 0) $- inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+l-1)+ accursedUnutterablePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+l-1) {-# INLINE unsafeLast #-} -- | Unsafe 'ByteString' index (subscript) operator, starting from 0, returning a 'Word8'@@ -133,7 +126,7 @@ -- other way. unsafeIndex :: ByteString -> Int -> Word8 unsafeIndex (PS x s l) i = assert (i >= 0 && i < l) $- inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+i)+ accursedUnutterablePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+i) {-# INLINE unsafeIndex #-} -- | A variety of 'take' which omits the checks on @n@ so there is an
LICENSE view
@@ -1,5 +1,5 @@ Copyright (c) Don Stewart 2005-2009- (c) Duncan Coutts 2006-2011+ (c) Duncan Coutts 2006-2015 (c) David Roundy 2003-2005 (c) Simon Meier 2010-2011
− TODO
@@ -1,71 +0,0 @@-TODO:-- * back port streams fusion code.- * show instance for LPS- * stress testing- * strictness testing- * rewrite C code to Haskell- * eliminate use of -fno-warn-orphans---Todo items-------------* check that api again.- - in particular, unsafeHead/Tail for Char8?- - scanr,scanr1... in Char8--* would it make sense to move the IO bits into a different module too?- - System.IO.ByteString- - Data.ByteString.IO--* can we avoid joinWithByte? - - Hard. Can't do it easily with a rule.--* think about Data.ByteString.hGetLines. is it needed in the presence of- the cheap "lines =<< Data.ByteString.Lazy.getContents" ?--* unchunk, Data.ByteString.Lazy -> [Data.ByteString]- - and that'd work for any Lazy.ByteString, not just hGetContents >>= lines--* It might be nice to have a trim MutableByteArray primitive that can release- the tail of an array back to the GC. This would save copying in cases where- we choose to realloc to save space. This combined with GC-movable strings- might improve fragmentation / space usage for the many small strings case.--* if we can be sure there is very little variance then it might be interesting to look - into the cases where we're doing slightly worse eg the map/up, filter/up cases- and why we're doing so much better in the up/up case!? that one makes no sense- since we should be doing the exact same thing as the old loopU for the up/up- case--* then there are the strictness issues eg our current foldl & foldr are- arguably too strict we could fuse unpack/unpackWith if they wern't so strict--* look at shrinking the chunk size, based on our cache testing.--* think about horizontal fusion (esp. when considering nofib code)--* fuseable reverse.--* 'reverse' is very common in list code, but unnecessary in bytestring- code, since it takes a symmertric view.- look to eliminate it with rules. loopUp . reverse --> loopDown--* work out how robust the rules are .--* benchmark against C string library benchmarks--* work out if we can convince ghc to remove NoAccs in map and filter.--* Implement Lazy:- scanl1- partition- unzip--* fix documentation in Fusion.hs--* Prelude Data.ByteString.Lazy> List.groupBy (/=) $ [97,99,103,103]- [[97,99,103,103]]- Prelude Data.ByteString.Lazy> groupBy (/=) $ pack [97,99,103,103]- [LPS ["ac","g"],LPS ["g"]]
bytestring.cabal view
@@ -1,5 +1,5 @@ Name: bytestring-Version: 0.10.4.1+Version: 0.10.6.0 Synopsis: Fast, compact, strict and lazy byte strings with a list interface Description: An efficient compact, immutable byte string type (both strict and lazy)@@ -44,7 +44,7 @@ License-file: LICENSE Category: Data Copyright: Copyright (c) Don Stewart 2005-2009,- (c) Duncan Coutts 2006-2013,+ (c) Duncan Coutts 2006-2015, (c) David Roundy 2003-2005, (c) Jasper Van der Jeugt 2010, (c) Simon Meier 2010-2013.@@ -54,21 +54,15 @@ Maintainer: Duncan Coutts <duncan@community.haskell.org> Homepage: https://github.com/haskell/bytestring Bug-reports: https://github.com/haskell/bytestring/issues-Tested-With: GHC==7.8.1, GHC==7.6.3, GHC==7.4.2, GHC==7.0.4, GHC==6.12.3+Tested-With: GHC==7.10.1, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==6.12.3 Build-Type: Simple Cabal-Version: >= 1.10-extra-source-files: README.md TODO+extra-source-files: README.md Changelog.md source-repository head type: git location: https://github.com/haskell/bytestring -source-repository this- type: git- location: https://github.com/haskell/bytestring- branch: 0.10.4.x- tag: 0.10.4.1- flag integer-simple description: Use the simple integer library instead of GMP default: False@@ -126,7 +120,7 @@ DeriveDataTypeable, BangPatterns, NamedFieldPuns - ghc-options: -Wall+ ghc-options: -Wall -fwarn-tabs -O2 -fmax-simplifier-iterations=10 -fdicts-cheap
tests/Properties.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP, ScopedTypeVariables, BangPatterns #-} ----- Must have rules off, otherwise the fusion rules will replace the rhs+-- Must have rules off, otherwise the rewrite rules will replace the rhs -- with the lhs, and we only end up testing lhs == lhs -- @@ -77,7 +77,7 @@ prop_anyCC = D.any `eq2` C.any prop_appendCC = D.append `eq2` C.append prop_breakCC = D.break `eq2` C.break-prop_concatMapCC = adjustSize (min 50) $+prop_concatMapCC = forAll (sized $ \n -> resize (min 50 n) arbitrary) $ D.concatMap `eq2` C.concatMap prop_consCC = D.cons `eq2` C.cons prop_consCC' = D.cons' `eq2` C.cons@@ -147,7 +147,7 @@ -- ByteString.Lazy <=> ByteString -- -prop_concatBP = adjustSize (`div` 2) $+prop_concatBP = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $ L.concat `eq1` P.concat prop_nullBP = L.null `eq1` P.null prop_reverseBP = L.reverse `eq1` P.reverse@@ -161,7 +161,7 @@ prop_anyBP = L.any `eq2` P.any prop_appendBP = L.append `eq2` P.append prop_breakBP = L.break `eq2` P.break-prop_concatMapBP = adjustSize (`div` 4) $+prop_concatMapBP = forAll (sized $ \n -> resize (n `div` 4) arbitrary) $ L.concatMap `eq2` P.concatMap prop_consBP = L.cons `eq2` P.cons prop_consBP' = L.cons' `eq2` P.cons@@ -332,7 +332,7 @@ -- properties comparing ByteString.Lazy `eq1` List -- -prop_concatBL = adjustSize (`div` 2) $+prop_concatBL = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $ L.concat `eq1` (concat :: [[W]] -> [W]) prop_lengthBL = L.length `eq1` (toInt64 . length :: [W] -> Int64) prop_nullBL = L.null `eq1` (null :: [W] -> Bool)@@ -346,7 +346,7 @@ prop_anyBL = L.any `eq2` (any :: (W -> Bool) -> [W] -> Bool) prop_appendBL = L.append `eq2` ((++) :: [W] -> [W] -> [W]) prop_breakBL = L.break `eq2` (break :: (W -> Bool) -> [W] -> ([W],[W]))-prop_concatMapBL = adjustSize (`div` 2) $+prop_concatMapBL = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $ L.concatMap `eq2` (concatMap :: (W -> [W]) -> [W] -> [W]) prop_consBL = L.cons `eq2` ((:) :: W -> [W] -> [W]) prop_dropBL = (L.drop . toInt64) `eq2` (drop :: Int -> [W] -> [W])@@ -431,13 +431,13 @@ prop_groupByPL = P.groupBy `eq2` (groupBy :: (W -> W -> Bool) -> [W] -> [[W]]) prop_initsPL = P.inits `eq1` (inits :: [W] -> [[W]]) prop_tailsPL = P.tails `eq1` (tails :: [W] -> [[W]])-prop_concatPL = adjustSize (`div` 2) $+prop_concatPL = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $ P.concat `eq1` (concat :: [[W]] -> [W]) prop_allPL = P.all `eq2` (all :: (W -> Bool) -> [W] -> Bool) prop_anyPL = P.any `eq2` (any :: (W -> Bool) -> [W] -> Bool) prop_appendPL = P.append `eq2` ((++) :: [W] -> [W] -> [W]) prop_breakPL = P.break `eq2` (break :: (W -> Bool) -> [W] -> ([W],[W]))-prop_concatMapPL = adjustSize (`div` 2) $+prop_concatMapPL = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $ P.concatMap `eq2` (concatMap :: (W -> [W]) -> [W] -> [W]) prop_consPL = P.cons `eq2` ((:) :: W -> [W] -> [W]) prop_dropPL = P.drop `eq2` (drop :: Int -> [W] -> [W])@@ -655,8 +655,8 @@ prop_concat1 xs = (concat [xs,xs]) == (unpack $ L.concat [pack xs, pack xs]) prop_concat2 xs = (concat [xs,[]]) == (unpack $ L.concat [pack xs, pack []])-prop_concat3 xss = adjustSize (`div` 2) $- L.concat (map pack xss) == pack (concat xss)+prop_concat3 = forAll (sized $ \n -> resize (n `div` 2) arbitrary) $ \xss ->+ L.concat (map pack xss) == pack (concat xss) prop_concatMap xs = L.concatMap L.singleton xs == (pack . concatMap (:[]) . unpack) xs @@ -667,7 +667,7 @@ prop_minimum xs = (not (null xs)) ==> (minimum xs) == (L.minimum ( pack xs )) prop_replicate1 c =- forAll arbitrarySizedIntegral $ \(Positive n) ->+ forAll arbitrary $ \(Positive n) -> unpack (L.replicate (fromIntegral n) c) == replicate n c prop_replicate2 c = unpack (L.replicate 0 c) == replicate 0 c@@ -1090,6 +1090,14 @@ prop_elemIndexEnd2BB c xs = (P.elemIndexEnd c (P.pack xs)) == ((-) (length xs - 1) `fmap` P.elemIndex c (P.pack $ reverse xs)) +prop_elemIndexEnd1LL c xs = (L.elemIndexEnd c (L.pack xs)) ==+ (case L.elemIndex c (L.pack (reverse xs)) of+ Nothing -> Nothing+ Just i -> Just (fromIntegral (length xs) -1 -i))++prop_elemIndexEnd2LL c xs = (L.elemIndexEnd c (L.pack xs)) ==+ ((-) (fromIntegral (length xs) - 1) `fmap` L.elemIndex c (L.pack $ reverse xs))+ prop_elemIndicesBB xs c = elemIndices c xs == P.elemIndices c (P.pack xs) prop_findIndexBB xs a = (findIndex (==a) xs) == (P.findIndex (==a) (P.pack xs))@@ -1253,207 +1261,7 @@ prop_unzipBB x = let (xs,ys) = unzip x in (P.pack xs, P.pack ys) == P.unzip x ------------------------------------------------------------------------------- And check fusion RULES.--- -{--prop_lazylooploop em1 em2 start1 start2 arr =- loopL em2 start2 (loopArr (loopL em1 start1 arr)) ==- loopSndAcc (loopL (em1 `fuseEFL` em2) (start1 :*: start2) arr)- where- _ = start1 :: Int- _ = start2 :: Int--prop_looploop em1 em2 start1 start2 arr =- loopU em2 start2 (loopArr (loopU em1 start1 arr)) ==- loopSndAcc (loopU (em1 `fuseEFL` em2) (start1 :*: start2) arr)- where- _ = start1 :: Int- _ = start2 :: Int------------------------------------------------------------------------------ check associativity of sequence loops-prop_sequenceloops_assoc n m o x y z a1 a2 a3 xs =-- k ((f * g) * h) == k (f * (g * h)) -- associativity-- where- (*) = sequenceLoops- f = (sel n) x a1- g = (sel m) y a2- h = (sel o) z a3-- _ = a1 :: Int; _ = a2 :: Int; _ = a3 :: Int- k g = loopArr (loopWrapper g xs)---- check wrapper elimination-prop_loop_loop_wrapper_elimination n m x y a1 a2 xs =- loopWrapper g (loopArr (loopWrapper f xs)) ==- loopSndAcc (loopWrapper (sequenceLoops f g) xs)- where- f = (sel n) x a1- g = (sel m) y a2- _ = a1 :: Int; _ = a2 :: Int--sel :: Bool- -> (acc -> Word8 -> PairS acc (MaybeS Word8))- -> acc- -> Ptr Word8- -> Ptr Word8- -> Int- -> IO (PairS (PairS acc Int) Int)-sel False = doDownLoop-sel True = doUpLoop-------------------------------------------------------------------------------- Test fusion forms-----prop_up_up_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doUpLoop f1 acc1) (doUpLoop f2 acc2)) ==- k (doUpLoop (f1 `fuseAccAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs--prop_down_down_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doDownLoop f1 acc1) (doDownLoop f2 acc2)) ==- k (doDownLoop (f1 `fuseAccAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int ; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_noAcc_noAcc_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doNoAccLoop f1 acc1) (doNoAccLoop f2 acc2)) ==- k (doNoAccLoop (f1 `fuseNoAccNoAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int ; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_noAcc_up_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doNoAccLoop f1 acc1) (doUpLoop f2 acc2)) ==- k (doUpLoop (f1 `fuseNoAccAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs--prop_up_noAcc_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doUpLoop f1 acc1) (doNoAccLoop f2 acc2)) ==- k (doUpLoop (f1 `fuseAccNoAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs--prop_noAcc_down_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doNoAccLoop f1 acc1) (doDownLoop f2 acc2)) ==- k (doDownLoop (f1 `fuseNoAccAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_down_noAcc_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doDownLoop f1 acc1) (doNoAccLoop f2 acc2)) ==- k (doDownLoop (f1 `fuseAccNoAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs--prop_map_map_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doMapLoop f1 acc1) (doMapLoop f2 acc2)) ==- k (doMapLoop (f1 `fuseMapMapEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_filter_filter_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doFilterLoop f1 acc1) (doFilterLoop f2 acc2)) ==- k (doFilterLoop (f1 `fuseFilterFilterEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_map_filter_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doMapLoop f1 acc1) (doFilterLoop f2 acc2)) ==- k (doNoAccLoop (f1 `fuseMapFilterEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_filter_map_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doFilterLoop f1 acc1) (doMapLoop f2 acc2)) ==- k (doNoAccLoop (f1 `fuseFilterMapEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_map_noAcc_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doMapLoop f1 acc1) (doNoAccLoop f2 acc2)) ==- k (doNoAccLoop (f1 `fuseMapNoAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_noAcc_map_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doNoAccLoop f1 acc1) (doMapLoop f2 acc2)) ==- k (doNoAccLoop (f1 `fuseNoAccMapEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_map_up_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doMapLoop f1 acc1) (doUpLoop f2 acc2)) ==- k (doUpLoop (f1 `fuseMapAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_up_map_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doUpLoop f1 acc1) (doMapLoop f2 acc2)) ==- k (doUpLoop (f1 `fuseAccMapEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_map_down_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doMapLoop f1 acc1) (doDownLoop f2 acc2)) ==- k (doDownLoop (f1 `fuseMapAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_down_map_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doDownLoop f1 acc1) (doMapLoop f2 acc2)) ==- k (doDownLoop (f1 `fuseAccMapEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_filter_noAcc_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doFilterLoop f1 acc1) (doNoAccLoop f2 acc2)) ==- k (doNoAccLoop (f1 `fuseFilterNoAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_noAcc_filter_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doNoAccLoop f1 acc1) (doFilterLoop f2 acc2)) ==- k (doNoAccLoop (f1 `fuseNoAccFilterEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_filter_up_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doFilterLoop f1 acc1) (doUpLoop f2 acc2)) ==- k (doUpLoop (f1 `fuseFilterAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_up_filter_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doUpLoop f1 acc1) (doFilterLoop f2 acc2)) ==- k (doUpLoop (f1 `fuseAccFilterEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_filter_down_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doFilterLoop f1 acc1) (doDownLoop f2 acc2)) ==- k (doDownLoop (f1 `fuseFilterAccEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs--prop_down_filter_loop_fusion f1 f2 acc1 acc2 xs =- k (sequenceLoops (doDownLoop f1 acc1) (doFilterLoop f2 acc2)) ==- k (doDownLoop (f1 `fuseAccFilterEFL` f2) (acc1 :*: acc2))- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs----------------------------------------------------------------------------{--prop_length_loop_fusion_1 f1 acc1 xs =- P.length (loopArr (loopWrapper (doUpLoop f1 acc1) xs)) ==- P.lengthU (loopArr (loopWrapper (doUpLoop f1 acc1) xs))- where _ = acc1 :: Int--prop_length_loop_fusion_2 f1 acc1 xs =- P.length (loopArr (loopWrapper (doDownLoop f1 acc1) xs)) ==- P.lengthU (loopArr (loopWrapper (doDownLoop f1 acc1) xs))- where _ = acc1 :: Int--prop_length_loop_fusion_3 f1 acc1 xs =- P.length (loopArr (loopWrapper (doMapLoop f1 acc1) xs)) ==- P.lengthU (loopArr (loopWrapper (doMapLoop f1 acc1) xs))- where _ = acc1 :: Int--prop_length_loop_fusion_4 f1 acc1 xs =- P.length (loopArr (loopWrapper (doFilterLoop f1 acc1) xs)) ==- P.lengthU (loopArr (loopWrapper (doFilterLoop f1 acc1) xs))- where _ = acc1 :: Int--}---}- -- prop_zipwith_spec f p q = -- P.pack (P.zipWith f p q) == P.zipWith' f p q -- where _ = f :: Word8 -> Word8 -> Word8@@ -2333,6 +2141,8 @@ , testProperty "elemIndexEnd 1" prop_elemIndexEnd1BB , testProperty "elemIndexEnd 1" prop_elemIndexEnd1CC , testProperty "elemIndexEnd 2" prop_elemIndexEnd2BB+ , testProperty "elemIndexEnd 1" prop_elemIndexEnd1LL+ , testProperty "elemIndexEnd 2" prop_elemIndexEnd2LL -- , testProperty "words'" prop_wordsBB' -- , testProperty "lines'" prop_linesBB' -- , testProperty "dropSpaceEnd" prop_dropSpaceEndBB@@ -2413,55 +2223,6 @@ -- , testProperty "span/spanByte" prop_span_spec -- , testProperty "break/breakByte"prop_break_spec ]----------------------------------------------------------------------------- Fusion rules--{--fusion_tests =--- v1 fusion- [ ("lazy loop/loop fusion" prop_lazylooploop- , ("loop/loop fusion" prop_looploop---- v2 fusion- , testProperty "loop/loop wrapper elim" prop_loop_loop_wrapper_elimination- , testProperty "sequence association" prop_sequenceloops_assoc-- , testProperty "up/up loop fusion" prop_up_up_loop_fusion- , testProperty "down/down loop fusion" prop_down_down_loop_fusion- , testProperty "noAcc/noAcc loop fusion" prop_noAcc_noAcc_loop_fusion- , testProperty "noAcc/up loop fusion" prop_noAcc_up_loop_fusion- , testProperty "up/noAcc loop fusion" prop_up_noAcc_loop_fusion- , testProperty "noAcc/down loop fusion" prop_noAcc_down_loop_fusion- , testProperty "down/noAcc loop fusion" prop_down_noAcc_loop_fusion- , testProperty "map/map loop fusion" prop_map_map_loop_fusion- , testProperty "filter/filter loop fusion" prop_filter_filter_loop_fusion- , testProperty "map/filter loop fusion" prop_map_filter_loop_fusion- , testProperty "filter/map loop fusion" prop_filter_map_loop_fusion- , testProperty "map/noAcc loop fusion" prop_map_noAcc_loop_fusion- , testProperty "noAcc/map loop fusion" prop_noAcc_map_loop_fusion- , testProperty "map/up loop fusion" prop_map_up_loop_fusion- , testProperty "up/map loop fusion" prop_up_map_loop_fusion- , testProperty "map/down loop fusion" prop_map_down_fusion- , testProperty "down/map loop fusion" prop_down_map_loop_fusion- , testProperty "filter/noAcc loop fusion" prop_filter_noAcc_loop_fusion- , testProperty "noAcc/filter loop fusion" prop_noAcc_filter_loop_fusion- , testProperty "filter/up loop fusion" prop_filter_up_loop_fusion- , testProperty "up/filter loop fusion" prop_up_filter_loop_fusion- , testProperty "filter/down loop fusion" prop_filter_down_fusion- , testProperty "down/filter loop fusion" prop_down_filter_loop_fusion--{-- , testProperty "length/loop fusion" prop_length_loop_fusion_1- , testProperty "length/loop fusion" prop_length_loop_fusion_2- , testProperty "length/loop fusion" prop_length_loop_fusion_3- , testProperty "length/loop fusion" prop_length_loop_fusion_4--}---- , testProperty "zipwith/spec" prop_zipwith_spec- ]---} ------------------------------------------------------------------------
tests/QuickCheckUtils.hs view
@@ -27,41 +27,6 @@ ------------------------------------------------------------------------ -adjustSize :: Testable prop => (Int -> Int) -> prop -> Property-adjustSize f p = sized $ \sz -> resize (f sz) (property p)----------------------------------------------------------------------------{----- HUGS needs: --instance Functor ((->) r) where- fmap = (.)--instance (Arbitrary a) => Arbitrary (Maybe a) where- arbitrary = sized arbMaybe- where- arbMaybe 0 = return Nothing- arbMaybe n = fmap Just (resize (n-1) arbitrary)- coarbitrary Nothing = variant 0- coarbitrary (Just x) = variant 1 . coarbitrary x--instance Monad ((->) r) where- return = const- f >>= k = \ r -> k (f r) r--instance Functor ((,) a) where- fmap f (x,y) = (x, f y)--instance Functor (Either a) where- fmap _ (Left x) = Left x- fmap f (Right y) = Right (f y)---}--------------------------------------------------------------------------- integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g) integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer, fromIntegral b :: Integer) g of