Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring On branch : master
http://hackage.haskell.org/trac/ghc/changeset/5844eabca00824c897475ba469cea13ce4c3da93 >--------------------------------------------------------------- commit 5844eabca00824c897475ba469cea13ce4c3da93 Author: Duncan Coutts <[email protected]> Date: Sat Nov 5 15:16:35 2011 +0000 Specify sensible fixities for cons and snoc As suggested by Yitzchak Gale. >--------------------------------------------------------------- Data/ByteString.hs | 3 +++ Data/ByteString/Char8.hs | 3 +++ Data/ByteString/Lazy.hs | 3 +++ Data/ByteString/Lazy/Char8.hs | 3 +++ 4 files changed, 12 insertions(+), 0 deletions(-) diff --git a/Data/ByteString.hs b/Data/ByteString.hs index 6a17aa1..9d28d3e 100644 --- a/Data/ByteString.hs +++ b/Data/ByteString.hs @@ -505,6 +505,9 @@ length (PS _ _ l) = assert (l >= 0) $ l ------------------------------------------------------------------------ +infixr 5 `cons` --same as list (:) +infixl 5 `snoc` + -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different -- complexity, as it requires a memcpy. cons :: Word8 -> ByteString -> ByteString diff --git a/Data/ByteString/Char8.hs b/Data/ByteString/Char8.hs index a9ccf0c..4b255ec 100644 --- a/Data/ByteString/Char8.hs +++ b/Data/ByteString/Char8.hs @@ -331,6 +331,9 @@ unpack :: ByteString -> [Char] unpack = P.map w2c . B.unpack {-# INLINE unpack #-} +infixr 5 `cons` --same as list (:) +infixl 5 `snoc` + -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different -- complexity, as it requires a memcpy. cons :: Char -> ByteString -> ByteString diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs index f2b437c..7c3b9a5 100644 --- a/Data/ByteString/Lazy.hs +++ b/Data/ByteString/Lazy.hs @@ -346,6 +346,9 @@ length :: ByteString -> Int64 length cs = foldlChunks (\n c -> n + fromIntegral (S.length c)) 0 cs {-# INLINE length #-} +infixr 5 `cons`, `cons'` --same as list (:) +infixl 5 `snoc` + -- | /O(1)/ 'cons' is analogous to '(:)' for lists. -- cons :: Word8 -> ByteString -> ByteString diff --git a/Data/ByteString/Lazy/Char8.hs b/Data/ByteString/Lazy/Char8.hs index f2e869a..d1828f2 100644 --- a/Data/ByteString/Lazy/Char8.hs +++ b/Data/ByteString/Lazy/Char8.hs @@ -249,6 +249,9 @@ unpack :: ByteString -> [Char] unpack = List.map w2c . L.unpack {-# INLINE unpack #-} +infixr 5 `cons`, `cons'` --same as list (:) +infixl 5 `snoc` + -- | /O(1)/ 'cons' is analogous to '(:)' for lists. cons :: Char -> ByteString -> ByteString cons = L.cons . c2w _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
