Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring On branch : master
http://hackage.haskell.org/trac/ghc/changeset/dabb1a2fbd2e9c8e79d14ae280bc0d681582afbd >--------------------------------------------------------------- commit dabb1a2fbd2e9c8e79d14ae280bc0d681582afbd Author: Duncan Coutts <[email protected]> Date: Mon Nov 7 12:43:52 2011 +0000 Add conversion functions between lazy and (single) strict ByteStrings API proposal and initial patch by Herbert Valerio Riedel <[email protected]> http://article.gmane.org/gmane.comp.lang.haskell.libraries/16444 More or less unanimous support. Don points out that he and I deliberately did not include these functions originally in an attempt to discourage people from converting back and forth since it is expensive to do so. Clearly people want these functions anyway. So instead I've added the following documentation to toStrict: Note that this is an /expensive/ operation that forces the whole lazy 'ByteString' into memory and then copies all the data. If possible, try to avoid converting back and forth between strict and lazy bytestrings. >--------------------------------------------------------------- Data/ByteString/Lazy.hs | 26 ++++++++++++++++++++++++++ Data/ByteString/Lazy/Char8.hs | 4 +++- 2 files changed, 29 insertions(+), 1 deletions(-) diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs index 30fc5b9..9adc1fb 100644 --- a/Data/ByteString/Lazy.hs +++ b/Data/ByteString/Lazy.hs @@ -56,6 +56,8 @@ module Data.ByteString.Lazy ( singleton, -- :: Word8 -> ByteString pack, -- :: [Word8] -> ByteString unpack, -- :: ByteString -> [Word8] + fromStrict, -- :: Strict.ByteString -> ByteString + toStrict, -- :: ByteString -> Strict.ByteString fromChunks, -- :: [Strict.ByteString] -> ByteString toChunks, -- :: ByteString -> [Strict.ByteString] @@ -271,6 +273,30 @@ fromChunks cs = L.foldr chunk Empty cs toChunks :: ByteString -> [P.ByteString] toChunks cs = foldrChunks (:) [] cs +-- |/O(1)/ Convert a strict 'ByteString' into a lazy 'ByteString'. +fromStrict :: P.ByteString -> ByteString +fromStrict bs | S.null bs = Empty + | otherwise = Chunk bs Empty + +-- |/O(n)/ Convert a lazy 'ByteString' into a strict 'ByteString'. +-- +-- Note that this is an /expensive/ operation that forces the whole lazy +-- ByteString into memory and then copies all the data. If possible, try to +-- avoid converting back and forth between strict and lazy bytestrings. +-- +toStrict :: ByteString -> S.ByteString +toStrict Empty = S.empty +toStrict (Chunk c Empty) = c +toStrict cs0 = S.unsafeCreate totalLen $ \ptr -> go cs0 ptr + where + totalLen = foldlChunks (\a c -> a + S.length c) 0 cs0 + + go Empty !_ = return () + go (Chunk (S.PS fp off len) cs) !destptr = + withForeignPtr fp $ \p -> do + S.memcpy destptr (p `plusPtr` off) len + go cs (destptr `plusPtr` len) + ------------------------------------------------------------------------ {- diff --git a/Data/ByteString/Lazy/Char8.hs b/Data/ByteString/Lazy/Char8.hs index 6720649..626a5fe 100644 --- a/Data/ByteString/Lazy/Char8.hs +++ b/Data/ByteString/Lazy/Char8.hs @@ -42,6 +42,8 @@ module Data.ByteString.Lazy.Char8 ( unpack, -- :: ByteString -> String fromChunks, -- :: [Strict.ByteString] -> ByteString toChunks, -- :: ByteString -> [Strict.ByteString] + fromStrict, -- :: Strict.ByteString -> ByteString + toStrict, -- :: ByteString -> Strict.ByteString -- * Basic interface cons, -- :: Char -> ByteString -> ByteString @@ -189,7 +191,7 @@ module Data.ByteString.Lazy.Char8 ( -- Functions transparently exported import Data.ByteString.Lazy - (fromChunks, toChunks + (fromChunks, toChunks, fromStrict, toStrict ,empty,null,length,tail,init,append,reverse,transpose,cycle ,concat,take,drop,splitAt,intercalate,isPrefixOf,group,inits,tails,copy ,hGetContents, hGet, hPut, getContents _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
