[commit: bytestring] master: Remove references to array fusion from the haddock docs (6f2b3a7)
Ian Lynagh
igloo at earth.li
Fri Jan 11 16:35:12 CET 2013
Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6f2b3a7e6717fc347ccc17df0792833d724114f3
>---------------------------------------------------------------
commit 6f2b3a7e6717fc347ccc17df0792833d724114f3
Author: Duncan Coutts <duncan at community.haskell.org>
Date: Tue Jan 8 17:23:23 2013 +0000
Remove references to array fusion from the haddock docs
We are not doing fusion and have not done so for ages and ages.
>---------------------------------------------------------------
Data/ByteString.hs | 7 ++-----
Data/ByteString/Lazy.hs | 1 -
2 files changed, 2 insertions(+), 6 deletions(-)
diff --git a/Data/ByteString.hs b/Data/ByteString.hs
index f889170..a166bbb 100644
--- a/Data/ByteString.hs
+++ b/Data/ByteString.hs
@@ -476,7 +476,7 @@ append = mappend
-- Transformations
-- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each
--- element of @xs at . This function is subject to array fusion.
+-- element of @xs at .
map :: (Word8 -> Word8) -> ByteString -> ByteString
map f (PS fp s len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a ->
create len $ map_ 0 (a `plusPtr` s)
@@ -518,8 +518,6 @@ transpose ps = P.map pack (List.transpose (P.map unpack ps))
-- the left-identity of the operator), and a ByteString, reduces the
-- ByteString using the binary operator, from left to right.
--
--- This function is subject to array fusion.
>---------------------------------------------------------------
foldl :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl f z (PS fp off len) =
let p = unsafeForeignPtrToPtr fp
@@ -578,7 +576,6 @@ foldr' k v (PS fp off len) =
-- | '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.
-- An exception will be thrown in the case of an empty ByteString.
foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1 f ps
@@ -1275,7 +1272,7 @@ notElem c ps = not (elem c ps)
-- | /O(n)/ 'filter', applied to a predicate and a ByteString,
-- returns a ByteString containing those characters that satisfy the
--- predicate. This function is subject to array fusion.
+-- predicate.
filter :: (Word8 -> Bool) -> ByteString -> ByteString
filter k ps@(PS x s l)
| null ps = ps
diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs
index 7755cb3..56ee7a0 100644
--- a/Data/ByteString/Lazy.hs
+++ b/Data/ByteString/Lazy.hs
@@ -491,7 +491,6 @@ foldr k z cs = foldrChunks (flip (S.foldr k)) z cs
-- | '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.
foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1 _ Empty = errorEmptyList "foldl1"
foldl1 f (Chunk c cs) = foldl f (S.unsafeHead c) (Chunk (S.unsafeTail c) cs)
More information about the ghc-commits
mailing list