Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring On branch : master
http://hackage.haskell.org/trac/ghc/changeset/fe6af04b69ccd3fb34311077701d0e198b0c1f89 >--------------------------------------------------------------- commit fe6af04b69ccd3fb34311077701d0e198b0c1f89 Author: Duncan Coutts <[email protected]> Date: Sun Nov 6 18:28:00 2011 +0000 Use the new {un,}pack{Bytes,Chars} functions and simplify We had a whole variety of odd pack/unpack functions. The nice thing is that with modern ghc we can use simpler implementations and get as good or better code than the old ones. >--------------------------------------------------------------- Data/ByteString.hs | 49 ++++------------------------------------ Data/ByteString/Char8.hs | 35 +++-------------------------- Data/ByteString/Lazy.hs | 10 +------ Data/ByteString/Lazy/Char8.hs | 5 +-- 4 files changed, 13 insertions(+), 86 deletions(-) diff --git a/Data/ByteString.hs b/Data/ByteString.hs index ba7eef4..f40832b 100644 --- a/Data/ByteString.hs +++ b/Data/ByteString.hs @@ -270,7 +270,7 @@ import GHC.IO.Handle.Internals import GHC.IO.Handle.Types import GHC.IO.Buffer import GHC.IO.BufferedIO as Buffered -import GHC.IO (stToIO, unsafePerformIO) +import GHC.IO (unsafePerformIO) import Data.Char (ord) import Foreign.Marshal.Utils (copyBytes) #else @@ -279,11 +279,9 @@ import GHC.IOBase import GHC.Handle #endif -import GHC.Prim (Word#, (+#), writeWord8OffAddr#) +import GHC.Prim (Word#) import GHC.Base (build) import GHC.Word hiding (Word8) -import GHC.Ptr (Ptr(..)) -import GHC.ST (ST(..)) #endif @@ -412,40 +410,12 @@ singleton c = unsafeCreate 1 $ \p -> poke p c -- For applications with large numbers of string literals, pack can be a -- bottleneck. In such cases, consider using packAddress (GHC only). pack :: [Word8] -> ByteString - -#if !defined(__GLASGOW_HASKELL__) - -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 = 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 - - writeByte p i c = ST $ \s# -> - case writeWord8OffAddr# p i c s# of s2# -> (# s2#, () #) - -#endif +pack = packBytes -- | /O(n)/ Converts a 'ByteString' to a '[Word8]'. unpack :: ByteString -> [Word8] - #if !defined(__GLASGOW_HASKELL__) - -unpack (PS _ _ 0) = [] -unpack (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 (e : acc) - go p n acc = peekByteOff p n >>= \e -> go p (n-1) (e : acc) -{-# INLINE unpack #-} - +unpack = unpackBytes #else unpack ps = build (unpackFoldr ps) @@ -469,18 +439,9 @@ unpackFoldr (PS fp off len) f ch = withPtr fp $ \p -> do 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 _ (-1) acc = return acc - loop q n acc = do - a <- peekByteOff q n - loop q (n-1) (a : acc) - loop (p `plusPtr` off) (len-1) [] - {-# RULES "ByteString unpack-list" [1] forall p . - unpackFoldr p (:) [] = unpackList p + unpackFoldr p (:) [] = unpackBytes p #-} #endif diff --git a/Data/ByteString/Char8.hs b/Data/ByteString/Char8.hs index 556cd73..95270db 100644 --- a/Data/ByteString/Char8.hs +++ b/Data/ByteString/Char8.hs @@ -247,8 +247,7 @@ import Data.ByteString (empty,null,length,tail,init,append ,useAsCString,useAsCStringLen ) -import Data.ByteString.Internal (ByteString(PS), c2w, w2c, isSpaceWord8 - ,inlinePerformIO) +import Data.ByteString.Internal import Data.Char ( isSpace ) import qualified Data.List as List (intersperse) @@ -261,18 +260,6 @@ import IO (bracket) #endif import Foreign -#if defined(__GLASGOW_HASKELL__) -import GHC.Base (Char(..),unpackCString#,ord#,int2Word#) -#if __GLASGOW_HASKELL__ >= 611 -import GHC.IO (stToIO) -#else -import GHC.IOBase (stToIO) -#endif -import GHC.Prim (Addr#,writeWord8OffAddr#,plusAddr#) -import GHC.Ptr (Ptr(..)) -import GHC.ST (ST(..)) -#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 @@ -290,23 +277,9 @@ singleton = B.singleton . c2w -- For applications with large numbers of string literals, pack can be a -- bottleneck. pack :: String -> ByteString -#if !defined(__GLASGOW_HASKELL__) - -pack str = B.unsafeCreate (P.length str) $ \p -> go p str - where go _ [] = return () - go p (x:xs) = poke p (c2w x) >> go (p `plusPtr` 1) xs - -#else /* hack away */ +pack = packChars -pack str = B.unsafeCreate (P.length str) $ \(Ptr p) -> stToIO (go p str) - where - go :: Addr# -> [Char] -> ST a () - go _ [] = return () - go p (C# c:cs) = writeByte p (int2Word# (ord# c)) >> go (p `plusAddr#` 1#) cs - - writeByte p c = ST $ \s# -> - case writeWord8OffAddr# p 0# c s# of s2# -> (# s2#, () #) - {-# INLINE writeByte #-} +#if !defined(__GLASGOW_HASKELL__) {-# INLINE [1] pack #-} {-# RULES @@ -318,7 +291,7 @@ pack str = B.unsafeCreate (P.length str) $ \(Ptr p) -> stToIO (go p str) -- | /O(n)/ Converts a 'ByteString' to a 'String'. unpack :: ByteString -> [Char] -unpack = P.map w2c . B.unpack +unpack = B.unpackChars {-# INLINE unpack #-} infixr 5 `cons` --same as list (:) diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs index 4aa91f2..cd21cc7 100644 --- a/Data/ByteString/Lazy.hs +++ b/Data/ByteString/Lazy.hs @@ -295,17 +295,11 @@ singleton w = Chunk (S.singleton w) Empty -- | /O(n)/ Convert a '[Word8]' into a 'ByteString'. pack :: [Word8] -> ByteString -pack ws = L.foldr (Chunk . S.pack) Empty (chunks defaultChunkSize ws) - where - chunks :: Int -> [a] -> [[a]] - chunks _ [] = [] - chunks size xs = case L.splitAt size xs of - (xs', xs'') -> xs' : chunks size xs'' +pack = packBytes -- | /O(n)/ Converts a 'ByteString' to a '[Word8]'. unpack :: ByteString -> [Word8] -unpack cs = L.concatMap S.unpack (toChunks cs) ---TODO: we can do better here by integrating the concat with the unpack +unpack = unpackBytes -- | /O(c)/ Convert a list of strict 'ByteString' into a lazy 'ByteString' fromChunks :: [P.ByteString] -> ByteString diff --git a/Data/ByteString/Lazy/Char8.hs b/Data/ByteString/Lazy/Char8.hs index 47337a4..51d9b47 100644 --- a/Data/ByteString/Lazy/Char8.hs +++ b/Data/ByteString/Lazy/Char8.hs @@ -232,12 +232,11 @@ singleton = L.singleton . c2w -- | /O(n)/ Convert a 'String' into a 'ByteString'. pack :: [Char] -> ByteString -pack = L.pack. List.map c2w +pack = packChars -- | /O(n)/ Converts a 'ByteString' to a 'String'. unpack :: ByteString -> [Char] -unpack = List.map w2c . L.unpack -{-# INLINE unpack #-} +unpack = unpackChars infixr 5 `cons`, `cons'` --same as list (:) infixl 5 `snoc` _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
