packages feed

bytestring 0.9.2.1 → 0.10.0.0

raw patch · 28 files changed

+8373/−2778 lines, 28 filesdep +QuickCheckdep +byteorderdep +criteriondep ~base

Dependencies added: QuickCheck, byteorder, criterion, deepseq, directory, dlist, mtl

Dependency ranges changed: base

Files

Data/ByteString.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-}--- We cannot actually specify all the language pragmas, see ghc ticket #--- If we could, these are what they would be:-{- LANGUAGE MagicHash, UnboxedTuples,-            NamedFieldPuns, BangPatterns, RecordWildCards -}+#if __GLASGOW_HASKELL__+{-# LANGUAGE MagicHash, UnboxedTuples,+            NamedFieldPuns, BangPatterns, RecordWildCards #-}+#endif {-# OPTIONS_HADDOCK prune #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-}@@ -12,18 +12,14 @@ -- Module      : Data.ByteString -- Copyright   : (c) The University of Glasgow 2001, --               (c) David Roundy 2003-2005,---               (c) Simon Marlow 2005---               (c) Bjorn Bringert 2006---               (c) Don Stewart 2005-2008------               Array fusion code:---               (c) 2001,2002 Manuel M T Chakravarty & Gabriele Keller---               (c) 2006      Manuel M T Chakravarty & Roman Leshchinskiy---+--               (c) Simon Marlow 2005,+--               (c) Bjorn Bringert 2006,+--               (c) Don Stewart 2005-2008,+--               (c) Duncan Coutts 2006-2011 -- License     : BSD-style ----- Maintainer  : dons@cse.unsw.edu.au--- Stability   : experimental+-- Maintainer  : dons00@gmail.com, duncan@community.haskell.org+-- Stability   : stable -- Portability : portable --  -- A time and space-efficient implementation of byte vectors using@@ -40,7 +36,7 @@ -- Original GHC implementation by Bryan O\'Sullivan. -- Rewritten to use 'Data.Array.Unboxed.UArray' by Simon Marlow. -- Rewritten to support slices and use 'ForeignPtr' by David Roundy.--- Polished and extended by Don Stewart.+-- Rewritten again and extended by Don Stewart and Duncan Coutts. --  module Data.ByteString (@@ -229,7 +225,7 @@  -- Control.Exception.assert not available in yhc or nhc #ifndef __NHC__-import Control.Exception        (finally, bracket, assert)+import Control.Exception        (finally, bracket, assert, throwIO) #else import Control.Exception	(bracket, finally) #endif@@ -249,7 +245,7 @@                                 ,IOMode(..)) import System.IO.Error          (mkIOError, illegalOperationErrorType) -import Data.Monoid              (Monoid, mempty, mappend, mconcat)+import Data.Monoid              (Monoid(..))  #if !defined(__GLASGOW_HASKELL__) import System.IO.Unsafe@@ -274,7 +270,7 @@ 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@@ -283,11 +279,9 @@ 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 @@ -318,67 +312,6 @@ #define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined  -- -------------------------------------------------------------------------------instance Eq  ByteString where-    (==)    = eq--instance Ord ByteString where-    compare = compareBytes--instance Monoid ByteString where-    mempty  = empty-    mappend = append-    mconcat = concat---- | /O(n)/ Equality on the 'ByteString' type.-eq :: ByteString -> ByteString -> Bool-eq a@(PS p s l) b@(PS p' s' l')-    | l /= l'            = False    -- short cut on length-    | p == p' && s == s' = True     -- short cut for the same string-    | otherwise          = compareBytes a b == EQ-{-# INLINE eq #-}--- ^ still needed---- | /O(n)/ 'compareBytes' provides an 'Ordering' for 'ByteStrings' supporting slices. -compareBytes :: ByteString -> ByteString -> Ordering-compareBytes (PS x1 s1 l1) (PS x2 s2 l2)-    | l1 == 0  && l2 == 0               = EQ  -- short cut for empty strings-    | otherwise                         = inlinePerformIO $-        withForeignPtr x1 $ \p1 ->-        withForeignPtr x2 $ \p2 -> do-            i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral $ min l1 l2)-            return $! case i `compare` 0 of-                        EQ  -> l1 `compare` l2-                        x   -> x--{----- Pure Haskell version--compareBytes (PS fp1 off1 len1) (PS fp2 off2 len2)---    | len1 == 0  && len2 == 0                     = EQ  -- short cut for empty strings---    | fp1 == fp2 && off1 == off2 && len1 == len2  = EQ  -- short cut for the same string-    | otherwise                                   = inlinePerformIO $-    withForeignPtr fp1 $ \p1 ->-        withForeignPtr fp2 $ \p2 ->-            cmp (p1 `plusPtr` off1)-                (p2 `plusPtr` off2) 0 len1 len2---- XXX todo.-cmp :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> Int-> IO Ordering-cmp p1 p2 n len1 len2-      | n == len1 = if n == len2 then return EQ else return LT-      | n == len2 = return GT-      | otherwise = do-          a <- peekByteOff p1 n :: IO Word8-          b <- peekByteOff p2 n-          case a `compare` b of-                EQ -> cmp p1 p2 (n+1) len1 len2-                LT -> return LT-                GT -> return GT--}---- ----------------------------------------------------------------------------- -- Introducing and eliminating 'ByteString's  -- | /O(1)/ The empty 'ByteString'@@ -416,40 +349,12 @@ -- 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)@@ -473,18 +378,9 @@     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@@ -505,6 +401,9 @@  ------------------------------------------------------------------------ +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@@ -566,9 +465,7 @@  -- | /O(n)/ Append two ByteStrings append :: ByteString -> ByteString -> ByteString-append xs ys | null xs   = ys-             | null ys   = xs-             | otherwise = concat [xs,ys]+append = mappend {-# INLINE append #-}  -- ---------------------------------------------------------------------@@ -700,15 +597,7 @@  -- | /O(n)/ Concatenate a list of ByteStrings. concat :: [ByteString] -> ByteString-concat []     = empty-concat [ps]   = ps-concat xs     = unsafeCreate len $ \ptr -> go xs ptr-  where len = P.sum . P.map length $ xs-        STRICT2(go)-        go []            _   = return ()-        go (PS p s l:ps) ptr = do-                withForeignPtr p $ \fp -> memcpy ptr (fp `plusPtr` s) (fromIntegral l)-                go ps (ptr `plusPtr` l)+concat = mconcat  -- | Map a function over a 'ByteString' and concatenate the results concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString@@ -1735,7 +1624,7 @@ packCStringLen (cstr, len) | len >= 0 = create len $ \p ->     memcpy p (castPtr cstr) (fromIntegral len) packCStringLen (_, len) =-    moduleError "packCStringLen" ("negative length: " ++ show len)+    moduleErrorIO "packCStringLen" ("negative length: " ++ show len)  ------------------------------------------------------------------------ @@ -2112,8 +2001,20 @@ {-# NOINLINE errorEmptyList #-}  moduleError :: String -> String -> a-moduleError fun msg = error ("Data.ByteString." ++ fun ++ ':':' ':msg)+moduleError fun msg = error (moduleErrorMsg fun msg) {-# NOINLINE moduleError #-}++moduleErrorIO :: String -> String -> IO a+moduleErrorIO fun msg =+#if MIN_VERSION_base(4,0,0)+    throwIO . userError $ moduleErrorMsg fun msg+#else+    throwIO . IOException . userError $ moduleErrorMsg fun msg+#endif+{-# NOINLINE moduleErrorIO #-}++moduleErrorMsg :: String -> String -> String+moduleErrorMsg fun msg = "Data.ByteString." ++ fun ++ ':':' ':msg  -- Find from the end of the string using predicate findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int
Data/ByteString/Char8.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-}--- We cannot actually specify all the language pragmas, see ghc ticket #--- If we could, these are what they would be:-{- LANGUAGE MagicHash, UnboxedTuples -}+#if __GLASGOW_HASKELL__+{-# LANGUAGE MagicHash, UnboxedTuples #-}+#endif {-# OPTIONS_HADDOCK prune #-} #if __GLASGOW_HASKELL__ >= 701 {-# LANGUAGE Trustworthy #-}@@ -10,10 +10,11 @@ -- | -- Module      : Data.ByteString.Char8 -- Copyright   : (c) Don Stewart 2006-2008+--               (c) Duncan Coutts 2006-2011 -- License     : BSD-style ----- Maintainer  : dons@cse.unsw.edu.au--- Stability   : experimental+-- Maintainer  : dons00@gmail.com, duncan@community.haskell.org+-- Stability   : stable -- Portability : portable -- -- Manipulate 'ByteString's using 'Char' operations. All Chars will be@@ -35,12 +36,12 @@ -- This module is intended to be imported @qualified@, to avoid name -- clashes with "Prelude" functions.  eg. ----- > import qualified Data.ByteString.Char8 as B+-- > import qualified Data.ByteString.Char8 as C -- -- The Char8 interface to bytestrings provides an instance of IsString -- for the ByteString type, enabling you to use string literals, and--- have them implicitly packed to ByteStrings. Use -XOverloadedStrings--- to enable this.+-- have them implicitly packed to ByteStrings.+-- Use @{-\# LANGUAGE OverloadedStrings \#-}@ to enable this. --  module Data.ByteString.Char8 (@@ -247,8 +248,7 @@                        ,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,22 +261,6 @@ #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--#if MIN_VERSION_base(3,0,0)-import Data.String              (IsString(..))-#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@@ -289,34 +273,14 @@ singleton = B.singleton . c2w {-# INLINE singleton #-} -#if MIN_VERSION_base(3,0,0)-instance IsString ByteString where-    fromString = pack-    {-# INLINE fromString #-}-#endif- -- | /O(n)/ Convert a 'String' into a 'ByteString' -- -- 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 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+pack = packChars -    writeByte p c = ST $ \s# ->-        case writeWord8OffAddr# p 0# c s# of s2# -> (# s2#, () #)-    {-# INLINE writeByte #-}+#if !defined(__GLASGOW_HASKELL__) {-# INLINE [1] pack #-}  {-# RULES@@ -328,8 +292,11 @@  -- | /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 (:)+infixl 5 `snoc`  -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different -- complexity, as it requires a memcpy.
− Data/ByteString/Fusion.hs 
@@ -1,24 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}-#if __GLASGOW_HASKELL__ >= 701-{-# LANGUAGE Safe #-}-#endif--- |--- Module      : Data.ByteString.Fusion--- License     : BSD-style--- Maintainer  : dons@cse.unsw.edu.au--- Stability   : experimental--- Portability : portable------ Stream fusion for ByteStrings.------ See the paper /Stream Fusion: From Lists to Streams to Nothing at All/,--- Coutts, Leshchinskiy and Stewart, 2007.  -----module Data.ByteString.Fusion (--    -- A place holder for Stream Fusion--  ) where--
Data/ByteString/Internal.hs view
@@ -1,16 +1,18 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}--- We cannot actually specify all the language pragmas, see ghc ticket #--- If we could, these are what they would be:-{- LANGUAGE UnliftedFFITypes, MagicHash,-            UnboxedTuples, DeriveDataTypeable -}+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-}+#if __GLASGOW_HASKELL__+{-# LANGUAGE UnliftedFFITypes, MagicHash,+            UnboxedTuples, DeriveDataTypeable #-}+#endif {-# OPTIONS_HADDOCK hide #-}  -- | -- Module      : Data.ByteString.Internal+-- Copyright   : (c) Don Stewart 2006-2008+--               (c) Duncan Coutts 2006-2011 -- License     : BSD-style--- Maintainer  : Don Stewart <dons@galois.com>--- Stability   : experimental--- Portability : portable+-- Maintainer  : dons00@gmail.com, duncan@community.haskell.org+-- Stability   : unstable+-- Portability : non-portable -- -- A module containing semi-public 'ByteString' internals. This exposes the -- 'ByteString' representation and low level construction functions. As such@@ -25,7 +27,13 @@         -- * The @ByteString@ type and representation         ByteString(..),         -- instances: Eq, Ord, Show, Read, Data, Typeable -        -- * Low level introduction and elimination+        -- * Conversion with lists: packing and unpacking+        packBytes, packUptoLenBytes, unsafePackLenBytes,+        packChars, packUptoLenChars, unsafePackLenChars,+        unpackBytes, unpackAppendBytesLazy, unpackAppendBytesStrict,+        unpackChars, unpackAppendCharsLazy, unpackAppendCharsStrict,++        -- * Low level imperative construction         create,                 -- :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString         createAndTrim,          -- :: Int -> (Ptr Word8 -> IO Int) -> IO  ByteString         createAndTrim',         -- :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)@@ -45,8 +53,8 @@         c_free_finalizer,       -- :: FunPtr (Ptr Word8 -> IO ())          memchr,                 -- :: Ptr Word8 -> Word8 -> CSize -> IO Ptr Word8-        memcmp,                 -- :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt-        memcpy,                 -- :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()+        memcmp,                 -- :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt+        memcpy,                 -- :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()         memset,                 -- :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)          -- * cbits functions@@ -65,12 +73,26 @@    ) where +import Prelude hiding (concat)+import qualified Data.List as List+ import Foreign.ForeignPtr       (ForeignPtr, withForeignPtr) import Foreign.Ptr              (Ptr, FunPtr, plusPtr) import Foreign.Storable         (Storable(..))+#if MIN_VERSION_base(4,5,0) || __GLASGOW_HASKELL__ >= 703 import Foreign.C.Types          (CInt(..), CSize(..), CULong(..))+#else+import Foreign.C.Types          (CInt, CSize, CULong)+#endif import Foreign.C.String         (CString) +import Data.Monoid              (Monoid(..))+import Control.DeepSeq          (NFData)++#if MIN_VERSION_base(3,0,0)+import Data.String              (IsString(..))+#endif+ #ifndef __NHC__ import Control.Exception        (assert) #endif@@ -78,13 +100,19 @@ import Data.Char                (ord) import Data.Word                (Word8) -#if defined(__GLASGOW_HASKELL__) import Data.Typeable            (Typeable)-#if __GLASGOW_HASKELL__ >= 610-import Data.Data                (Data)+#if MIN_VERSION_base(4,1,0)+import Data.Data                (Data(..))+#if MIN_VERSION_base(4,2,0)+import Data.Data                (mkNoRepType) #else-import Data.Generics            (Data)+import Data.Data                (mkNorepType) #endif+#else+import Data.Generics            (Data(..), mkNorepType)+#endif++#ifdef __GLASGOW_HASKELL__ import GHC.Base                 (realWorld#,unsafeChr) #if __GLASGOW_HASKELL__ >= 611 import GHC.IO                   (IO(IO))@@ -154,42 +182,148 @@                      {-# UNPACK #-} !Int                -- length  #if defined(__GLASGOW_HASKELL__)-    deriving (Data, Typeable)+    deriving (Typeable) #endif +instance Eq  ByteString where+    (==)    = eq++instance Ord ByteString where+    compare = compareBytes++instance Monoid ByteString where+    mempty  = PS nullForeignPtr 0 0+    mappend = append+    mconcat = concat++instance NFData ByteString+ instance Show ByteString where-    showsPrec p ps r = showsPrec p (unpackWith w2c ps) r+    showsPrec p ps r = showsPrec p (unpackChars ps) r  instance Read ByteString where-    readsPrec p str = [ (packWith c2w x, y) | (x, y) <- readsPrec p str ]+    readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ] --- | /O(n)/ Converts a 'ByteString' to a '[a]', using a conversion function.-unpackWith :: (Word8 -> a) -> ByteString -> [a]-unpackWith _ (PS _  _ 0) = []-unpackWith k (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 (k e : acc)-        go p n acc = peekByteOff p n >>= \e -> go p (n-1) (k e : acc)-{-# INLINE unpackWith #-}+#if MIN_VERSION_base(3,0,0)+instance IsString ByteString where+    fromString = packChars+#endif --- | /O(n)/ Convert a '[a]' into a 'ByteString' using some--- conversion function-packWith :: (a -> Word8) -> [a] -> ByteString-packWith k str = unsafeCreate (length str) $ \p -> go p str-    where-        STRICT2(go)-        go _ []     = return ()-        go p (x:xs) = poke p (k x) >> go (p `plusPtr` 1) xs -- less space than pokeElemOff-{-# INLINE packWith #-}+instance Data ByteString where+  gfoldl f z txt = z packBytes `f` (unpackBytes txt)+  toConstr _     = error "Data.ByteString.ByteString.toConstr"+  gunfold _ _    = error "Data.ByteString.ByteString.gunfold"+#if MIN_VERSION_base(4,2,0)+  dataTypeOf _   = mkNoRepType "Data.ByteString.ByteString"+#else+  dataTypeOf _   = mkNorepType "Data.ByteString.ByteString"+#endif  ------------------------------------------------------------------------+-- Packing and unpacking from lists +packBytes :: [Word8] -> ByteString+packBytes ws = unsafePackLenBytes (List.length ws) ws++packChars :: [Char] -> ByteString+packChars cs = unsafePackLenChars (List.length cs) cs++unsafePackLenBytes :: Int -> [Word8] -> ByteString+unsafePackLenBytes len xs0 =+    unsafeCreate len $ \p -> go p xs0+  where+    go !_ []     = return ()+    go !p (x:xs) = poke p x >> go (p `plusPtr` 1) xs++unsafePackLenChars :: Int -> [Char] -> ByteString+unsafePackLenChars len cs0 =+    unsafeCreate len $ \p -> go p cs0+  where+    go !_ []     = return ()+    go !p (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) cs++packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])+packUptoLenBytes len xs0 =+    unsafeDupablePerformIO $ create' len $ \p -> go p len xs0+  where+    go !_ !n []     = return (len-n, [])+    go !_ !0 xs     = return (len,   xs)+    go !p !n (x:xs) = poke p x >> go (p `plusPtr` 1) (n-1) xs++packUptoLenChars :: Int -> [Char] -> (ByteString, [Char])+packUptoLenChars len cs0 =+    unsafeDupablePerformIO $ create' len $ \p -> go p len cs0+  where+    go !_ !n []     = return (len-n, [])+    go !_ !0 cs     = return (len,   cs)+    go !p !n (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) (n-1) cs++-- Unpacking bytestrings into lists effeciently is a tradeoff: on the one hand+-- we would like to write a tight loop that just blats the list into memory, on+-- the other hand we want it to be unpacked lazily so we don't end up with a+-- massive list data structure in memory.+--+-- Our strategy is to combine both: we will unpack lazily in reasonable sized+-- chunks, where each chunk is unpacked strictly.+--+-- unpackBytes and unpackChars do the lazy loop, while unpackAppendBytes and+-- unpackAppendChars do the chunks strictly.++unpackBytes :: ByteString -> [Word8]+unpackBytes bs = unpackAppendBytesLazy bs []++unpackChars :: ByteString -> [Char]+unpackChars bs = unpackAppendCharsLazy bs []++unpackAppendBytesLazy :: ByteString -> [Word8] -> [Word8]+unpackAppendBytesLazy (PS fp off len) xs+  | len <= 100 = unpackAppendBytesStrict (PS fp off len) xs+  | otherwise  = unpackAppendBytesStrict (PS fp off 100) remainder+  where+    remainder  = unpackAppendBytesLazy (PS fp (off+100) (len-100)) xs++  -- Why 100 bytes you ask? Because on a 64bit machine the list we allocate+  -- takes just shy of 4k which seems like a reasonable amount.+  -- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes)++unpackAppendCharsLazy :: ByteString -> [Char] -> [Char]+unpackAppendCharsLazy (PS fp off len) cs+  | len <= 100 = unpackAppendCharsStrict (PS fp off len) cs+  | otherwise  = unpackAppendCharsStrict (PS fp off 100) remainder+  where+    remainder  = unpackAppendCharsLazy (PS fp (off+100) (len-100)) cs++-- For these unpack functions, since we're unpacking the whole list strictly we+-- build up the result list in an accumulator. This means we have to build up+-- the list starting at the end. So our traversal starts at the end of the+-- buffer and loops down until we hit the sentinal:++unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8]+unpackAppendBytesStrict (PS fp off len) xs =+    inlinePerformIO $ withForeignPtr fp $ \base -> do+      loop (base `plusPtr` (off-1)) (base `plusPtr` (off-1+len)) xs+  where+    loop !sentinal !p acc+      | p == sentinal = return acc+      | otherwise     = do x <- peek p+                           loop sentinal (p `plusPtr` (-1)) (x:acc)++unpackAppendCharsStrict :: ByteString -> [Char] -> [Char]+unpackAppendCharsStrict (PS fp off len) xs =+    inlinePerformIO $ withForeignPtr fp $ \base ->+      loop (base `plusPtr` (off-1)) (base `plusPtr` (off-1+len)) xs+  where+    loop !sentinal !p acc+      | p == sentinal = return acc+      | otherwise     = do x <- peek p+                           loop sentinal (p `plusPtr` (-1)) (w2c x:acc)++------------------------------------------------------------------------+ -- | The 0 pointer. Used to indicate the empty Bytestring. nullForeignPtr :: ForeignPtr Word8 #ifdef __GLASGOW_HASKELL__-nullForeignPtr = ForeignPtr nullAddr# undefined --TODO: should ForeignPtrContents be strict?+nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr") --TODO: should ForeignPtrContents be strict? #else nullForeignPtr = unsafePerformIO $ newForeignPtr_ nullPtr {-# NOINLINE nullForeignPtr #-}@@ -238,6 +372,14 @@     return $! PS fp 0 l {-# INLINE create #-} +-- | Create ByteString of up to size @l@ and use action @f@ to fill it's contents which returns its true size.+create' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)+create' l f = do+    fp <- mallocByteString l+    (l', res) <- withForeignPtr fp $ \p -> f p+    assert (l' <= l) $ return (PS fp 0 l', res)+{-# INLINE create' #-}+ -- | Given the maximum size needed and a function to make the contents -- of a ByteString, createAndTrim makes the 'ByteString'. The generating -- function is required to return the actual final size (<= the maximum@@ -253,7 +395,7 @@         l' <- f p         if assert (l' <= l) $ l' >= l             then return $! PS fp 0 l-            else create l' $ \p' -> memcpy p' p (fromIntegral l')+            else create l' $ \p' -> memcpy p' p l' {-# INLINE createAndTrim #-}  createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)@@ -264,7 +406,7 @@         if assert (l' <= l) $ l' >= l             then return $! (PS fp 0 l, res)             else do ps <- create l' $ \p' ->-                            memcpy p' (p `plusPtr` off) (fromIntegral l')+                            memcpy p' (p `plusPtr` off) l'                     return $! (ps, res)  -- | Wrapper of 'mallocForeignPtrBytes' with faster implementation for GHC@@ -279,7 +421,49 @@ {-# INLINE mallocByteString #-}  ------------------------------------------------------------------------+-- Implementations for Eq, Ord and Monoid instances +eq :: ByteString -> ByteString -> Bool+eq a@(PS fp off len) b@(PS fp' off' len')+  | len /= len'              = False    -- short cut on length+  | fp == fp' && off == off' = True     -- short cut for the same string+  | otherwise                = compareBytes a b == EQ+{-# INLINE eq #-}+-- ^ still needed++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 $+      withForeignPtr fp1 $ \p1 ->+      withForeignPtr fp2 $ \p2 -> do+        i <- memcmp (p1 `plusPtr` off1) (p2 `plusPtr` off2) (min len1 len2)+        return $! case i `compare` 0 of+                    EQ  -> len1 `compare` len2+                    x   -> x++append :: ByteString -> ByteString -> ByteString+append (PS _   _    0)    b                  = b+append a                  (PS _   _    0)    = a+append (PS fp1 off1 len1) (PS fp2 off2 len2) =+    unsafeCreate (len1+len2) $ \destptr1 -> do+      let destptr2 = destptr1 `plusPtr` len1+      withForeignPtr fp1 $ \p1 -> memcpy destptr1 (p1 `plusPtr` off1) len1+      withForeignPtr fp2 $ \p2 -> memcpy destptr2 (p2 `plusPtr` off2) len2++concat :: [ByteString] -> ByteString+concat []     = mempty+concat [bs]   = bs+concat bss0   = unsafeCreate totalLen $ \ptr -> go bss0 ptr+  where+    totalLen = List.sum [ len | (PS _ _ len) <- bss0 ]+    go []                  !_   = return ()+    go (PS fp off len:bss) !ptr = do+      withForeignPtr fp $ \p -> memcpy ptr (p `plusPtr` off) len+      go bss (ptr `plusPtr` len)++------------------------------------------------------------------------+ -- | Conversion between 'Word8' and 'Char'. Should compile to a no-op. w2c :: Word8 -> Char #if !defined(__GLASGOW_HASKELL__)@@ -353,14 +537,17 @@ memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) memchr p w s = c_memchr p (fromIntegral w) s -foreign import ccall unsafe "string.h memcmp" memcmp+foreign import ccall unsafe "string.h memcmp" c_memcmp     :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt +memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt+memcmp p q s = c_memcmp p q (fromIntegral s)+ foreign import ccall unsafe "string.h memcpy" c_memcpy     :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8) -memcpy :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()-memcpy p q s = c_memcpy p q s >> return ()+memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()+memcpy p q s = c_memcpy p q (fromIntegral s) >> return ()  {- foreign import ccall unsafe "string.h memmove" c_memmove
Data/ByteString/Lazy.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, BangPatterns #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# OPTIONS_HADDOCK prune #-} #if __GLASGOW_HASKELL__ >= 701@@ -8,30 +8,34 @@ -- | -- Module      : Data.ByteString.Lazy -- Copyright   : (c) Don Stewart 2006---               (c) Duncan Coutts 2006+--               (c) Duncan Coutts 2006-2011 -- License     : BSD-style ----- Maintainer  : dons@galois.com--- Stability   : experimental+-- Maintainer  : dons00@gmail.com, duncan@community.haskell.org+-- Stability   : stable -- Portability : portable --  -- A time and space-efficient implementation of lazy byte vectors -- using lists of packed 'Word8' arrays, suitable for high performance -- use, both in terms of large data quantities, or high speed--- requirements. Byte vectors are encoded as lazy lists of strict 'Word8'--- arrays of bytes. They provide a means to manipulate large byte vectors--- without requiring the entire vector be resident in memory.+-- requirements. Lazy ByteStrings are encoded as lazy lists of strict chunks+-- of bytes. ----- Some operations, such as concat, append, reverse and cons, have+-- A key feature of lazy ByteStrings is the means to manipulate large or+-- unbounded streams of data without requiring the entire sequence to be+-- resident in memory. To take advantage of this you have to write your+-- functions in a lazy streaming style, e.g. classic pipeline composition. The+-- default I\/O chunk size is 32k, which should be good in most circumstances.+--+-- Some operations, such as 'concat', 'append', 'reverse' and 'cons', have -- better complexity than their "Data.ByteString" equivalents, due to--- optimisations resulting from the list spine structure. And for other+-- optimisations resulting from the list spine structure. For other -- operations lazy ByteStrings are usually within a few percent of--- strict ones, but with better heap usage. For data larger than the--- available memory, or if you have tight memory constraints, this--- module will be the only option. The default chunk size is 64k, which--- should be good in most circumstances. For people with large L2--- caches, you may want to increase this to fit your cache.+-- strict ones. --+-- The recomended way to assemble lazy ByteStrings from smaller parts+-- is to use the builder monoid from "Data.ByteString.Lazy.Builder".+-- -- This module is intended to be imported @qualified@, to avoid name -- clashes with "Prelude" functions.  eg. --@@ -41,7 +45,7 @@ -- Rewritten to use 'Data.Array.Unboxed.UArray' by Simon Marlow. -- Rewritten to support slices and use 'Foreign.ForeignPtr.ForeignPtr' -- by David Roundy.--- Polished and extended by Don Stewart.+-- Rewritten again and extended by Don Stewart and Duncan Coutts. -- Lazy variant by Duncan Coutts and Don Stewart. -- @@ -55,8 +59,12 @@         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]+        foldrChunks,            -- :: (S.ByteString -> a -> a) -> a -> ByteString -> a+        foldlChunks,            -- :: (a -> S.ByteString -> a) -> a -> ByteString -> a          -- * Basic interface         cons,                   -- :: Word8 -> ByteString -> ByteString@@ -242,45 +250,6 @@ #define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined  -- -------------------------------------------------------------------------------instance Eq  ByteString-    where (==)    = eq--instance Ord ByteString-    where compare = cmp--instance Monoid ByteString where-    mempty  = empty-    mappend = append-    mconcat = concat--eq :: ByteString -> ByteString -> Bool-eq Empty Empty = True-eq Empty _     = False-eq _     Empty = False-eq (Chunk a as) (Chunk b bs) =-  case compare (S.length a) (S.length b) of-    LT -> a == (S.take (S.length a) b) && eq as (Chunk (S.drop (S.length a) b) bs)-    EQ -> a == b                       && eq as bs-    GT -> (S.take (S.length b) a) == b && eq (Chunk (S.drop (S.length b) a) as) bs--cmp :: ByteString -> ByteString -> Ordering-cmp Empty Empty = EQ-cmp Empty _     = LT-cmp _     Empty = GT-cmp (Chunk a as) (Chunk b bs) =-  case compare (S.length a) (S.length b) of-    LT -> case compare a (S.take (S.length a) b) of-            EQ     -> cmp as (Chunk (S.drop (S.length a) b) bs)-            result -> result-    EQ -> case compare a b of-            EQ     -> cmp as bs-            result -> result-    GT -> case compare (S.take (S.length b) a) b of-            EQ     -> cmp (Chunk (S.drop (S.length b) a) as) bs-            result -> result---- ----------------------------------------------------------------------------- -- Introducing and eliminating 'ByteString's  -- | /O(1)/ The empty 'ByteString'@@ -295,26 +264,44 @@  -- | /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 fromChunks cs = L.foldr chunk Empty cs --- | /O(n)/ Convert a lazy 'ByteString' into a list of strict 'ByteString'+-- | /O(c)/ Convert a lazy 'ByteString' into a list of strict 'ByteString' 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)+ ------------------------------------------------------------------------  {-@@ -346,6 +333,9 @@ 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@@ -418,7 +408,7 @@  -- | /O(n\/c)/ Append two ByteStrings append :: ByteString -> ByteString -> ByteString-append xs ys = foldrChunks Chunk ys xs+append = mappend {-# INLINE append #-}  -- ---------------------------------------------------------------------@@ -515,12 +505,7 @@  -- | /O(n)/ Concatenate a list of ByteStrings. concat :: [ByteString] -> ByteString-concat css0 = to css0-  where-    go Empty        css = to css-    go (Chunk c cs) css = Chunk c (go cs css)-    to []               = Empty-    to (cs:css)         = go cs css+concat = mconcat  -- | Map a function over a 'ByteString' and concatenate the results concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString@@ -845,53 +830,40 @@ -- It is a special case of 'groupBy', which allows the programmer to -- supply their own equality test. group :: ByteString -> [ByteString]-group Empty          = []-group (Chunk c0 cs0) = group' [] (S.group c0) cs0-  where -    group' :: [P.ByteString] -> [P.ByteString] -> ByteString -> [ByteString]-    group' acc@(s':_) ss@(s:_) cs-      | S.unsafeHead s'-     /= S.unsafeHead s             = revNonEmptyChunks    acc  : group' [] ss cs-    group' acc (s:[]) Empty        = revNonEmptyChunks (s:acc) : []-    group' acc (s:[]) (Chunk c cs) = group' (s:acc) (S.group c) cs-    group' acc (s:ss) cs           = revNonEmptyChunks (s:acc) : group' [] ss cs--{--TODO: check if something like this might be faster+group = go+  where+    go Empty        = []+    go (Chunk c cs)+      | S.length c == 1  = to [c] (S.unsafeHead c) cs+      | otherwise        = to [S.unsafeTake 1 c] (S.unsafeHead c) (Chunk (S.unsafeTail c) cs) -group :: ByteString -> [ByteString]-group xs-    | null xs   = []-    | otherwise = ys : group zs-    where-        (ys, zs) = spanByte (unsafeHead xs) xs--}+    to acc !_ Empty        = revNonEmptyChunks acc : []+    to acc !w (Chunk c cs) =+      case findIndexOrEnd (/= w) c of+        0                    -> revNonEmptyChunks acc+                              : go (Chunk c cs)+        n | n == S.length c  -> to (S.unsafeTake n c : acc) w cs+          | otherwise        -> revNonEmptyChunks (S.unsafeTake n c : acc)+                              : go (Chunk (S.unsafeDrop n c) cs)  -- | The 'groupBy' function is the non-overloaded version of 'group'. -- groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]-groupBy _ Empty          = []-groupBy k (Chunk c0 cs0) = groupBy' [] 0 (S.groupBy k c0) cs0+groupBy k = go   where-    groupBy' :: [P.ByteString] -> Word8 -> [P.ByteString] -> ByteString -> [ByteString]-    groupBy' acc@(_:_) c ss@(s:_) cs-      | not (c `k` S.unsafeHead s)     = revNonEmptyChunks acc : groupBy' [] 0 ss cs-    groupBy' acc _ (s:[]) Empty        = revNonEmptyChunks (s : acc) : []-    groupBy' acc w (s:[]) (Chunk c cs) = groupBy' (s:acc) w' (S.groupBy k c) cs-                                           where w' | L.null acc = S.unsafeHead s-                                                    | otherwise  = w-    groupBy' acc _ (s:ss) cs           = revNonEmptyChunks (s : acc) : groupBy' [] 0 ss cs--{--TODO: check if something like this might be faster+    go Empty        = []+    go (Chunk c cs)+      | S.length c == 1  = to [c] (S.unsafeHead c) cs+      | otherwise        = to [S.unsafeTake 1 c] (S.unsafeHead c) (Chunk (S.unsafeTail c) cs) -groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]-groupBy k xs-    | null xs   = []-    | otherwise = take n xs : groupBy k (drop n xs)-    where-        n = 1 + findIndexOrEnd (not . k (head xs)) (tail xs)--}+    to acc !_ Empty        = revNonEmptyChunks acc : []+    to acc !w (Chunk c cs) =+      case findIndexOrEnd (not . k w) c of+        0                    -> revNonEmptyChunks acc+                              : go (Chunk c cs)+        n | n == S.length c  -> to (S.unsafeTake n c : acc) w cs+          | otherwise        -> revNonEmptyChunks (S.unsafeTake n c : acc)+                              : go (Chunk (S.unsafeDrop n c) cs)  -- | /O(n)/ The 'intercalate' function takes a 'ByteString' and a list of -- 'ByteString's and concatenates the list after interspersing the first@@ -1344,9 +1316,11 @@ -- constant strings created when compiled: errorEmptyList :: String -> a errorEmptyList fun = moduleError fun "empty ByteString"+{-# NOINLINE errorEmptyList #-}  moduleError :: String -> String -> a moduleError fun msg = error ("Data.ByteString.Lazy." ++ fun ++ ':':' ':msg)+{-# NOINLINE moduleError #-}   -- reverse a list of non-empty chunks into a lazy ByteString
+ Data/ByteString/Lazy/Builder.hs view
@@ -0,0 +1,451 @@+{-# LANGUAGE CPP, BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{- | Copyright   : (c) 2010 Jasper Van der Jeugt+                   (c) 2010 - 2011 Simon Meier+License     : BSD3-style (see LICENSE)+Maintainer  : Simon Meier <iridcode@gmail.com>+Portability : GHC++'Builder's are used to efficiently construct sequences of bytes from+  smaller parts.+Typically,+  such a construction is part of the implementation of an /encoding/, i.e.,+  a function for converting Haskell values to sequences of bytes.+Examples of encodings are the generation of the sequence of bytes+  representing a HTML document to be sent in a HTTP response by a+  web application or the serialization of a Haskell value using+  a fixed binary format.++For an /efficient implementation of an encoding/,+  it is important that (a) little time is spent on converting+  the Haskell values to the resulting sequence of bytes /and/+  (b) that the representation of the resulting sequence+  is such that it can be consumed efficiently.+'Builder's support (a) by providing an /O(1)/ concatentation operation+  and efficient implementations of basic encodings for 'Char's, 'Int's,+  and other standard Haskell values.+They support (b) by providing their result as a lazy 'L.ByteString',+  which is internally just a linked list of pointers to /chunks/+  of consecutive raw memory.+Lazy 'L.ByteString's can be efficiently consumed by functions that+  write them to a file or send them over a network socket.+Note that each chunk boundary incurs expensive extra work (e.g., a system call)+  that must be amortized over the work spent on consuming the chunk body.+'Builder's therefore take special care to ensure that the+  average chunk size is large enough.+The precise meaning of large enough is application dependent.+The current implementation is tuned+  for an average chunk size between 4kb and 32kb,+  which should suit most applications.++As a simple example of an encoding implementation,+  we show how to efficiently convert the following representation of mixed-data+  tables to an UTF-8 encoded Comma-Separated-Values (CSV) table.++>data Cell = StringC String+>          | IntC Int+>          deriving( Eq, Ord, Show )+>+>type Row   = [Cell]+>type Table = [Row]++We use the following imports and abbreviate 'mappend' to simplify reading.++@+import qualified "Data.ByteString.Lazy"               as L+import           "Data.ByteString.Lazy.Builder"+import           "Data.ByteString.Lazy.Builder.ASCII" ('intDec')+import           Data.Monoid+import           Data.Foldable                        ('foldMap')+import           Data.List                            ('intersperse')++infixr 4 \<\>+(\<\>) :: 'Monoid' m => m -> m -> m+(\<\>) = 'mappend'+@++CSV is a character-based representation of tables. For maximal modularity,+we could first render 'Table's as 'String's and then encode this 'String'+using some Unicode character encoding. However, this sacrifices performance+due to the intermediate 'String' representation being built and thrown away+right afterwards. We get rid of this intermediate 'String' representation by+fixing the character encoding to UTF-8 and using 'Builder's to convert+'Table's directly to UTF-8 encoded CSV tables represented as lazy+'L.ByteString's.++@+encodeUtf8CSV :: Table -> L.ByteString+encodeUtf8CSV = 'toLazyByteString' . renderTable++renderTable :: Table -> Builder+renderTable rs = 'mconcat' [renderRow r \<\> 'charUtf8' \'\\n\' | r <- rs]++renderRow :: Row -> Builder+renderRow []     = 'mempty'+renderRow (c:cs) =+    renderCell c \<\> mconcat [ charUtf8 \',\' \<\> renderCell c\' | c\' <- cs ]++renderCell :: Cell -> Builder+renderCell (StringC cs) = renderString cs+renderCell (IntC i)     = 'intDec' i++renderString :: String -> Builder+renderString cs = charUtf8 \'\"\' \<\> foldMap escape cs \<\> charUtf8 \'\"\'+  where+    escape \'\\\\\' = charUtf8 \'\\\\\' \<\> charUtf8 \'\\\\\'+    escape \'\\\"\' = charUtf8 \'\\\\\' \<\> charUtf8 \'\\\"\'+    escape c    = charUtf8 c+@++Note that the ASCII encoding is a subset of the UTF-8 encoding,+  which is why we can use the optimized function 'intDec' to+  encode an 'Int' as a decimal number with UTF-8 encoded digits.+Using 'intDec' is more efficient than @'stringUtf8' . 'show'@,+  as it avoids constructing an intermediate 'String'.+Avoiding this intermediate data structure significantly improves+  performance because encoding 'Cell's is the core operation+  for rendering CSV-tables.+See "Data.ByteString.Lazy.Builder.BasicEncoding" for further+  information on how to improve the performance of 'renderString'.++We demonstrate our UTF-8 CSV encoding function on the following table.++@+strings :: [String]+strings =  [\"hello\", \"\\\"1\\\"\", \"&#955;-w&#246;rld\"]++table :: Table+table = [map StringC strings, map IntC [-3..3]]+@++The expression @encodeUtf8CSV table@ results in the following lazy+'L.ByteString'.++>Chunk "\"hello\",\"\\\"1\\\"\",\"\206\187-w\195\182rld\"\n-3,-2,-1,0,1,2,3\n" Empty++We can clearly see that we are converting to a /binary/ format. The \'&#955;\'+and \'&#246;\' characters, which have a Unicode codepoint above 127, are+expanded to their corresponding UTF-8 multi-byte representation.++We use the @criterion@ library (<http://hackage.haskell.org/package/criterion>)+  to benchmark the efficiency of our encoding function on the following table.++>import Criterion.Main     -- add this import to the ones above+>+>maxiTable :: Table+>maxiTable = take 1000 $ cycle table+>+>main :: IO ()+>main = defaultMain+>  [ bench "encodeUtf8CSV maxiTable (original)" $+>      whnf (L.length . encodeUtf8CSV) maxiTable+>  ]++On a Core2 Duo 2.20GHz on a 32-bit Linux,+  the above code takes 1ms to generate the 22'500 bytes long lazy 'L.ByteString'.+Looking again at the definitions above,+  we see that we took care to avoid intermediate data structures,+  as otherwise we would sacrifice performance.+For example,+  the following (arguably simpler) definition of 'renderRow' is about 20% slower.++>renderRow :: Row -> Builder+>renderRow  = mconcat . intersperse (charUtf8 ',') . map renderCell++Similarly, using /O(n)/ concatentations like '++' or the equivalent 'S.concat'+  operations on strict and lazy 'L.ByteString's should be avoided.+The following definition of 'renderString' is also about 20% slower.++>renderString :: String -> Builder+>renderString cs = charUtf8 $ "\"" ++ concatMap escape cs ++ "\""+>  where+>    escape '\\' = "\\"+>    escape '\"' = "\\\""+>    escape c    = return c++Apart from removing intermediate data-structures,+  encodings can be optimized further by fine-tuning their execution+  parameters using the functions in "Data.ByteString.Lazy.Builder.Extras" and+  their \"inner loops\" using the functions in+  "Data.ByteString.Lazy.Builder.BasicEncoding".+-}+++module Data.ByteString.Lazy.Builder+    (+      -- * The Builder type+      Builder++      -- * Executing Builders+      -- | Internally, 'Builder's are buffer-filling functions. They are+      -- executed by a /driver/ that provides them with an actual buffer to+      -- fill. Once called with a buffer, a 'Builder' fills it and returns a+      -- signal to the driver telling it that it is either done, has filled the+      -- current buffer, or wants to directly insert a reference to a chunk of+      -- memory. In the last two cases, the 'Builder' also returns a+      -- continutation 'Builder' that the driver can call to fill the next+      -- buffer. Here, we provide the two drivers that satisfy almost all use+      -- cases. See "Data.ByteString.Lazy.Builder.Extras", for information+      -- about fine-tuning them.+    , toLazyByteString+    , hPutBuilder++      -- * Creating Builders++      -- ** Binary encodings+    , byteString+    , lazyByteString+    , int8+    , word8++      -- *** Big-endian+    , int16BE+    , int32BE+    , int64BE++    , word16BE+    , word32BE+    , word64BE++    , floatBE+    , doubleBE++      -- *** Little-endian+    , int16LE+    , int32LE+    , int64LE++    , word16LE+    , word32LE+    , word64LE++    , floatLE+    , doubleLE++    -- ** Character encodings++    -- *** ASCII (Char7)+    -- | The ASCII encoding is a 7-bit encoding. The /Char7/ encoding implemented here+    -- works by truncating the Unicode codepoint to 7-bits, prefixing it+    -- with a leading 0, and encoding the resulting 8-bits as a single byte.+    -- For the codepoints 0-127 this corresponds the ASCII encoding. In+    -- "Data.ByteString.Lazy.Builder.ASCII", we also provide efficient+    -- implementations of ASCII-based encodings of numbers (e.g., decimal and+    -- hexadecimal encodings).+    , char7+    , string7++    -- *** ISO/IEC 8859-1 (Char8)+    -- | The ISO/IEC 8859-1 encoding is an 8-bit encoding often known as Latin-1.+    -- The /Char8/ encoding implemented here works by truncating the Unicode codepoint+    -- to 8-bits and encoding them as a single byte. For the codepoints 0-255 this corresponds+    -- to the ISO/IEC 8859-1 encoding. Note that you can also use+    -- the functions from "Data.ByteString.Lazy.Builder.ASCII", as the ASCII encoding+    -- and ISO/IEC 8859-1 are equivalent on the codepoints 0-127.+    , char8+    , string8++    -- *** UTF-8+    -- | The UTF-8 encoding can encode /all/ Unicode codepoints. We recommend+    -- using it always for encoding 'Char's and 'String's unless an application+    -- really requires another encoding. Note that you can also use the+    -- functions from "Data.ByteString.Lazy.Builder.ASCII" for UTF-8 encoding,+    -- as the ASCII encoding is equivalent to the UTF-8 encoding on the Unicode+    -- codepoints 0-127.+    , charUtf8+    , stringUtf8+++    ) where++import           Data.ByteString.Lazy.Builder.Internal+import qualified Data.ByteString.Lazy.Builder.BasicEncoding as E+import qualified Data.ByteString.Lazy.Internal as L++import           System.IO (Handle)+import           Foreign++-- HADDOCK only imports+import           Data.ByteString.Lazy.Builder.ASCII (intDec)+import qualified Data.ByteString               as S (concat)+import           Data.Monoid+import           Data.Foldable                      (foldMap)+import           Data.List                          (intersperse)+++-- | Execute a 'Builder' and return the generated chunks as a lazy 'L.ByteString'.+-- The work is performed lazy, i.e., only when a chunk of the lazy 'L.ByteString'+-- is forced.+{-# NOINLINE toLazyByteString #-} -- ensure code is shared+toLazyByteString :: Builder -> L.ByteString+toLazyByteString = toLazyByteStringWith+    (safeStrategy L.smallChunkSize L.defaultChunkSize) L.Empty++{- Not yet stable enough.+   See note on 'hPut' in Data.ByteString.Lazy.Builder.Internal+-}++-- | Output a 'Builder' to a 'Handle'.+-- The 'Builder' is executed directly on the buffer of the 'Handle'. If the+-- buffer is too small (or not present), then it is replaced with a large+-- enough buffer.+--+-- It is recommended that the 'Handle' is set to binary and+-- 'BlockBuffering' mode. See 'hSetBinaryMode' and 'hSetBuffering'.+--+-- This function is more efficient than @hPut . 'toLazyByteString'@ because in+-- many cases no buffer allocation has to be done. Moreover, the results of+-- several executions of short 'Builder's are concatenated in the 'Handle's+-- buffer, therefore avoiding unnecessary buffer flushes.+hPutBuilder :: Handle -> Builder -> IO ()+hPutBuilder h = hPut h . putBuilder+++------------------------------------------------------------------------------+-- Binary encodings+------------------------------------------------------------------------------++-- | Encode a single signed byte as-is.+--+{-# INLINE int8 #-}+int8 :: Int8 -> Builder+int8 = E.encodeWithF E.int8++-- | Encode a single unsigned byte as-is.+--+{-# INLINE word8 #-}+word8 :: Word8 -> Builder+word8 = E.encodeWithF E.word8+++------------------------------------------------------------------------------+-- Binary little-endian encodings+------------------------------------------------------------------------------++-- | Encode an 'Int16' in little endian format.+{-# INLINE int16LE #-}+int16LE :: Int16 -> Builder+int16LE = E.encodeWithF E.int16LE++-- | Encode an 'Int32' in little endian format.+{-# INLINE int32LE #-}+int32LE :: Int32 -> Builder+int32LE = E.encodeWithF E.int32LE++-- | Encode an 'Int64' in little endian format.+{-# INLINE int64LE #-}+int64LE :: Int64 -> Builder+int64LE = E.encodeWithF E.int64LE++-- | Encode a 'Word16' in little endian format.+{-# INLINE word16LE #-}+word16LE :: Word16 -> Builder+word16LE = E.encodeWithF E.word16LE++-- | Encode a 'Word32' in little endian format.+{-# INLINE word32LE #-}+word32LE :: Word32 -> Builder+word32LE = E.encodeWithF E.word32LE++-- | Encode a 'Word64' in little endian format.+{-# INLINE word64LE #-}+word64LE :: Word64 -> Builder+word64LE = E.encodeWithF E.word64LE++-- | Encode a 'Float' in little endian format.+{-# INLINE floatLE #-}+floatLE :: Float -> Builder+floatLE = E.encodeWithF E.floatLE++-- | Encode a 'Double' in little endian format.+{-# INLINE doubleLE #-}+doubleLE :: Double -> Builder+doubleLE = E.encodeWithF E.doubleLE+++------------------------------------------------------------------------------+-- Binary big-endian encodings+------------------------------------------------------------------------------++-- | Encode an 'Int16' in big endian format.+{-# INLINE int16BE #-}+int16BE :: Int16 -> Builder+int16BE = E.encodeWithF E.int16BE++-- | Encode an 'Int32' in big endian format.+{-# INLINE int32BE #-}+int32BE :: Int32 -> Builder+int32BE = E.encodeWithF E.int32BE++-- | Encode an 'Int64' in big endian format.+{-# INLINE int64BE #-}+int64BE :: Int64 -> Builder+int64BE = E.encodeWithF E.int64BE++-- | Encode a 'Word16' in big endian format.+{-# INLINE word16BE #-}+word16BE :: Word16 -> Builder+word16BE = E.encodeWithF E.word16BE++-- | Encode a 'Word32' in big endian format.+{-# INLINE word32BE #-}+word32BE :: Word32 -> Builder+word32BE = E.encodeWithF E.word32BE++-- | Encode a 'Word64' in big endian format.+{-# INLINE word64BE #-}+word64BE :: Word64 -> Builder+word64BE = E.encodeWithF E.word64BE++-- | Encode a 'Float' in big endian format.+{-# INLINE floatBE #-}+floatBE :: Float -> Builder+floatBE = E.encodeWithF E.floatBE++-- | Encode a 'Double' in big endian format.+{-# INLINE doubleBE #-}+doubleBE :: Double -> Builder+doubleBE = E.encodeWithF E.doubleBE++------------------------------------------------------------------------------+-- ASCII encoding+------------------------------------------------------------------------------++-- | Char7 encode a 'Char'.+{-# INLINE char7 #-}+char7 :: Char -> Builder+char7 = E.encodeWithF E.char7++-- | Char7 encode a 'String'.+{-# INLINE string7 #-}+string7 :: String -> Builder+string7 = E.encodeListWithF E.char7++------------------------------------------------------------------------------+-- ISO/IEC 8859-1 encoding+------------------------------------------------------------------------------++-- | Char8 encode a 'Char'.+{-# INLINE char8 #-}+char8 :: Char -> Builder+char8 = E.encodeWithF E.char8++-- | Char8 encode a 'String'.+{-# INLINE string8 #-}+string8 :: String -> Builder+string8 = E.encodeListWithF E.char8++------------------------------------------------------------------------------+-- UTF-8 encoding+------------------------------------------------------------------------------++-- | UTF-8 encode a 'Char'.+{-# INLINE charUtf8 #-}+charUtf8 :: Char -> Builder+charUtf8 = E.encodeWithB E.charUtf8++-- | UTF-8 encode a 'String'.+{-# INLINE stringUtf8 #-}+stringUtf8 :: String -> Builder+stringUtf8 = E.encodeListWithB E.charUtf8+
+ Data/ByteString/Lazy/Builder/ASCII.hs view
@@ -0,0 +1,262 @@+{-# LANGUAGE ScopedTypeVariables, CPP, ForeignFunctionInterface #-}+-- | Copyright : (c) 2010 - 2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Portability : GHC+--+-- Constructing 'Builder's using ASCII-based encodings.+--+module Data.ByteString.Lazy.Builder.ASCII+    (+      -- * Decimal numbers+      -- | Decimal encoding of numbers using ASCII encoded characters.+      int8Dec+    , int16Dec+    , int32Dec+    , int64Dec+    , intDec+    , integerDec++    , word8Dec+    , word16Dec+    , word32Dec+    , word64Dec+    , wordDec++    , floatDec+    , doubleDec++      -- * Hexadecimal numbers++      -- | Encoding positive integers as hexadecimal numbers using lower-case+      -- ASCII characters. The shortest+      -- possible representation is used. For example,+      --+      -- >>> toLazyByteString (word16Hex 0x0a10)+      -- Chunk "a10" Empty+      --+      -- Note that there is no support for using upper-case characters. Please+      -- contact the maintainer, if your application cannot work without+      -- hexadecimal encodings that use upper-case characters.+      --+    , word8Hex+    , word16Hex+    , word32Hex+    , word64Hex+    , wordHex++      -- * Fixed-width hexadecimal numbers+      --+    , int8HexFixed+    , int16HexFixed+    , int32HexFixed+    , int64HexFixed+    , word8HexFixed+    , word16HexFixed+    , word32HexFixed+    , word64HexFixed++    , floatHexFixed+    , doubleHexFixed++    , byteStringHexFixed+    , lazyByteStringHexFixed++    ) where++import           Data.ByteString                                  as S+import           Data.ByteString.Lazy.Internal                    as L+import           Data.ByteString.Lazy.Builder.Internal (Builder)+import qualified Data.ByteString.Lazy.Builder.BasicEncoding       as E++import           Foreign++------------------------------------------------------------------------------+-- Decimal Encoding+------------------------------------------------------------------------------+++-- | Encode a 'String' using 'E.char7'.+{-# INLINE string7 #-}+string7 :: String -> Builder+string7 = E.encodeListWithF E.char7++------------------------------------------------------------------------------+-- Decimal Encoding+------------------------------------------------------------------------------++-- Signed integers+------------------++-- | Decimal encoding of an 'Int8' using the ASCII digits.+{-# INLINE int8Dec #-}+int8Dec :: Int8 -> Builder+int8Dec = E.encodeWithB E.int8Dec++-- | Decimal encoding of an 'Int16' using the ASCII digits.+{-# INLINE int16Dec #-}+int16Dec :: Int16 -> Builder+int16Dec = E.encodeWithB E.int16Dec++-- | Decimal encoding of an 'Int32' using the ASCII digits.+{-# INLINE int32Dec #-}+int32Dec :: Int32 -> Builder+int32Dec = E.encodeWithB E.int32Dec++-- | Decimal encoding of an 'Int64' using the ASCII digits.+{-# INLINE int64Dec #-}+int64Dec :: Int64 -> Builder+int64Dec = E.encodeWithB E.int64Dec++-- | Decimal encoding of an 'Int' using the ASCII digits.+{-# INLINE intDec #-}+intDec :: Int -> Builder+intDec = E.encodeWithB E.intDec++-- | /Currently slow./ Decimal encoding of an 'Integer' using the ASCII digits.+{-# INLINE integerDec #-}+integerDec :: Integer -> Builder+integerDec =  string7 . show+++-- Unsigned integers+--------------------++-- | Decimal encoding of a 'Word8' using the ASCII digits.+{-# INLINE word8Dec #-}+word8Dec :: Word8 -> Builder+word8Dec = E.encodeWithB E.word8Dec++-- | Decimal encoding of a 'Word16' using the ASCII digits.+{-# INLINE word16Dec #-}+word16Dec :: Word16 -> Builder+word16Dec = E.encodeWithB E.word16Dec++-- | Decimal encoding of a 'Word32' using the ASCII digits.+{-# INLINE word32Dec #-}+word32Dec :: Word32 -> Builder+word32Dec = E.encodeWithB E.word32Dec++-- | Decimal encoding of a 'Word64' using the ASCII digits.+{-# INLINE word64Dec #-}+word64Dec :: Word64 -> Builder+word64Dec = E.encodeWithB E.word64Dec++-- | Decimal encoding of a 'Word' using the ASCII digits.+{-# INLINE wordDec #-}+wordDec :: Word -> Builder+wordDec = E.encodeWithB E.wordDec+++-- Floating point numbers+-------------------------++-- TODO: Use Bryan O'Sullivan's double-conversion package to speed it up.++-- | /Currently slow./ Decimal encoding of an IEEE 'Float'.+{-# INLINE floatDec #-}+floatDec :: Float -> Builder+floatDec = string7 . show++-- | /Currently slow./ Decimal encoding of an IEEE 'Double'.+{-# INLINE doubleDec #-}+doubleDec :: Double -> Builder+doubleDec = string7 . show+++------------------------------------------------------------------------------+-- Hexadecimal Encoding+------------------------------------------------------------------------------++-- without lead+---------------++-- | Shortest hexadecimal encoding of a 'Word8' using lower-case characters.+{-# INLINE word8Hex #-}+word8Hex :: Word8 -> Builder+word8Hex = E.encodeWithB E.word8Hex++-- | Shortest hexadecimal encoding of a 'Word16' using lower-case characters.+{-# INLINE word16Hex #-}+word16Hex :: Word16 -> Builder+word16Hex = E.encodeWithB E.word16Hex++-- | Shortest hexadecimal encoding of a 'Word32' using lower-case characters.+{-# INLINE word32Hex #-}+word32Hex :: Word32 -> Builder+word32Hex = E.encodeWithB E.word32Hex++-- | Shortest hexadecimal encoding of a 'Word64' using lower-case characters.+{-# INLINE word64Hex #-}+word64Hex :: Word64 -> Builder+word64Hex = E.encodeWithB E.word64Hex++-- | Shortest hexadecimal encoding of a 'Word' using lower-case characters.+{-# INLINE wordHex #-}+wordHex :: Word -> Builder+wordHex = E.encodeWithB E.wordHex+++-- fixed width; leading zeroes+------------------------------++-- | Encode a 'Int8' using 2 nibbles (hexadecimal digits).+{-# INLINE int8HexFixed #-}+int8HexFixed :: Int8 -> Builder+int8HexFixed = E.encodeWithF E.int8HexFixed++-- | Encode a 'Int16' using 4 nibbles.+{-# INLINE int16HexFixed #-}+int16HexFixed :: Int16 -> Builder+int16HexFixed = E.encodeWithF E.int16HexFixed++-- | Encode a 'Int32' using 8 nibbles.+{-# INLINE int32HexFixed #-}+int32HexFixed :: Int32 -> Builder+int32HexFixed = E.encodeWithF E.int32HexFixed++-- | Encode a 'Int64' using 16 nibbles.+{-# INLINE int64HexFixed #-}+int64HexFixed :: Int64 -> Builder+int64HexFixed = E.encodeWithF E.int64HexFixed++-- | Encode a 'Word8' using 2 nibbles (hexadecimal digits).+{-# INLINE word8HexFixed #-}+word8HexFixed :: Word8 -> Builder+word8HexFixed = E.encodeWithF E.word8HexFixed++-- | Encode a 'Word16' using 4 nibbles.+{-# INLINE word16HexFixed #-}+word16HexFixed :: Word16 -> Builder+word16HexFixed = E.encodeWithF E.word16HexFixed++-- | Encode a 'Word32' using 8 nibbles.+{-# INLINE word32HexFixed #-}+word32HexFixed :: Word32 -> Builder+word32HexFixed = E.encodeWithF E.word32HexFixed++-- | Encode a 'Word64' using 16 nibbles.+{-# INLINE word64HexFixed #-}+word64HexFixed :: Word64 -> Builder+word64HexFixed = E.encodeWithF E.word64HexFixed++-- | Encode an IEEE 'Float' using 8 nibbles.+{-# INLINE floatHexFixed #-}+floatHexFixed :: Float -> Builder+floatHexFixed = E.encodeWithF E.floatHexFixed++-- | Encode an IEEE 'Double' using 16 nibbles.+{-# INLINE doubleHexFixed #-}+doubleHexFixed :: Double -> Builder+doubleHexFixed = E.encodeWithF E.doubleHexFixed++-- | Encode each byte of a 'S.ByteString' using its fixed-width hex encoding.+{-# NOINLINE byteStringHexFixed #-} -- share code+byteStringHexFixed :: S.ByteString -> Builder+byteStringHexFixed = E.encodeByteStringWithF E.word8HexFixed++-- | Encode each byte of a lazy 'L.ByteString' using its fixed-width hex encoding.+{-# NOINLINE lazyByteStringHexFixed #-} -- share code+lazyByteStringHexFixed :: L.ByteString -> Builder+lazyByteStringHexFixed = E.encodeLazyByteStringWithF E.word8HexFixed
+ Data/ByteString/Lazy/Builder/BasicEncoding.hs view
@@ -0,0 +1,804 @@+{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{- | Copyright : (c) 2010-2011 Simon Meier+                   (c) 2010      Jasper van der Jeugt+License        : BSD3-style (see LICENSE)+Maintainer     : Simon Meier <iridcode@gmail.com>+Portability    : GHC++This module provides the types of fixed-size and bounded-size encodings,+  which are the basic building blocks for constructing 'Builder's.+These types are used to achieve+  application-specific performance improvements of 'Builder's.++/Fixed(-size) encodings/ are encodings that always result in a sequence of bytes+  of a predetermined, fixed length.+An example for a fixed encoding is the big-endian encoding of a 'Word64',+  which always results in exactly 8 bytes.+/Bounded(-size) encodings/ are encodings that always result in a sequence+  of bytes that is no larger than a predetermined bound.+An example for a bounded encoding is the UTF-8 encoding of a 'Char',+  which results always in less or equal to 4 bytes.+Note that every fixed encoding is also a bounded encoding.+In the following, we therefore only refer to fixed encodings,+  where it matters that the resulting sequence of bytes is of a+  of a predetermined, fixed length.+Otherwise, we just refer to bounded encodings.++As said,+  the goal of bounded encodings is to improve the performance of 'Builder's.+These improvements stem from making the two+  most common steps performed by a 'Builder' more efficient.+We explain these two steps in turn.++The first most common step is the concatentation of two 'Builder's.+Internally,+  concatentation corresponds to function composition.+(Note that 'Builder's can be seen as difference-lists+  of buffer-filling functions;+  cf.  <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/dlist>.+)+Function composition is a fast /O(1)/ operation.+However,+  we can use bounded encodings to+  remove some of these function compositions altoghether,+  which is obviously more efficient.++The second most common step performed by a 'Builder' is to fill a buffer+  using a bounded encoding,+  which works as follows.+The 'Builder' checks whether there is enough space left to+  execute the bounded encoding.+If there is, then the 'Builder' executes the bounded encoding+  and calls the next 'Builder' with the updated buffer.+Otherwise,+  the 'Builder' signals its driver that it requires a new buffer.+This buffer must be at least as large as the bound of the encoding.+We can use bounded encodings to reduce the number of buffer-free+  checks by fusing the buffer-free checks of consecutive+  'Builder's.+We can also use bounded encodings to simplify the control flow+  for signalling that a buffer is full by+  ensuring that we check first that there is enough space left+  and only then decide on how to encode a given value.++Let us illustrate these improvements on the+  CSV-table rendering example from "Data.ByteString.Lazy.Builder".+Its \"hot code\" is the rendering of a table's cells,+  which we implement as follows using only the functions from the+  'Builder' API.++@+import           "Data.ByteString.Lazy.Builder"         as B+import           "Data.ByteString.Lazy.Builder.ASCII"   as B++renderCell :: Cell -> Builder+renderCell (StringC cs) = renderString cs+renderCell (IntC i)     = B.intDec i++renderString :: String -> Builder+renderString cs = B.charUtf8 \'\"\' \<\> foldMap escape cs \<\> B.charUtf8 \'\"\'+  where+    escape \'\\\\\' = B.charUtf8 \'\\\\\' \<\> B.charUtf8 \'\\\\\'+    escape \'\\\"\' = B.charUtf8 \'\\\\\' \<\> B.charUtf8 \'\\\"\'+    escape c    = B.charUtf8 c+@++Efficient encoding of 'Int's as decimal numbers is performed by @intDec@+  from "Data.ByteString.Lazy.Builder.ASCII".+Optimization potential exists for the escaping of 'String's.+The above implementation has two optimization opportunities.+First,+  the buffer-free checks of the 'Builder's for escaping doublequotes+  and backslashes can be fused.+Second,+  the concatenations performed by 'foldMap' can be eliminated.+The following implementation exploits these optimizations.++@+import qualified Data.ByteString.Lazy.Builder.BasicEncoding  as E+import           Data.ByteString.Lazy.Builder.BasicEncoding+                 ( 'ifB', 'fromF', ('>*<'), ('>$<') )++renderString :: String -\> Builder+renderString cs =+    B.charUtf8 \'\"\' \<\> E.'encodeListWithB' escape cs \<\> B.charUtf8 \'\"\'+  where+    escape :: E.'BoundedEncoding' Char+    escape =+      'ifB' (== \'\\\\\') (fixed2 (\'\\\\\', \'\\\\\')) $+      'ifB' (== \'\\\"\') (fixed2 (\'\\\\\', \'\\\"\')) $+      E.'charUtf8'+    &#160;+    {&#45;\# INLINE fixed2 \#&#45;}+    fixed2 x = 'fromF' $ const x '>$<' E.'char7' '>*<' E.'char7'+@++The code should be mostly self-explanatory.+The slightly awkward syntax is because the combinators+  are written such that the size-bound of the resulting 'BoundedEncoding'+  can be computed at compile time.+We also explicitly inline the 'fixed2' encoding,+  which encodes a fixed tuple of characters,+  to ensure that the bound compuation happens at compile time.+When encoding the following list of 'String's,+  the optimized implementation of 'renderString' is two times faster.++@+maxiStrings :: [String]+maxiStrings = take 1000 $ cycle [\"hello\", \"\\\"1\\\"\", \"&#955;-w&#246;rld\"]+@++Most of the performance gain stems from using 'encodeListWithB',+  which encodes a list of values from left-to-right with a+  'BoundedEncoding'.+It exploits the 'Builder' internals to avoid unnecessary function+  compositions (i.e., concatentations).+In the future,+  we would expect the compiler to perform the optimizations+  implemented in 'encodeListWithB'.+However,+  it seems that the code is currently to complicated for the+  compiler to see through.+Therefore,+  we provide the 'BoundedEncoding' escape hatch,+  which allows data structures to provide very efficient encoding traversals,+  like 'encodeListWithB' for lists.++Note that 'BoundedEncoding's are a bit verbose, but quite versatile.+Here is an example of a 'BoundedEncoding' for combined HTML escapng and+UTF-8 encoding.+It exploits that the escaped character with the maximal Unicode+  codepoint is \'>\'.++@+{&#45;\# INLINE charUtf8HtmlEscaped \#&#45;}+charUtf8HtmlEscaped :: E.BoundedEncoding Char+charUtf8HtmlEscaped =+    'ifB' (>  \'\>\' ) E.'charUtf8' $+    'ifB' (== \'\<\' ) (fixed4 (\'&\',(\'l\',(\'t\',\';\')))) $        -- &lt;+    'ifB' (== \'\>\' ) (fixed4 (\'&\',(\'g\',(\'t\',\';\')))) $        -- &gt;+    'ifB' (== \'&\' ) (fixed5 (\'&\',(\'a\',(\'m\',(\'p\',\';\'))))) $  -- &amp;+    'ifB' (== \'\"\' ) (fixed5 (\'&\',(\'\#\',(\'3\',(\'4\',\';\'))))) $  -- &\#34;+    'ifB' (== \'\\\'\') (fixed5 (\'&\',(\'\#\',(\'3\',(\'9\',\';\'))))) $  -- &\#39;+    ('fromF' E.'char7')         -- fallback for 'Char's smaller than \'\>\'+  where+    {&#45;\# INLINE fixed4 \#&#45;}+    fixed4 x = 'fromF' $ const x '>$<'+      E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7+    &#160;+    {&#45;\# INLINE fixed5 \#&#45;}+    fixed5 x = 'fromF' $ const x '>$<'+      E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7 '>*<' E.char7+@++This module currently does not expose functions that require the special+  properties of fixed-size encodings.+They are useful for prefixing 'Builder's with their size or for+  implementing chunked encodings.+We will expose the corresponding functions in future releases of this+  library.+-}++++{-+--+--+-- A /bounded encoding/ is an encoding that never results in a sequence+-- longer than some fixed number of bytes. This number of bytes must be+-- independent of the value being encoded. Typical examples of bounded+-- encodings are the big-endian encoding of a 'Word64', which results always+-- in exactly 8 bytes, or the UTF-8 encoding of a 'Char', which results always+-- in less or equal to 4 bytes.+--+-- Typically, encodings are implemented efficiently by allocating a buffer (an+-- array of bytes) and repeatedly executing the following two steps: (1)+-- writing to the buffer until it is full and (2) handing over the filled part+-- to the consumer of the encoded value. Step (1) is where bounded encodings+-- are used. We must use a bounded encoding, as we must check that there is+-- enough free space /before/ actually writing to the buffer.+--+-- In term of expressivity, it would be sufficient to construct all encodings+-- from the single bounded encoding that encodes a 'Word8' as-is. However,+-- this is not sufficient in terms of efficiency. It results in unnecessary+-- buffer-full checks and it complicates the program-flow for writing to the+-- buffer, as buffer-full checks are interleaved with analyzing the value to be+-- encoded (e.g., think about the program-flow for UTF-8 encoding). This has a+-- significant effect on overall encoding performance, as encoding primitive+-- Haskell values such as 'Word8's or 'Char's lies at the heart of every+-- encoding implementation.+--+-- The bounded 'Encoding's provided by this module remove this performance+-- problem. Intuitively, they consist of a tuple of the bound on the maximal+-- number of bytes written and the actual implementation of the encoding as a+-- function that modifies a mutable buffer. Hence when executing a bounded+-- 'Encoding', the buffer-full check can be done once before the actual writing+-- to the buffer. The provided 'Encoding's also take care to implement the+-- actual writing to the buffer efficiently. Moreover, combinators are+-- provided to construct new bounded encodings from the provided ones.+--+-- A typical example for using the combinators is a bounded 'Encoding' that+-- combines escaping the ' and \\ characters with UTF-8 encoding. More+-- precisely, the escaping to be done is the one implemented by the following+-- @escape@ function.+--+-- > escape :: Char -> [Char]+-- > escape '\'' = "\\'"+-- > escape '\\' = "\\\\"+-- > escape c    = [c]+--+-- The bounded 'Encoding' that combines this escaping with UTF-8 encoding is+-- the following.+--+-- > import Data.ByteString.Lazy.Builder.BasicEncoding.Utf8 (char)+-- >+-- > {-# INLINE escapeChar #-}+-- > escapeUtf8 :: BoundedEncoding Char+-- > escapeUtf8 =+-- >     encodeIf ('\'' ==) (char <#> char #. const ('\\','\'')) $+-- >     encodeIf ('\\' ==) (char <#> char #. const ('\\','\\')) $+-- >     char+--+-- The definition of 'escapeUtf8' is more complicated than 'escape', because+-- the combinators ('encodeIf', 'encodePair', '#.', and 'char') used in+-- 'escapeChar' compute both the bound on the maximal number of bytes written+-- (8 for 'escapeUtf8') as well as the low-level buffer manipulation required+-- to implement the encoding. Bounded 'Encoding's should always be inlined.+-- Otherwise, the compiler cannot compute the bound on the maximal number of+-- bytes written at compile-time. Without inlinining, it would also fail to+-- optimize the constant encoding of the escape characters in the above+-- example. Functions that execute bounded 'Encoding's also perform+-- suboptimally, if the definition of the bounded 'Encoding' is not inlined.+-- Therefore we add an 'INLINE' pragma to 'escapeUtf8'.+--+-- Currently, the only library that executes bounded 'Encoding's is the+-- 'bytestring' library (<http://hackage.haskell.org/package/bytestring>). It+-- uses bounded 'Encoding's to implement most of its lazy bytestring builders.+-- Executing a bounded encoding should be done using the corresponding+-- functions in the lazy bytestring builder 'Extras' module.+--+-- TODO: Merge with explanation/example below+--+-- Bounded 'E.Encoding's abstract encodings of Haskell values that can be implemented by+-- writing a bounded-size sequence of bytes directly to memory. They are+-- lifted to conversions from Haskell values to 'Builder's by wrapping them+-- with a bound-check. The compiler can implement this bound-check very+-- efficiently (i.e, a single comparison of the difference of two pointers to a+-- constant), because the bound of a 'E.Encoding' is always independent of the+-- value being encoded and, in most cases, a literal constant.+--+-- 'E.Encoding's are the primary means for defining conversion functions from+-- primitive Haskell values to 'Builder's. Most 'Builder' constructors+-- provided by this library are implemented that way.+-- 'E.Encoding's are also used to construct conversions that exploit the internal+-- representation of data-structures.+--+-- For example, 'encodeByteStringWith' works directly on the underlying byte+-- array and uses some tricks to reduce the number of variables in its inner+-- loop. Its efficiency is exploited for implementing the @filter@ and @map@+-- functions in "Data.ByteString.Lazy" as+--+-- > import qualified Codec.Bounded.Encoding as E+-- >+-- > filter :: (Word8 -> Bool) -> ByteString -> ByteString+-- > filter p = toLazyByteString . encodeLazyByteStringWithB write+-- >   where+-- >     write = E.encodeIf p E.word8 E.emptyEncoding+-- >+-- > map :: (Word8 -> Word8) -> ByteString -> ByteString+-- > map f = toLazyByteString . encodeLazyByteStringWithB (E.word8 E.#. f)+--+-- Compared to earlier versions of @filter@ and @map@ on lazy 'L.ByteString's,+-- these versions use a more efficient inner loop and have the additional+-- advantage that they always result in well-chunked 'L.ByteString's; i.e, they+-- also perform automatic defragmentation.+--+-- We can also use 'E.Encoding's to improve the efficiency of the following+-- 'renderString' function from our UTF-8 CSV table encoding example in+-- "Data.ByteString.Lazy.Builder".+--+-- > renderString :: String -> Builder+-- > renderString cs = charUtf8 '"' <> foldMap escape cs <> charUtf8 '"'+-- >   where+-- >     escape '\\' = charUtf8 '\\' <> charUtf8 '\\'+-- >     escape '\"' = charUtf8 '\\' <> charUtf8 '\"'+-- >     escape c    = charUtf8 c+--+-- The idea is to save on 'mappend's by implementing a 'E.Encoding' that escapes+-- characters and using 'encodeListWith', which implements writing a list of+-- values with a tighter inner loop and no 'mappend'.+--+-- > import Data.ByteString.Lazy.Builder.Extras     -- assume these three+-- > import Codec.Bounded.Encoding                  -- imports are present+-- >        ( BoundedEncoding, encodeIf, (<#>), (#.) )+-- > import Data.ByteString.Lazy.Builder.BasicEncoding.Utf8 (char)+-- >+-- > renderString :: String -> Builder+-- > renderString cs =+-- >     charUtf8 '"' <> encodeListWithB escapedUtf8 cs <> charUtf8 '"'+-- >   where+-- >     escapedUtf8 :: BoundedEncoding Char+-- >     escapedUtf8 =+-- >       encodeIf (== '\\') (char <#> char #. const ('\\', '\\')) $+-- >       encodeIf (== '\"') (char <#> char #. const ('\\', '\"')) $+-- >       char+--+-- This 'Builder' considers a buffer with less than 8 free bytes as full. As+-- all functions are inlined, the compiler is able to optimize the constant+-- 'E.Encoding's as two sequential 'poke's. Compared to the first implementation of+-- 'renderString' this implementation is 1.7x faster.+--+-}+{-+Internally, 'Builder's are buffer-fill operations that are+given a continuation buffer-fill operation and a buffer-range to be filled.+A 'Builder' first checks if the buffer-range is large enough. If that's+the case, the 'Builder' writes the sequences of bytes to the buffer and+calls its continuation.  Otherwise, it returns a signal that it requires a+new buffer together with a continuation to be called on this new buffer.+Ignoring the rare case of a full buffer-range, the execution cost of a+'Builder' consists of three parts:++  1. The time taken to read the parameters; i.e., the buffer-fill+     operation to call after the 'Builder' is done and the buffer-range to+     fill.++  2. The time taken to check for the size of the buffer-range.++  3. The time taken for the actual encoding.++We can reduce cost (1) by ensuring that fewer buffer-fill function calls are+required. We can reduce cost (2) by fusing buffer-size checks of sequential+writes. For example, when escaping a 'String' using 'renderString', it would+be sufficient to check before encoding a character that at least 8 bytes are+free. We can reduce cost (3) by implementing better primitive 'Builder's.+For example, 'renderCell' builds an intermediate list containing the decimal+representation of an 'Int'. Implementing a direct decimal encoding of 'Int's+to memory would be more efficient, as it requires fewer buffer-size checks+and less allocation. It is also a planned extension of this library.++The first two cost reductions are supported for user code through functions+in "Data.ByteString.Lazy.Builder.Extras". There, we continue the above example+and drop the generation time to 0.8ms by implementing 'renderString' more+cleverly. The third reduction requires meddling with the internals of+'Builder's and is not recomended in code outside of this library. However,+patches to this library are very welcome.+-}+module Data.ByteString.Lazy.Builder.BasicEncoding (++  -- * Fixed-size encodings+    FixedEncoding++  -- ** Combinators+  -- | The combinators for 'FixedEncoding's are implemented such that the 'size'+  -- of the resulting 'FixedEncoding' is computed at compile time.+  , emptyF+  , pairF+  , contramapF++  -- ** Builder construction+  -- | In terms of expressivity, the function 'encodeWithF' would be sufficient+  -- for constructing 'Builder's from 'FixedEncoding's. The fused variants of+  -- this function are provided because they allow for more efficient+  -- implementations. Our compilers are just not smart enough yet; and for some+  -- of the employed optimizations (see the code of 'encodeByteStringWithF')+  -- they will very likely never be.+  --+  -- Note that functions marked with \"/Heavy inlining./\" are forced to be+  -- inlined because they must be specialized for concrete encodings,+  -- but are rather heavy in terms of code size. We recommend to define a+  -- top-level function for every concrete instantiation of such a function in+  -- order to share its code. A typical example is the function+  -- 'byteStringHexFixed' from "Data.ByteString.Lazy.Builder.ASCII", which is+  -- implemented as follows.+  --+  -- @+  -- byteStringHexFixed :: S.ByteString -> Builder+  -- byteStringHexFixed = 'encodeByteStringWithF' 'word8HexFixed'+  -- @+  --+  , encodeWithF+  , encodeListWithF+  , encodeUnfoldrWithF++  , encodeByteStringWithF+  , encodeLazyByteStringWithF++  -- * Bounded-size encodings++  , BoundedEncoding++  -- ** Combinators+  -- | The combinators for 'BoundedEncoding's are implemented such that the+  -- 'sizeBound' of the resulting 'BoundedEncoding' is computed at compile time.+  , fromF+  , emptyB+  , pairB+  , eitherB+  , ifB+  , contramapB++  -- | We provide overloaded operators for some of the above combinators to+  -- allow for a more convenient syntax. We do not export their corresponding,+  -- as we they are used for overloading only and should not be extended by+  -- the user of this library. We plan to use the @contravariant@ library+  -- <http://hackage.haskell.org/package/contravariant> once it is part of the+  -- Haskell platform.+  , (>*<)+  , (>$<)++  -- ** Builder construction+  , encodeWithB+  , encodeListWithB+  , encodeUnfoldrWithB++  , encodeByteStringWithB+  , encodeLazyByteStringWithB++  -- * Standard encodings of Haskell values++  , module Data.ByteString.Lazy.Builder.BasicEncoding.Binary++  -- ** Character encodings+  , module Data.ByteString.Lazy.Builder.BasicEncoding.ASCII++  -- *** ISO/IEC 8859-1 (Char8)+  -- | The ISO/IEC 8859-1 encoding is an 8-bit encoding often known as Latin-1.+  -- The /Char8/ encoding implemented here works by truncating the Unicode+  -- codepoint to 8-bits and encoding them as a single byte. For the codepoints+  -- 0-255 this corresponds to the ISO/IEC 8859-1 encoding. Note that the+  -- Char8 encoding is equivalent to the ASCII encoding on the Unicode+  -- codepoints 0-127. Hence, functions such as 'intDec' can also be used for+  -- encoding 'Int's as a decimal number with Char8 encoded characters.+  , char8++  -- *** UTF-8+  -- | The UTF-8 encoding can encode all Unicode codepoints.+  -- It is equivalent to the ASCII encoding on the Unicode codepoints 0-127.+  -- Hence, functions such as 'intDec' can also be used for encoding 'Int's as+  -- a decimal number with UTF-8 encoded characters.+  , charUtf8++  -- * Testing support+  -- | The following four functions are intended for testing use+  -- only. They are /not/ efficient. Basic encodings are efficently executed by+  -- creating 'Builder's from them using the @encodeXXX@ functions explained at+  -- the top of this module.++  , evalF+  , evalB++  , showF+  , showB++  ) where++import           Data.ByteString.Lazy.Builder.Internal+import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal.UncheckedShifts+import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Base16 (lowerTable, encode4_as_8)++import qualified Data.ByteString               as S+import qualified Data.ByteString.Internal      as S+import qualified Data.ByteString.Lazy.Internal as L++import           Data.Monoid+import           Data.List (unfoldr)  -- HADDOCK ONLY+import           Data.Char (chr, ord)+import           Control.Monad ((<=<), unless)++import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal hiding (size, sizeBound)+import qualified Data.ByteString.Lazy.Builder.BasicEncoding.Internal as I (size, sizeBound)+import           Data.ByteString.Lazy.Builder.BasicEncoding.Binary+import           Data.ByteString.Lazy.Builder.BasicEncoding.ASCII++#if MIN_VERSION_base(4,4,0)+import           Foreign hiding (unsafePerformIO, unsafeForeignPtrToPtr)+import           Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import           System.IO.Unsafe (unsafePerformIO)+#else+import           Foreign+#endif++------------------------------------------------------------------------------+-- Creating Builders from bounded encodings+------------------------------------------------------------------------------++-- | Encode a value with a 'FixedEncoding'.+{-# INLINE encodeWithF #-}+encodeWithF :: FixedEncoding a -> (a -> Builder)+encodeWithF = encodeWithB . toB++-- | Encode a list of values from left-to-right with a 'FixedEncoding'.+{-# INLINE encodeListWithF #-}+encodeListWithF :: FixedEncoding a -> ([a] -> Builder)+encodeListWithF = encodeListWithB . toB++-- | Encode a list of values represented as an 'unfoldr' with a 'FixedEncoding'.+{-# INLINE encodeUnfoldrWithF #-}+encodeUnfoldrWithF :: FixedEncoding b -> (a -> Maybe (b, a)) -> a -> Builder+encodeUnfoldrWithF = encodeUnfoldrWithB . toB++-- | /Heavy inlining./ Encode all bytes of a strict 'S.ByteString' from+-- left-to-right with a 'FixedEncoding'. This function is quite versatile. For+-- example, we can use it to construct a 'Builder' that maps every byte before+-- copying it to the buffer to be filled.+--+-- > mapToBuilder :: (Word8 -> Word8) -> S.ByteString -> Builder+-- > mapToBuilder f = encodeByteStringWithF (contramapF f word8)+--+-- We can also use it to hex-encode a strict 'S.ByteString' as shown by the+-- 'byteStringHexFixed' example above.+{-# INLINE encodeByteStringWithF #-}+encodeByteStringWithF :: FixedEncoding Word8 -> (S.ByteString -> Builder)+encodeByteStringWithF = encodeByteStringWithB . toB++-- | /Heavy inlining./ Encode all bytes of a lazy 'L.ByteString' from+-- left-to-right with a 'FixedEncoding'.+{-# INLINE encodeLazyByteStringWithF #-}+encodeLazyByteStringWithF :: FixedEncoding Word8 -> (L.ByteString -> Builder)+encodeLazyByteStringWithF = encodeLazyByteStringWithB . toB++-- IMPLEMENTATION NOTE: Sadly, 'encodeListWith' cannot be used for foldr/build+-- fusion. Its performance relies on hoisting several variables out of the+-- inner loop.  That's not possible when writing 'encodeListWith' as a 'foldr'.+-- If we had stream fusion for lists, then we could fuse 'encodeListWith', as+-- 'encodeWithStream' can keep control over the execution.+++-- | Create a 'Builder' that encodes values with the given 'Encoding'.+--+-- We rewrite consecutive uses of 'encodeWith' such that the bound-checks are+-- fused. For example,+--+-- > encodeWithB (word32 c1) `mappend` encodeWithB (word32 c2)+--+-- is rewritten such that the resulting 'Builder' checks only once, if ther are+-- at 8 free bytes, instead of checking twice, if there are 4 free bytes. This+-- optimization is not observationally equivalent in a strict sense, as it+-- influences the boundaries of the generated chunks. However, for a user of+-- this library it is observationally equivalent, as chunk boundaries of a lazy+-- 'L.ByteString' can only be observed through the internal interface.+-- Morevoer, we expect that all 'Encoding's write much fewer than 4kb (the+-- default short buffer size). Hence, it is safe to ignore the additional+-- memory spilled due to the more agressive buffer wrapping introduced by this+-- optimization.+--+{-# INLINE[1] encodeWithB #-}+encodeWithB :: BoundedEncoding a -> (a -> Builder)+encodeWithB w =+    mkBuilder+  where+    bound = I.sizeBound w+    mkBuilder x = builder step+      where+        step k (BufferRange op ope)+          | op `plusPtr` bound <= ope = do+              op' <- runB w x op+              let !br' = BufferRange op' ope+              k br'+          | otherwise = return $ bufferFull bound op (step k)++{-# RULES++"append/encodeWithB" forall w1 w2 x1 x2.+       append (encodeWithB w1 x1) (encodeWithB w2 x2)+     = encodeWithB (pairB w1 w2) (x1, x2)++"append/encodeWithB/assoc_r" forall w1 w2 x1 x2 b.+       append (encodeWithB w1 x1) (append (encodeWithB w2 x2) b)+     = append (encodeWithB (pairB w1 w2) (x1, x2)) b++"append/encodeWithB/assoc_l" forall w1 w2 x1 x2 b.+       append (append b (encodeWithB w1 x1)) (encodeWithB w2 x2)+     = append b (encodeWithB (pairB w1 w2) (x1, x2))+  #-}++-- TODO: The same rules for 'putBuilder (..) >> putBuilder (..)'++-- | Create a 'Builder' that encodes a list of values consecutively using an+-- 'Encoding'. This function is more efficient than the canonical+--+-- > filter p =+-- >  B.toLazyByteString .+-- >  E.encodeLazyByteStringWithF (E.ifF p E.word8) E.emptyF)+-- >+--+-- > mconcat . map (encodeWithB w)+--+-- or+--+-- > foldMap (encodeWithB w)+--+-- because it moves several variables out of the inner loop.+{-# INLINE encodeListWithB #-}+encodeListWithB :: BoundedEncoding a -> [a] -> Builder+encodeListWithB w =+    makeBuilder+  where+    bound = I.sizeBound w+    makeBuilder xs0 = builder $ step xs0+      where+        step xs1 k !(BufferRange op0 ope0) = go xs1 op0+          where+            go [] !op = do+               let !br' = BufferRange op ope0+               k br'++            go xs@(x':xs') !op+              | op `plusPtr` bound <= ope0 = do+                  !op' <- runB w x' op+                  go xs' op'+             | otherwise = return $ bufferFull bound op (step xs k)++-- TODO: Add 'foldMap/encodeWith' its variants+-- TODO: Ensure rewriting 'encodeWithB w . f = encodeWithB (w #. f)'++-- | Create a 'Builder' that encodes a sequence generated from a seed value+-- using an 'Encoding'.+{-# INLINE encodeUnfoldrWithB #-}+encodeUnfoldrWithB :: BoundedEncoding b -> (a -> Maybe (b, a)) -> a -> Builder+encodeUnfoldrWithB w =+    makeBuilder+  where+    bound = I.sizeBound w+    makeBuilder f x0 = builder $ step x0+      where+        step x1 !k = fill x1+          where+            fill x !(BufferRange pf0 pe0) = go (f x) pf0+              where+                go !Nothing        !pf = do+                    let !br' = BufferRange pf pe0+                    k br'+                go !(Just (y, x')) !pf+                  | pf `plusPtr` bound <= pe0 = do+                      !pf' <- runB w y pf+                      go (f x') pf'+                  | otherwise = return $ bufferFull bound pf $+                      \(BufferRange pfNew peNew) -> do+                          !pfNew' <- runB w y pfNew+                          fill x' (BufferRange pfNew' peNew)++-- | Create a 'Builder' that encodes each 'Word8' of a strict 'S.ByteString'+-- using an 'Encoding'. For example, we can write a 'Builder' that filters+-- a strict 'S.ByteString' as follows.+--+-- > import Codec.Bounded.Encoding as E (encodeIf, word8, encodeNothing)+--+-- > filterBS p = E.encodeIf p E.word8 E.encodeNothing+--+{-# INLINE encodeByteStringWithB #-}+encodeByteStringWithB :: BoundedEncoding Word8 -> S.ByteString -> Builder+encodeByteStringWithB w =+    \bs -> builder $ step bs+  where+    bound = I.sizeBound w+    step (S.PS ifp ioff isize) !k =+        goBS (unsafeForeignPtrToPtr ifp `plusPtr` ioff)+      where+        !ipe = unsafeForeignPtrToPtr ifp `plusPtr` (ioff + isize)+        goBS !ip0 !br@(BufferRange op0 ope)+          | ip0 >= ipe = do+              touchForeignPtr ifp -- input buffer consumed+              k br++          | op0 `plusPtr` bound < ope =+              goPartial (ip0 `plusPtr` min outRemaining inpRemaining)++          | otherwise  = return $ bufferFull bound op0 (goBS ip0)+          where+            outRemaining = (ope `minusPtr` op0) `div` bound+            inpRemaining = ipe `minusPtr` ip0++            goPartial !ipeTmp = go ip0 op0+              where+                go !ip !op+                  | ip < ipeTmp = do+                      x   <- peek ip+                      op' <- runB w x op+                      go (ip `plusPtr` 1) op'+                  | otherwise =+                      goBS ip (BufferRange op ope)++-- | Chunk-wise application of 'encodeByteStringWith'.+{-# INLINE encodeLazyByteStringWithB #-}+encodeLazyByteStringWithB :: BoundedEncoding Word8 -> L.ByteString -> Builder+encodeLazyByteStringWithB w =+    L.foldrChunks (\x b -> encodeByteStringWithB w x `mappend` b) mempty+++------------------------------------------------------------------------------+-- Char8 encoding+------------------------------------------------------------------------------++-- | Char8 encode a 'Char'.+{-# INLINE char8 #-}+char8 :: FixedEncoding Char+char8 = (fromIntegral . ord) >$< word8+++------------------------------------------------------------------------------+-- UTF-8 encoding+------------------------------------------------------------------------------++-- | UTF-8 encode a 'Char'.+{-# INLINE charUtf8 #-}+charUtf8 :: BoundedEncoding Char+charUtf8 = boundedEncoding 4 (encodeCharUtf8 f1 f2 f3 f4)+  where+    pokeN n io op  = io op >> return (op `plusPtr` n)++    f1 x1          = pokeN 1 $ \op -> do pokeByteOff op 0 x1++    f2 x1 x2       = pokeN 2 $ \op -> do pokeByteOff op 0 x1+                                         pokeByteOff op 1 x2++    f3 x1 x2 x3    = pokeN 3 $ \op -> do pokeByteOff op 0 x1+                                         pokeByteOff op 1 x2+                                         pokeByteOff op 2 x3++    f4 x1 x2 x3 x4 = pokeN 4 $ \op -> do pokeByteOff op 0 x1+                                         pokeByteOff op 1 x2+                                         pokeByteOff op 2 x3+                                         pokeByteOff op 3 x4++-- | Encode a Unicode character to another datatype, using UTF-8. This function+-- acts as an abstract way of encoding characters, as it is unaware of what+-- needs to happen with the resulting bytes: you have to specify functions to+-- deal with those.+--+{-# INLINE encodeCharUtf8 #-}+encodeCharUtf8 :: (Word8 -> a)                             -- ^ 1-byte UTF-8+               -> (Word8 -> Word8 -> a)                    -- ^ 2-byte UTF-8+               -> (Word8 -> Word8 -> Word8 -> a)           -- ^ 3-byte UTF-8+               -> (Word8 -> Word8 -> Word8 -> Word8 -> a)  -- ^ 4-byte UTF-8+               -> Char                                     -- ^ Input 'Char'+               -> a                                        -- ^ Result+encodeCharUtf8 f1 f2 f3 f4 c = case ord c of+    x | x <= 0x7F -> f1 $ fromIntegral x+      | x <= 0x07FF ->+           let x1 = fromIntegral $ (x `shiftR` 6) + 0xC0+               x2 = fromIntegral $ (x .&. 0x3F)   + 0x80+           in f2 x1 x2+      | x <= 0xFFFF ->+           let x1 = fromIntegral $ (x `shiftR` 12) + 0xE0+               x2 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80+               x3 = fromIntegral $ (x .&. 0x3F) + 0x80+           in f3 x1 x2 x3+      | otherwise ->+           let x1 = fromIntegral $ (x `shiftR` 18) + 0xF0+               x2 = fromIntegral $ ((x `shiftR` 12) .&. 0x3F) + 0x80+               x3 = fromIntegral $ ((x `shiftR` 6) .&. 0x3F) + 0x80+               x4 = fromIntegral $ (x .&. 0x3F) + 0x80+           in f4 x1 x2 x3 x4+++------------------------------------------------------------------------------+-- Testing encodings+------------------------------------------------------------------------------++-- | /For testing use only./ Evaluate a 'FixedEncoding' on a given value.+evalF :: FixedEncoding a -> a -> [Word8]+evalF fe = S.unpack . S.unsafeCreate (I.size fe) . runF fe++-- | /For testing use only./ Evaluate a 'BoundedEncoding' on a given value.+evalB :: BoundedEncoding a -> a -> [Word8]+evalB be x = S.unpack $ unsafePerformIO $+    S.createAndTrim (I.sizeBound be) $ \op -> do+        op' <- runB be x op+        return (op' `minusPtr` op)++-- | /For testing use only./ Show the result of a 'FixedEncoding' of a given+-- value as a 'String' by interpreting the resulting bytes as Unicode+-- codepoints.+showF :: FixedEncoding a -> a -> String+showF fe = map (chr . fromIntegral) . evalF fe++-- | /For testing use only./ Show the result of a 'BoundedEncoding' of a given+-- value as a 'String' by interpreting the resulting bytes as Unicode+-- codepoints.+showB :: BoundedEncoding a -> a -> String+showB be = map (chr . fromIntegral) . evalB be++
+ Data/ByteString/Lazy/Builder/BasicEncoding/ASCII.hs view
@@ -0,0 +1,287 @@+{-# LANGUAGE ScopedTypeVariables, CPP, ForeignFunctionInterface #-}+-- | Copyright   : (c) 2010 Jasper Van der Jeugt+--                 (c) 2010 - 2011 Simon Meier+-- License       : BSD3-style (see LICENSE)+--+-- Maintainer    : Simon Meier <iridcode@gmail.com>+-- Portability   : GHC+--+-- Encodings using ASCII encoded Unicode characters.+--+module Data.ByteString.Lazy.Builder.BasicEncoding.ASCII+    (++     -- *** ASCII+     char7++      -- **** Decimal numbers+      -- | Decimal encoding of numbers using ASCII encoded characters.+    , int8Dec+    , int16Dec+    , int32Dec+    , int64Dec+    , intDec++    , word8Dec+    , word16Dec+    , word32Dec+    , word64Dec+    , wordDec++    {-+    -- These are the functions currently provided by Bryan O'Sullivans+    -- double-conversion library.+    --+    -- , float+    -- , floatWith+    -- , double+    -- , doubleWith+    -}++      -- **** Hexadecimal numbers++      -- | Encoding positive integers as hexadecimal numbers using lower-case+      -- ASCII characters. The shortest possible representation is used. For+      -- example,+      --+      -- > showB word16Hex 0x0a10 = "a10"+      --+      -- Note that there is no support for using upper-case characters. Please+      -- contact the maintainer if your application cannot work without+      -- hexadecimal encodings that use upper-case characters.+      --+    , word8Hex+    , word16Hex+    , word32Hex+    , word64Hex+    , wordHex++      -- **** Fixed-width hexadecimal numbers+      --+      -- | Encoding the bytes of fixed-width types as hexadecimal+      -- numbers using lower-case ASCII characters. For example,+      --+      -- > showF word16HexFixed 0x0a10 = "0a10"+      --+    , int8HexFixed+    , int16HexFixed+    , int32HexFixed+    , int64HexFixed+    , word8HexFixed+    , word16HexFixed+    , word32HexFixed+    , word64HexFixed+    , floatHexFixed+    , doubleHexFixed++    ) where++import Data.ByteString.Lazy.Builder.BasicEncoding.Binary+import Data.ByteString.Lazy.Builder.BasicEncoding.Internal+import Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Floating+import Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Base16+import Data.ByteString.Lazy.Builder.BasicEncoding.Internal.UncheckedShifts++import Data.Char (ord)++import Foreign+import Foreign.C.Types++-- | Encode the least 7-bits of a 'Char' using the ASCII encoding.+{-# INLINE char7 #-}+char7 :: FixedEncoding Char+char7 = (\c -> fromIntegral $ ord c .&. 0x7f) >$< word8+++------------------------------------------------------------------------------+-- Decimal Encoding+------------------------------------------------------------------------------++-- Signed integers+------------------++foreign import ccall unsafe "static _hs_bytestring_int_dec" c_int_dec+    :: CInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_long_long_int_dec" c_long_long_int_dec+    :: CLLong -> Ptr Word8 -> IO (Ptr Word8)++{-# INLINE encodeIntDecimal #-}+encodeIntDecimal :: Integral a => Int -> BoundedEncoding a+encodeIntDecimal bound = boundedEncoding bound $ c_int_dec . fromIntegral++-- | Decimal encoding of an 'Int8'.+{-# INLINE int8Dec #-}+int8Dec :: BoundedEncoding Int8+int8Dec = encodeIntDecimal 4++-- | Decimal encoding of an 'Int16'.+{-# INLINE int16Dec #-}+int16Dec :: BoundedEncoding Int16+int16Dec = encodeIntDecimal 6+++-- | Decimal encoding of an 'Int32'.+{-# INLINE int32Dec #-}+int32Dec :: BoundedEncoding Int32+int32Dec = encodeIntDecimal 11++-- | Decimal encoding of an 'Int64'.+{-# INLINE int64Dec #-}+int64Dec :: BoundedEncoding Int64+int64Dec = boundedEncoding 20 $ c_long_long_int_dec . fromIntegral++-- | Decimal encoding of an 'Int'.+{-# INLINE intDec #-}+intDec :: BoundedEncoding Int+intDec = caseWordSize_32_64+    (fromIntegral >$< int32Dec)+    (fromIntegral >$< int64Dec)+++-- Unsigned integers+--------------------++foreign import ccall unsafe "static _hs_bytestring_uint_dec" c_uint_dec+    :: CUInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_long_long_uint_dec" c_long_long_uint_dec+    :: CULLong -> Ptr Word8 -> IO (Ptr Word8)++{-# INLINE encodeWordDecimal #-}+encodeWordDecimal :: Integral a => Int -> BoundedEncoding a+encodeWordDecimal bound = boundedEncoding bound $ c_uint_dec . fromIntegral++-- | Decimal encoding of a 'Word8'.+{-# INLINE word8Dec #-}+word8Dec :: BoundedEncoding Word8+word8Dec = encodeWordDecimal 3++-- | Decimal encoding of a 'Word16'.+{-# INLINE word16Dec #-}+word16Dec :: BoundedEncoding Word16+word16Dec = encodeWordDecimal 5++-- | Decimal encoding of a 'Word32'.+{-# INLINE word32Dec #-}+word32Dec :: BoundedEncoding Word32+word32Dec = encodeWordDecimal 10++-- | Decimal encoding of a 'Word64'.+{-# INLINE word64Dec #-}+word64Dec :: BoundedEncoding Word64+word64Dec = boundedEncoding 20 $ c_long_long_uint_dec . fromIntegral++-- | Decimal encoding of a 'Word'.+{-# INLINE wordDec #-}+wordDec :: BoundedEncoding Word+wordDec = caseWordSize_32_64+    (fromIntegral >$< word32Dec)+    (fromIntegral >$< word64Dec)++------------------------------------------------------------------------------+-- Hexadecimal Encoding+------------------------------------------------------------------------------++-- without lead+---------------++foreign import ccall unsafe "static _hs_bytestring_uint_hex" c_uint_hex+    :: CUInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_long_long_uint_hex" c_long_long_uint_hex+    :: CULLong -> Ptr Word8 -> IO (Ptr Word8)++{-# INLINE encodeWordHex #-}+encodeWordHex :: forall a. (Storable a, Integral a) => BoundedEncoding a+encodeWordHex =+    boundedEncoding (2 * sizeOf (undefined :: a)) $ c_uint_hex  . fromIntegral++-- | Hexadecimal encoding of a 'Word8'.+{-# INLINE word8Hex #-}+word8Hex :: BoundedEncoding Word8+word8Hex = encodeWordHex++-- | Hexadecimal encoding of a 'Word16'.+{-# INLINE word16Hex #-}+word16Hex :: BoundedEncoding Word16+word16Hex = encodeWordHex++-- | Hexadecimal encoding of a 'Word32'.+{-# INLINE word32Hex #-}+word32Hex :: BoundedEncoding Word32+word32Hex = encodeWordHex++-- | Hexadecimal encoding of a 'Word64'.+{-# INLINE word64Hex #-}+word64Hex :: BoundedEncoding Word64+word64Hex = boundedEncoding 16 $ c_long_long_uint_hex . fromIntegral++-- | Hexadecimal encoding of a 'Word'.+{-# INLINE wordHex #-}+wordHex :: BoundedEncoding Word+wordHex = caseWordSize_32_64+    (fromIntegral >$< word32Hex)+    (fromIntegral >$< word64Hex)+++-- fixed width; leading zeroes+------------------------------++-- | Encode a 'Word8' using 2 nibbles (hexadecimal digits).+{-# INLINE word8HexFixed #-}+word8HexFixed :: FixedEncoding Word8+word8HexFixed = fixedEncoding 2 $+    \x op -> poke (castPtr op) =<< encode8_as_16h lowerTable x++-- | Encode a 'Word16' using 4 nibbles.+{-# INLINE word16HexFixed #-}+word16HexFixed :: FixedEncoding Word16+word16HexFixed =+    (\x -> (fromIntegral $ x `shiftr_w16` 8, fromIntegral x))+      >$< pairF word8HexFixed word8HexFixed++-- | Encode a 'Word32' using 8 nibbles.+{-# INLINE word32HexFixed #-}+word32HexFixed :: FixedEncoding Word32+word32HexFixed =+    (\x -> (fromIntegral $ x `shiftr_w32` 16, fromIntegral x))+      >$< pairF word16HexFixed word16HexFixed+-- | Encode a 'Word64' using 16 nibbles.+{-# INLINE word64HexFixed #-}+word64HexFixed :: FixedEncoding Word64+word64HexFixed =+    (\x -> (fromIntegral $ x `shiftr_w64` 32, fromIntegral x))+      >$< pairF word32HexFixed word32HexFixed++-- | Encode a 'Int8' using 2 nibbles (hexadecimal digits).+{-# INLINE int8HexFixed #-}+int8HexFixed :: FixedEncoding Int8+int8HexFixed = fromIntegral >$< word8HexFixed++-- | Encode a 'Int16' using 4 nibbles.+{-# INLINE int16HexFixed #-}+int16HexFixed :: FixedEncoding Int16+int16HexFixed = fromIntegral >$< word16HexFixed++-- | Encode a 'Int32' using 8 nibbles.+{-# INLINE int32HexFixed #-}+int32HexFixed :: FixedEncoding Int32+int32HexFixed = fromIntegral >$< word32HexFixed++-- | Encode a 'Int64' using 16 nibbles.+{-# INLINE int64HexFixed #-}+int64HexFixed :: FixedEncoding Int64+int64HexFixed = fromIntegral >$< word64HexFixed++-- | Encode an IEEE 'Float' using 8 nibbles.+{-# INLINE floatHexFixed #-}+floatHexFixed :: FixedEncoding Float+floatHexFixed = encodeFloatViaWord32F word32HexFixed++-- | Encode an IEEE 'Double' using 16 nibbles.+{-# INLINE doubleHexFixed #-}+doubleHexFixed :: FixedEncoding Double+doubleHexFixed = encodeDoubleViaWord64F word64HexFixed++
+ Data/ByteString/Lazy/Builder/BasicEncoding/Binary.hs view
@@ -0,0 +1,336 @@+{-# LANGUAGE CPP, BangPatterns #-}+-- | Copyright   : (c) 2010-2011 Simon Meier+-- License       : BSD3-style (see LICENSE)+--+-- Maintainer    : Simon Meier <iridcode@gmail.com>+-- Portability   : GHC+--+module Data.ByteString.Lazy.Builder.BasicEncoding.Binary (++  -- ** Binary encodings+    int8+  , word8++  -- *** Big-endian+  , int16BE+  , int32BE+  , int64BE++  , word16BE+  , word32BE+  , word64BE++  , floatBE+  , doubleBE++  -- *** Little-endian+  , int16LE+  , int32LE+  , int64LE++  , word16LE+  , word32LE+  , word64LE++  , floatLE+  , doubleLE++  -- *** Non-portable, host-dependent+  , intHost+  , int16Host+  , int32Host+  , int64Host++  , wordHost+  , word16Host+  , word32Host+  , word64Host++  , floatHost+  , doubleHost++  ) where++import Data.ByteString.Lazy.Builder.BasicEncoding.Internal+import Data.ByteString.Lazy.Builder.BasicEncoding.Internal.UncheckedShifts+import Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Floating++import Foreign++#include "MachDeps.h"++------------------------------------------------------------------------------+-- Binary encoding+------------------------------------------------------------------------------++-- Word encodings+-----------------++-- | Encoding single unsigned bytes as-is.+--+{-# INLINE word8 #-}+word8 :: FixedEncoding Word8+word8 = storableToF++--+-- We rely on the fromIntegral to do the right masking for us.+-- The inlining here is critical, and can be worth 4x performance+--++-- | Encoding 'Word16's in big endian format.+{-# INLINE word16BE #-}+word16BE :: FixedEncoding Word16+#ifdef WORD_BIGENDIAN+word16BE = word16Host+#else+word16BE = fixedEncoding 2 $ \w p -> do+    poke p               (fromIntegral (shiftr_w16 w 8) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (w)              :: Word8)+#endif++-- | Encoding 'Word16's in little endian format.+{-# INLINE word16LE #-}+word16LE :: FixedEncoding Word16+#ifdef WORD_BIGENDIAN+word16LE = fixedEncoding 2 $ \w p -> do+    poke p               (fromIntegral (w)              :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w16 w 8) :: Word8)+#else+word16LE = word16Host+#endif++-- | Encoding 'Word32's in big endian format.+{-# INLINE word32BE #-}+word32BE :: FixedEncoding Word32+#ifdef WORD_BIGENDIAN+word32BE = word32Host+#else+word32BE = fixedEncoding 4 $ \w p -> do+    poke p               (fromIntegral (shiftr_w32 w 24) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w 16) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w  8) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (w)               :: Word8)+#endif++-- | Encoding 'Word32's in little endian format.+{-# INLINE word32LE #-}+word32LE :: FixedEncoding Word32+#ifdef WORD_BIGENDIAN+word32LE = fixedEncoding 4 $ \w p -> do+    poke p               (fromIntegral (w)               :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w  8) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w 16) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 w 24) :: Word8)+#else+word32LE = word32Host+#endif++-- on a little endian machine:+-- word32LE w32 = fixedEncoding 4 (\w p -> poke (castPtr p) w32)++-- | Encoding 'Word64's in big endian format.+{-# INLINE word64BE #-}+word64BE :: FixedEncoding Word64+#ifdef WORD_BIGENDIAN+word64BE = word64Host+#else+#if WORD_SIZE_IN_BITS < 64+--+-- To avoid expensive 64 bit shifts on 32 bit machines, we cast to+-- Word32, and write that+--+word64BE =+    fixedEncoding 8 $ \w p -> do+        let a = fromIntegral (shiftr_w64 w 32) :: Word32+            b = fromIntegral w                 :: Word32+        poke p               (fromIntegral (shiftr_w32 a 24) :: Word8)+        poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 16) :: Word8)+        poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a  8) :: Word8)+        poke (p `plusPtr` 3) (fromIntegral (a)               :: Word8)+        poke (p `plusPtr` 4) (fromIntegral (shiftr_w32 b 24) :: Word8)+        poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 16) :: Word8)+        poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b  8) :: Word8)+        poke (p `plusPtr` 7) (fromIntegral (b)               :: Word8)+#else+word64BE = fixedEncoding 8 $ \w p -> do+    poke p               (fromIntegral (shiftr_w64 w 56) :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w 48) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 40) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 32) :: Word8)+    poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 24) :: Word8)+    poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 16) :: Word8)+    poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w  8) :: Word8)+    poke (p `plusPtr` 7) (fromIntegral (w)               :: Word8)+#endif+#endif++-- | Encoding 'Word64's in little endian format.+{-# INLINE word64LE #-}+word64LE :: FixedEncoding Word64+#ifdef WORD_BIGENDIAN+#if WORD_SIZE_IN_BITS < 64+word64LE =+    fixedEncoding 8 $ \w p -> do+        let b = fromIntegral (shiftr_w64 w 32) :: Word32+            a = fromIntegral w                 :: Word32+        poke (p)             (fromIntegral (a)               :: Word8)+        poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a  8) :: Word8)+        poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 16) :: Word8)+        poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 a 24) :: Word8)+        poke (p `plusPtr` 4) (fromIntegral (b)               :: Word8)+        poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b  8) :: Word8)+        poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 16) :: Word8)+        poke (p `plusPtr` 7) (fromIntegral (shiftr_w32 b 24) :: Word8)+#else+word64LE = fixedEncoding 8 $ \w p -> do+    poke p               (fromIntegral (w)               :: Word8)+    poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w  8) :: Word8)+    poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 16) :: Word8)+    poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 24) :: Word8)+    poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 32) :: Word8)+    poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 40) :: Word8)+    poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w 48) :: Word8)+    poke (p `plusPtr` 7) (fromIntegral (shiftr_w64 w 56) :: Word8)+#endif+#else+word64LE = word64Host+#endif+++-- | Encode a single native machine 'Word'. The 'Word's is encoded in host order,+-- host endian form, for the machine you are on. On a 64 bit machine the 'Word'+-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values encoded this way+-- are not portable to different endian or word sized machines, without+-- conversion.+--+{-# INLINE wordHost #-}+wordHost :: FixedEncoding Word+wordHost = storableToF++-- | Encoding 'Word16's in native host order and host endianness.+{-# INLINE word16Host #-}+word16Host :: FixedEncoding Word16+word16Host = storableToF++-- | Encoding 'Word32's in native host order and host endianness.+{-# INLINE word32Host #-}+word32Host :: FixedEncoding Word32+word32Host = storableToF++-- | Encoding 'Word64's in native host order and host endianness.+{-# INLINE word64Host #-}+word64Host :: FixedEncoding Word64+word64Host = storableToF+++------------------------------------------------------------------------------+-- Int encodings+------------------------------------------------------------------------------+--+-- We rely on 'fromIntegral' to do a loss-less conversion to the corresponding+-- 'Word' type+--+------------------------------------------------------------------------------++-- | Encoding single signed bytes as-is.+--+{-# INLINE int8 #-}+int8 :: FixedEncoding Int8+int8 = fromIntegral >$< word8++-- | Encoding 'Int16's in big endian format.+{-# INLINE int16BE #-}+int16BE :: FixedEncoding Int16+int16BE = fromIntegral >$< word16BE++-- | Encoding 'Int16's in little endian format.+{-# INLINE int16LE #-}+int16LE :: FixedEncoding Int16+int16LE = fromIntegral >$< word16LE++-- | Encoding 'Int32's in big endian format.+{-# INLINE int32BE #-}+int32BE :: FixedEncoding Int32+int32BE = fromIntegral >$< word32BE++-- | Encoding 'Int32's in little endian format.+{-# INLINE int32LE #-}+int32LE :: FixedEncoding Int32+int32LE = fromIntegral >$< word32LE++-- | Encoding 'Int64's in big endian format.+{-# INLINE int64BE #-}+int64BE :: FixedEncoding Int64+int64BE = fromIntegral >$< word64BE++-- | Encoding 'Int64's in little endian format.+{-# INLINE int64LE #-}+int64LE :: FixedEncoding Int64+int64LE = fromIntegral >$< word64LE+++-- TODO: Ensure that they are safe on architectures where an unaligned write is+-- an error.++-- | Encode a single native machine 'Int'. The 'Int's is encoded in host order,+-- host endian form, for the machine you are on. On a 64 bit machine the 'Int'+-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values encoded this way+-- are not portable to different endian or integer sized machines, without+-- conversion.+--+{-# INLINE intHost #-}+intHost :: FixedEncoding Int+intHost = storableToF++-- | Encoding 'Int16's in native host order and host endianness.+{-# INLINE int16Host #-}+int16Host :: FixedEncoding Int16+int16Host = storableToF++-- | Encoding 'Int32's in native host order and host endianness.+{-# INLINE int32Host #-}+int32Host :: FixedEncoding Int32+int32Host = storableToF++-- | Encoding 'Int64's in native host order and host endianness.+{-# INLINE int64Host #-}+int64Host :: FixedEncoding Int64+int64Host = storableToF++-- IEEE Floating Point Numbers+------------------------------++-- | Encode a 'Float' in big endian format.+{-# INLINE floatBE #-}+floatBE :: FixedEncoding Float+floatBE = encodeFloatViaWord32F word32BE++-- | Encode a 'Float' in little endian format.+{-# INLINE floatLE #-}+floatLE :: FixedEncoding Float+floatLE = encodeFloatViaWord32F word32LE++-- | Encode a 'Double' in big endian format.+{-# INLINE doubleBE #-}+doubleBE :: FixedEncoding Double+doubleBE = encodeDoubleViaWord64F word64BE++-- | Encode a 'Double' in little endian format.+{-# INLINE doubleLE #-}+doubleLE :: FixedEncoding Double+doubleLE = encodeDoubleViaWord64F word64LE+++-- | Encode a 'Float' in native host order and host endianness. Values written+-- this way are not portable to different endian machines, without conversion.+--+{-# INLINE floatHost #-}+floatHost :: FixedEncoding Float+floatHost = storableToF++-- | Encode a 'Double' in native host order and host endianness.+{-# INLINE doubleHost #-}+doubleHost :: FixedEncoding Double+doubleHost = storableToF++
+ Data/ByteString/Lazy/Builder/BasicEncoding/Extras.hs view
@@ -0,0 +1,890 @@+{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_HADDOCK hide #-}+{- | Copyright : (c) 2010-2011 Simon Meier+License        : BSD3-style (see LICENSE)++Maintainer     : Simon Meier <iridcode@gmail.com>+Stability      : experimental+Portability    : GHC++An /encoding/ is a conversion function of Haskell values to sequences of bytes.+A /fixed(-size) encoding/ is an encoding that always results in sequence of bytes+  of a pre-determined, fixed length.+An example for a fixed encoding is the big-endian encoding of a 'Word64',+  which always results in exactly 8 bytes.+A /bounded(-size) encoding/ is an encoding that always results in sequence+  of bytes that is no larger than a pre-determined bound.+An example for a bounded encoding is the UTF-8 encoding of a 'Char',+  which results always in less or equal to 4 bytes.+Note that every fixed encoding is also a bounded encoding.+We explicitly identify fixed encodings because they allow some optimizations+  that are impossible with bounded encodings.+In the following,+  we first motivate the use of bounded encodings+  and then give examples of optimizations+  that are only possible with fixed encodings.++Typicall, encodings are implemented efficiently by allocating a buffer+  (a mutable array of bytes)+  and repeatedly executing the following two steps:+  (1) writing to the buffer until it is full and+  (2) handing over the filled part to the consumer of the encoded value.+Step (1) is where bounded encodings are used.+We must use a bounded encoding,+  as we must check that there is enough free space+  /before/ actually writing to the buffer.++In term of expressivity,+  it would be sufficient to construct all encodings+  from the single fixed encoding that encodes a 'Word8' as-is.+However,+  this is not sufficient in terms of efficiency.+It results in unnecessary buffer-full checks and+  it complicates the program-flow for writing to the buffer,+  as buffer-full checks are interleaved with analyzing the value to be+  encoded (e.g., think about the program-flow for UTF-8 encoding).+This has a significant effect on overall encoding performance,+  as encoding primitive Haskell values such as 'Word8's or 'Char's+  lies at the heart of every encoding implementation.++The 'BoundedEncoding's provided by this module remove this performance problem.+Intuitively,+  they consist of a tuple of the bound on the maximal number of bytes written+  and the actual implementation of the encoding as+  a function that modifies a mutable buffer.+Hence when executing a 'BoundedEncoding',+ the buffer-full check can be done once before the actual writing to the buffer.+The provided 'BoundedEncoding's also take care to implement the+  actual writing to the buffer efficiently.+Moreover, combinators are provided to construct new bounded encodings+  from the provided ones.++++The result of an encoding can be consumed efficiently,+  if it is represented as a sequence of large enough+  /chunks/ of consecutive memory (i.e., C @char@ arrays).+The precise meaning of /large enough/ is application dependent.+Typically, an average chunk size between 4kb and 32kb is suitable+  for writing the result to disk or sending it over the network.+We desire large enough chunk sizes because each chunk boundary+  incurs extra work that we must be able to amortize.+++The need for fixed-size encodings arises when considering+  the efficient implementation of encodings that require the encoding of a+  value to be prefixed with the size of the resulting sequence of bytes.+An efficient implementation avoids unnecessary buffer+We can implement this efficiently as follows.+We first reserve the space for the encoding of the size.+Then, we encode the value.+Finally, we encode the size of the resulting sequence of bytes into+  the reserved space.+For this to work++This works only if the encoding resulting size fits++by first, reserving the space for the encoding+  of the size, then performing the++For efficiency,+  we want to avoid unnecessary copying.+++For example, the HTTP/1.0 requires the size of the body to be given in+  the Content-Length field.++chunked-transfer encoding requires each chunk to+  be prefixed with the hexadecimal encoding of the chunk size.+++-}++{-+--+--+-- A /bounded encoding/ is an encoding that never results in a sequence+-- longer than some fixed number of bytes. This number of bytes must be+-- independent of the value being encoded. Typical examples of bounded+-- encodings are the big-endian encoding of a 'Word64', which results always+-- in exactly 8 bytes, or the UTF-8 encoding of a 'Char', which results always+-- in less or equal to 4 bytes.+--+-- Typically, encodings are implemented efficiently by allocating a buffer (an+-- array of bytes) and repeatedly executing the following two steps: (1)+-- writing to the buffer until it is full and (2) handing over the filled part+-- to the consumer of the encoded value. Step (1) is where bounded encodings+-- are used. We must use a bounded encoding, as we must check that there is+-- enough free space /before/ actually writing to the buffer.+--+-- In term of expressivity, it would be sufficient to construct all encodings+-- from the single bounded encoding that encodes a 'Word8' as-is. However,+-- this is not sufficient in terms of efficiency. It results in unnecessary+-- buffer-full checks and it complicates the program-flow for writing to the+-- buffer, as buffer-full checks are interleaved with analyzing the value to be+-- encoded (e.g., think about the program-flow for UTF-8 encoding). This has a+-- significant effect on overall encoding performance, as encoding primitive+-- Haskell values such as 'Word8's or 'Char's lies at the heart of every+-- encoding implementation.+--+-- The bounded 'Encoding's provided by this module remove this performance+-- problem. Intuitively, they consist of a tuple of the bound on the maximal+-- number of bytes written and the actual implementation of the encoding as a+-- function that modifies a mutable buffer. Hence when executing a bounded+-- 'Encoding', the buffer-full check can be done once before the actual writing+-- to the buffer. The provided 'Encoding's also take care to implement the+-- actual writing to the buffer efficiently. Moreover, combinators are+-- provided to construct new bounded encodings from the provided ones.+--+-- A typical example for using the combinators is a bounded 'Encoding' that+-- combines escaping the ' and \\ characters with UTF-8 encoding. More+-- precisely, the escaping to be done is the one implemented by the following+-- @escape@ function.+--+-- > escape :: Char -> [Char]+-- > escape '\'' = "\\'"+-- > escape '\\' = "\\\\"+-- > escape c    = [c]+--+-- The bounded 'Encoding' that combines this escaping with UTF-8 encoding is+-- the following.+--+-- > import Data.ByteString.Lazy.Builder.BasicEncoding.Utf8 (char)+-- >+-- > {-# INLINE escapeChar #-}+-- > escapeUtf8 :: BoundedEncoding Char+-- > escapeUtf8 =+-- >     encodeIf ('\'' ==) (char <#> char #. const ('\\','\'')) $+-- >     encodeIf ('\\' ==) (char <#> char #. const ('\\','\\')) $+-- >     char+--+-- The definition of 'escapeUtf8' is more complicated than 'escape', because+-- the combinators ('encodeIf', 'encodePair', '#.', and 'char') used in+-- 'escapeChar' compute both the bound on the maximal number of bytes written+-- (8 for 'escapeUtf8') as well as the low-level buffer manipulation required+-- to implement the encoding. Bounded 'Encoding's should always be inlined.+-- Otherwise, the compiler cannot compute the bound on the maximal number of+-- bytes written at compile-time. Without inlinining, it would also fail to+-- optimize the constant encoding of the escape characters in the above+-- example. Functions that execute bounded 'Encoding's also perform+-- suboptimally, if the definition of the bounded 'Encoding' is not inlined.+-- Therefore we add an 'INLINE' pragma to 'escapeUtf8'.+--+-- Currently, the only library that executes bounded 'Encoding's is the+-- 'bytestring' library (<http://hackage.haskell.org/package/bytestring>). It+-- uses bounded 'Encoding's to implement most of its lazy bytestring builders.+-- Executing a bounded encoding should be done using the corresponding+-- functions in the lazy bytestring builder 'Extras' module.+--+-- TODO: Merge with explanation/example below+--+-- Bounded 'E.Encoding's abstract encodings of Haskell values that can be implemented by+-- writing a bounded-size sequence of bytes directly to memory. They are+-- lifted to conversions from Haskell values to 'Builder's by wrapping them+-- with a bound-check. The compiler can implement this bound-check very+-- efficiently (i.e, a single comparison of the difference of two pointers to a+-- constant), because the bound of a 'E.Encoding' is always independent of the+-- value being encoded and, in most cases, a literal constant.+--+-- 'E.Encoding's are the primary means for defining conversion functions from+-- primitive Haskell values to 'Builder's. Most 'Builder' constructors+-- provided by this library are implemented that way.+-- 'E.Encoding's are also used to construct conversions that exploit the internal+-- representation of data-structures.+--+-- For example, 'encodeByteStringWith' works directly on the underlying byte+-- array and uses some tricks to reduce the number of variables in its inner+-- loop. Its efficiency is exploited for implementing the @filter@ and @map@+-- functions in "Data.ByteString.Lazy" as+--+-- > import qualified Codec.Bounded.Encoding as E+-- >+-- > filter :: (Word8 -> Bool) -> ByteString -> ByteString+-- > filter p = toLazyByteString . encodeLazyByteStringWithB write+-- >   where+-- >     write = E.encodeIf p E.word8 E.emptyEncoding+-- >+-- > map :: (Word8 -> Word8) -> ByteString -> ByteString+-- > map f = toLazyByteString . encodeLazyByteStringWithB (E.word8 E.#. f)+--+-- Compared to earlier versions of @filter@ and @map@ on lazy 'L.ByteString's,+-- these versions use a more efficient inner loop and have the additional+-- advantage that they always result in well-chunked 'L.ByteString's; i.e, they+-- also perform automatic defragmentation.+--+-- We can also use 'E.Encoding's to improve the efficiency of the following+-- 'renderString' function from our UTF-8 CSV table encoding example in+-- "Data.ByteString.Lazy.Builder".+--+-- > renderString :: String -> Builder+-- > renderString cs = charUtf8 '"' <> foldMap escape cs <> charUtf8 '"'+-- >   where+-- >     escape '\\' = charUtf8 '\\' <> charUtf8 '\\'+-- >     escape '\"' = charUtf8 '\\' <> charUtf8 '\"'+-- >     escape c    = charUtf8 c+--+-- The idea is to save on 'mappend's by implementing a 'E.Encoding' that escapes+-- characters and using 'encodeListWith', which implements writing a list of+-- values with a tighter inner loop and no 'mappend'.+--+-- > import Data.ByteString.Lazy.Builder.Extras     -- assume these three+-- > import Codec.Bounded.Encoding                  -- imports are present+-- >        ( BoundedEncoding, encodeIf, (<#>), (#.) )+-- > import Data.ByteString.Lazy.Builder.BasicEncoding.Utf8 (char)+-- >+-- > renderString :: String -> Builder+-- > renderString cs =+-- >     charUtf8 '"' <> encodeListWithB escapedUtf8 cs <> charUtf8 '"'+-- >   where+-- >     escapedUtf8 :: BoundedEncoding Char+-- >     escapedUtf8 =+-- >       encodeIf (== '\\') (char <#> char #. const ('\\', '\\')) $+-- >       encodeIf (== '\"') (char <#> char #. const ('\\', '\"')) $+-- >       char+--+-- This 'Builder' considers a buffer with less than 8 free bytes as full. As+-- all functions are inlined, the compiler is able to optimize the constant+-- 'E.Encoding's as two sequential 'poke's. Compared to the first implementation of+-- 'renderString' this implementation is 1.7x faster.+--+-}+{-+Internally, 'Builder's are buffer-fill operations that are+given a continuation buffer-fill operation and a buffer-range to be filled.+A 'Builder' first checks if the buffer-range is large enough. If that's+the case, the 'Builder' writes the sequences of bytes to the buffer and+calls its continuation.  Otherwise, it returns a signal that it requires a+new buffer together with a continuation to be called on this new buffer.+Ignoring the rare case of a full buffer-range, the execution cost of a+'Builder' consists of three parts:++  1. The time taken to read the parameters; i.e., the buffer-fill+     operation to call after the 'Builder' is done and the buffer-range to+     fill.++  2. The time taken to check for the size of the buffer-range.++  3. The time taken for the actual encoding.++We can reduce cost (1) by ensuring that fewer buffer-fill function calls are+required. We can reduce cost (2) by fusing buffer-size checks of sequential+writes. For example, when escaping a 'String' using 'renderString', it would+be sufficient to check before encoding a character that at least 8 bytes are+free. We can reduce cost (3) by implementing better primitive 'Builder's.+For example, 'renderCell' builds an intermediate list containing the decimal+representation of an 'Int'. Implementing a direct decimal encoding of 'Int's+to memory would be more efficient, as it requires fewer buffer-size checks+and less allocation. It is also a planned extension of this library.++The first two cost reductions are supported for user code through functions+in "Data.ByteString.Lazy.Builder.Extras". There, we continue the above example+and drop the generation time to 0.8ms by implementing 'renderString' more+cleverly. The third reduction requires meddling with the internals of+'Builder's and is not recomended in code outside of this library. However,+patches to this library are very welcome.+-}+module Data.ByteString.Lazy.Builder.BasicEncoding.Extras (++  -- * Base-128, variable-length binary encodings+  {- |+There are many options for implementing a base-128 (i.e, 7-bit),+variable-length encoding. The encoding implemented here is the one used by+Google's protocol buffer library+<http://code.google.com/apis/protocolbuffers/docs/encoding.html#varints>.  This+encoding can be implemented efficiently and provides the desired property that+small positive integers result in short sequences of bytes. It is intended to+be used for the new default binary serialization format of the differently+sized 'Word' types. It works as follows.++The most-significant bit (MSB) of each output byte indicates whether+there is a following byte (MSB set to 1) or it is the last byte (MSB set to 0).+The remaining 7-bits are used to encode the input starting with the least+significant 7-bit group of the input (i.e., a little-endian ordering of the+7-bit groups is used).++For example, the value @1 :: Int@ is encoded as @[0x01]@. The value+@128 :: Int@, whose binary representation is @1000 0000@, is encoded as+@[0x80, 0x01]@; i.e., the first byte has its MSB set and the least significant+7-bit group is @000 0000@, the second byte has its MSB not set (it is the last+byte) and its 7-bit group is @000 0001@.+-}+    word8Var+  , word16Var+  , word32Var+  , word64Var+  , wordVar++{- |+The following encodings work by casting the signed integer to the equally sized+unsigned integer. This works well for positive integers, but for negative+integers it always results in the longest possible sequence of bytes,+as their MSB is (by definition) always set.+-}++  , int8Var+  , int16Var+  , int32Var+  , int64Var+  , intVar++{- |+Positive and negative integers of small magnitude can be encoded compactly+  using the so-called ZigZag encoding+  (<http://code.google.com/apis/protocolbuffers/docs/encoding.html#types>).+The /ZigZag encoding/ uses+  even numbers to encode the postive integers and+  odd numbers to encode the negative integers.+For example,+  @0@ is encoded as @0@, @-1@ as @1@, @1@ as @2@, @-2@ as @3@, @2@ as @4@, and+  so on.+Its efficient implementation uses some bit-level magic.+For example++@+zigZag32 :: 'Int32' -> 'Word32'+zigZag32 n = fromIntegral ((n \`shiftL\` 1) \`xor\` (n \`shiftR\` 31))+@++Note that the 'shiftR' is an arithmetic shift that performs sign extension.+The ZigZag encoding essentially swaps the LSB with the MSB and additionally+inverts all bits if the MSB is set.++The following encodings implement the combintion of ZigZag encoding+  together with the above base-128, variable length encodings.+They are intended to become the the new default binary serialization format of+  the differently sized 'Int' types.+-}+  , int8VarSigned+  , int16VarSigned+  , int32VarSigned+  , int64VarSigned+  , intVarSigned+++  -- * Chunked / size-prefixed encodings+{- |+Some encodings like ASN.1 BER <http://en.wikipedia.org/wiki/Basic_Encoding_Rules>+or Google's protocol buffers <http://code.google.com/p/protobuf/> require+encoded data to be prefixed with its length. The simple method to achieve this+is to encode the data first into a separate buffer, compute the length of the+encoded data, write it to the current output buffer, and append the separate+buffers. The drawback of this method is that it requires a ...+-}+  , size+  , sizeBound+  -- , withSizeFB+  -- , withSizeBB+  , encodeWithSize++  , encodeChunked++  , wordVarFixedBound+  , wordHexFixedBound+  , wordDecFixedBound++  , word64VarFixedBound+  , word64HexFixedBound+  , word64DecFixedBound++  ) where++import           Data.ByteString.Lazy.Builder.Internal+import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal.UncheckedShifts+import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Base16 (lowerTable, encode4_as_8)++import qualified Data.ByteString               as S+import qualified Data.ByteString.Internal      as S+import qualified Data.ByteString.Lazy.Internal as L++import           Data.Monoid+import           Data.List (unfoldr)  -- HADDOCK ONLY+import           Data.Char (chr, ord)+import           Control.Monad ((<=<), unless)++import           Data.ByteString.Lazy.Builder.BasicEncoding.Internal hiding (size, sizeBound)+import qualified Data.ByteString.Lazy.Builder.BasicEncoding.Internal as I (size, sizeBound)+import           Data.ByteString.Lazy.Builder.BasicEncoding.Binary+import           Data.ByteString.Lazy.Builder.BasicEncoding.ASCII+import           Data.ByteString.Lazy.Builder.BasicEncoding++import           Foreign++------------------------------------------------------------------------------+-- Adapting 'size' for the public interface.+------------------------------------------------------------------------------++-- | The size of the sequence of bytes generated by this 'FixedEncoding'.+size :: FixedEncoding a -> Word+size = fromIntegral . I.size++-- | The bound on the size of the sequence of bytes generated by this+-- 'BoundedEncoding'.+sizeBound :: BoundedEncoding a -> Word+sizeBound = fromIntegral . I.sizeBound+++------------------------------------------------------------------------------+-- Base-128 Variable-Length Encodings+------------------------------------------------------------------------------++{-# INLINE encodeBase128 #-}+encodeBase128+    :: forall a b. (Integral a, Bits a, Storable b, Integral b, Num b)+    => (a -> Int -> a) -> BoundedEncoding b+encodeBase128 shiftr =+    -- We add 6 because we require the result of (`div` 7) to be rounded up.+    boundedEncoding ((8 * sizeOf (undefined :: b) + 6) `div` 7) (io . fromIntegral)+  where+    io !x !op+      | x' == 0   = do poke8 (x .&. 0x7f)+                       return $! op `plusPtr` 1+      | otherwise = do poke8 ((x .&. 0x7f) .|. 0x80)+                       io x' (op `plusPtr` 1)+      where+        x'    = x `shiftr` 7+        poke8 = poke op . fromIntegral++-- | Base-128, variable length encoding of a 'Word8'.+{-# INLINE word8Var #-}+word8Var :: BoundedEncoding Word8+word8Var = encodeBase128 shiftr_w++-- | Base-128, variable length encoding of a 'Word16'.+{-# INLINE word16Var #-}+word16Var :: BoundedEncoding Word16+word16Var = encodeBase128 shiftr_w++-- | Base-128, variable length encoding of a 'Word32'.+{-# INLINE word32Var #-}+word32Var :: BoundedEncoding Word32+word32Var = encodeBase128 shiftr_w32++-- | Base-128, variable length encoding of a 'Word64'.+{-# INLINE word64Var #-}+word64Var :: BoundedEncoding Word64+word64Var = encodeBase128 shiftr_w64++-- | Base-128, variable length encoding of a 'Word'.+{-# INLINE wordVar #-}+wordVar :: BoundedEncoding Word+wordVar = encodeBase128 shiftr_w+++-- | Base-128, variable length encoding of an 'Int8'.+-- Use 'int8VarSigned' for encoding negative numbers.+{-# INLINE int8Var #-}+int8Var :: BoundedEncoding Int8+int8Var = fromIntegral >$< word8Var++-- | Base-128, variable length encoding of an 'Int16'.+-- Use 'int16VarSigned' for encoding negative numbers.+{-# INLINE int16Var #-}+int16Var :: BoundedEncoding Int16+int16Var = fromIntegral >$< word16Var++-- | Base-128, variable length encoding of an 'Int32'.+-- Use 'int32VarSigned' for encoding negative numbers.+{-# INLINE int32Var #-}+int32Var :: BoundedEncoding Int32+int32Var = fromIntegral >$< word32Var++-- | Base-128, variable length encoding of an 'Int64'.+-- Use 'int64VarSigned' for encoding negative numbers.+{-# INLINE int64Var #-}+int64Var :: BoundedEncoding Int64+int64Var = fromIntegral >$< word64Var++-- | Base-128, variable length encoding of an 'Int'.+-- Use 'intVarSigned' for encoding negative numbers.+{-# INLINE intVar #-}+intVar :: BoundedEncoding Int+intVar = fromIntegral >$< wordVar++{-# INLINE zigZag #-}+zigZag :: (Storable a, Bits a) => a -> a+zigZag x = (x `shiftL` 1) `xor` (x `shiftR` (8 * sizeOf x - 1))++-- | Base-128, variable length, ZigZag encoding of an 'Int'.+{-# INLINE int8VarSigned #-}+int8VarSigned :: BoundedEncoding Int8+int8VarSigned = zigZag >$< int8Var++-- | Base-128, variable length, ZigZag encoding of an 'Int16'.+{-# INLINE int16VarSigned #-}+int16VarSigned :: BoundedEncoding Int16+int16VarSigned = zigZag >$< int16Var++-- | Base-128, variable length, ZigZag encoding of an 'Int32'.+{-# INLINE int32VarSigned #-}+int32VarSigned :: BoundedEncoding Int32+int32VarSigned = zigZag >$< int32Var++-- | Base-128, variable length, ZigZag encoding of an 'Int64'.+{-# INLINE int64VarSigned #-}+int64VarSigned :: BoundedEncoding Int64+int64VarSigned = zigZag >$< int64Var++-- | Base-128, variable length, ZigZag encoding of an 'Int'.+{-# INLINE intVarSigned #-}+intVarSigned :: BoundedEncoding Int+intVarSigned = zigZag >$< intVar++++------------------------------------------------------------------------------+-- Chunked Encoding Transformer+------------------------------------------------------------------------------++-- | /Heavy inlining./+{-# INLINE encodeChunked #-}+encodeChunked+    :: Word                           -- ^ Minimal free-size+    -> (Word64 -> FixedEncoding Word64)+    -- ^ Given a sizeBound on the maximal encodable size this function must return+    -- a fixed-size encoding for encoding all smaller size.+    -> (BoundedEncoding Word64)+    -- ^ An encoding for terminating a chunk of the given size.+    -> Builder+    -- ^ Inner Builder to transform+    -> Builder+    -- ^ 'Put' with chunked encoding.+encodeChunked minFree mkBeforeFE afterBE =+    fromPut . putChunked minFree mkBeforeFE afterBE . putBuilder++-- | /Heavy inlining./+{-# INLINE putChunked #-}+putChunked+    :: Word                         -- ^ Minimal free-size+    -> (Word64 -> FixedEncoding Word64)+    -- ^ Given a sizeBound on the maximal encodable size this function must return+    -- a fixed-size encoding for encoding all smaller size.+    -> (BoundedEncoding Word64)+    -- ^ Encoding a directly inserted chunk.+    -> Put a+    -- ^ Inner Put to transform+    -> Put a+    -- ^ 'Put' with chunked encoding.+putChunked minFree0 mkBeforeFE afterBE p =+    put encodingStep+  where+    minFree, reservedAfter, maxReserved, minBufferSize :: Int+    minFree       = fromIntegral $ max 1 minFree0   -- sanitize and convert to Int++    -- reserved space must be computed for maximum buffer size to cover for all+    -- sizes of the actually returned buffer.+    reservedAfter = I.sizeBound afterBE+    maxReserved   = I.size (mkBeforeFE maxBound) + reservedAfter+    minBufferSize = minFree + maxReserved++    encodingStep k =+        fill (runPut p)+      where+        fill innerStep !(BufferRange op ope)+          | outRemaining < minBufferSize =+              return $! bufferFull minBufferSize op (fill innerStep)+          | otherwise = do+              fillWithBuildStep innerStep doneH fullH insertChunksH brInner+          where+            outRemaining   = ope `minusPtr` op+            beforeFE       = mkBeforeFE $ fromIntegral outRemaining+            reservedBefore = I.size beforeFE++            opInner        = op  `plusPtr` reservedBefore+            opeInner       = ope `plusPtr` (-reservedAfter)+            brInner        = BufferRange opInner opeInner++            wrapChunk :: Ptr Word8 -> IO (Ptr Word8)+            wrapChunk !opInner'+              | innerSize == 0 = return op -- no data written => no chunk to wrap+              | otherwise      = do+                  runF beforeFE innerSize op+                  runB afterBE innerSize opInner'+              where+                innerSize = fromIntegral $ opInner' `minusPtr` opInner++            doneH opInner' x = do+                op' <- wrapChunk opInner'+                let !br' = BufferRange op' ope+                k x br'++            fullH opInner' minSize nextInnerStep = do+                op' <- wrapChunk opInner'+                return $! bufferFull+                  (max minBufferSize (minSize + maxReserved))+                  op'+                  (fill nextInnerStep)++            insertChunksH opInner' n lbsC nextInnerStep+              | n == 0 = do                      -- flush+                  op' <- wrapChunk opInner'+                  return $! insertChunks op' 0 id (fill nextInnerStep)++              | otherwise = do                   -- insert non-empty bytestring+                  op' <- wrapChunk opInner'+                  let !br' = BufferRange op' ope+                  runBuilderWith chunkB (fill nextInnerStep) br'+              where+                nU     = fromIntegral n+                chunkB =+                  encodeWithF (mkBeforeFE nU) nU `mappend`+                  lazyByteStringC n lbsC         `mappend`+                  encodeWithB afterBE nU+++-- | /Heavy inlining./ Prefix a 'Builder' with the size of the+-- sequence of bytes that it denotes.+--+-- This function is optimized for streaming use. It tries to prefix the size+-- without copying the output. This is achieved by reserving space for the+-- maximum size to be encoded. This succeeds if the output is smaller than+-- the current free buffer size, which is guaranteed to be at least @8kb@.+--+-- If the output does not fit into the current free buffer size,+-- the method falls back to encoding the data to a separate lazy bytestring,+-- computing the size, and encoding the size before inserting the chunks of+-- the separate lazy bytestring.+{-# INLINE encodeWithSize #-}+encodeWithSize+    ::+       Word+    -- ^ Inner buffer-size.+    -> (Word64 -> FixedEncoding Word64)+    -- ^ Given a bound on the maximal size to encode, this function must return+    -- a fixed-size encoding for all smaller sizes.+    -> Builder+    -- ^ 'Put' to prefix with the length of its sequence of bytes.+    -> Builder+encodeWithSize innerBufSize mkSizeFE =+    fromPut . putWithSize innerBufSize mkSizeFE . putBuilder++-- | Prefix a 'Put' with the size of its written data.+{-# INLINE putWithSize #-}+putWithSize+    :: forall a.+       Word+    -- ^ Buffer-size for inner driver.+    -> (Word64 -> FixedEncoding Word64)+    -- ^ Encoding the size for the fallback case.+    -> Put a+    -- ^ 'Put' to prefix with the length of its sequence of bytes.+    -> Put a+putWithSize innerBufSize mkSizeFE innerP =+    put $ encodingStep+  where+    -- | The minimal free size is such that we can encode any size.+    minFree = I.size $ mkSizeFE maxBound++    encodingStep :: (forall r. (a -> BuildStep r) -> BuildStep r)+    encodingStep k =+        fill (runPut innerP)+      where+        fill :: BuildStep a -> BufferRange -> IO (BuildSignal r)+        fill innerStep !(BufferRange op ope)+          | outRemaining < minFree =+              return $! bufferFull minFree op (fill innerStep)+          | otherwise = do+              fillWithBuildStep innerStep doneH fullH insertChunksH brInner+          where+            outRemaining   = ope `minusPtr` op+            sizeFE         = mkSizeFE $ fromIntegral outRemaining+            reservedBefore = I.size sizeFE+            reservedAfter  = minFree - reservedBefore++            -- leave enough free space such that all sizes can be encodded.+            startInner    = op  `plusPtr` reservedBefore+            opeInner      = ope `plusPtr` (negate reservedAfter)+            brInner       = BufferRange startInner opeInner++            fastPrefixSize :: Ptr Word8 -> IO (Ptr Word8)+            fastPrefixSize !opInner'+              | innerSize == 0 = do runB (toB $ mkSizeFE 0) 0         op+              | otherwise      = do runF (sizeFE)           innerSize op+                                    return opInner'+              where+                innerSize = fromIntegral $ opInner' `minusPtr` startInner++            slowPrefixSize :: Ptr Word8 -> Builder -> BuildStep a -> IO (BuildSignal r)+            slowPrefixSize opInner' bInner nextStep = do+                (x, chunks, payLenChunks) <- toLBS $ runBuilderWith bInner nextStep++                let -- length of payload data in current buffer+                    payLenCur   = opInner' `minusPtr` startInner+                    -- length of whole payload+                    payLen      = fromIntegral payLenCur + fromIntegral payLenChunks+                    -- encoder for payload length+                    sizeFE'     = mkSizeFE payLen+                    -- start of payload in current buffer with the payload+                    -- length encoded before+                    startInner' = op `plusPtr` I.size sizeFE'++                -- move data in current buffer out of the way, if required+                unless (startInner == startInner') $+                    moveBytes startInner' startInner payLenCur+                -- encode payload length at start of the buffer+                runF sizeFE' payLen op+                -- TODO: If we were to change the CIOS definition such that it also+                -- returns the last buffer for writing, we could also fill the+                -- last buffer with 'k' and return the signal, once it is+                -- filled, therefore avoiding unfilled space.+                return $ insertChunks (startInner' `plusPtr` payLenCur)+                                      payLenChunks+                                      chunks+                                      (k x)+              where+                toLBS = runCIOSWithLength <=<+                    buildStepToCIOSUntrimmedWith (fromIntegral innerBufSize)++            doneH :: Ptr Word8 -> a -> IO (BuildSignal r)+            doneH opInner' x = do+                op' <- fastPrefixSize opInner'+                let !br' = BufferRange op' ope+                k x br'++            fullH :: Ptr Word8 -> Int -> BuildStep a -> IO (BuildSignal r)+            fullH opInner' minSize nextInnerStep =+                slowPrefixSize opInner' (ensureFree minSize) nextInnerStep++            insertChunksH :: Ptr Word8 -> Int64 -> LazyByteStringC+                          -> BuildStep a -> IO (BuildSignal r)+            insertChunksH opInner' n lbsC nextInnerStep =+                slowPrefixSize opInner' (lazyByteStringC n lbsC) nextInnerStep+++-- | Run a 'ChunkIOStream' and gather its results and their length.+runCIOSWithLength :: ChunkIOStream a -> IO (a, LazyByteStringC, Int64)+runCIOSWithLength =+    go 0 id+  where+    go !l lbsC (Finished x)        = return (x, lbsC, l)+    go !l lbsC (YieldC n lbsC' io) = io >>= go (l + n) (lbsC . lbsC')+    go !l lbsC (Yield1 bs io)      =+        io >>= go (l + fromIntegral (S.length bs)) (lbsC . L.Chunk bs)++-- | Run a 'BuildStep' using the untrimmed strategy.+buildStepToCIOSUntrimmedWith :: Int -> BuildStep a -> IO (ChunkIOStream a)+buildStepToCIOSUntrimmedWith bufSize =+    buildStepToCIOS (untrimmedStrategy bufSize bufSize)+                    (return . Finished)+++----------------------------------------------------------------------+-- Padded versions of encodings for streamed prefixing of output sizes+----------------------------------------------------------------------++{-# INLINE appsUntilZero #-}+appsUntilZero :: (Eq a, Num a) => (a -> a) -> a -> Int+appsUntilZero f x0 =+    count 0 x0+  where+    count !n 0 = n+    count !n x = count (succ n) (f x)+++{-# INLINE genericVarFixedBound #-}+genericVarFixedBound :: (Eq b, Show b, Bits b, Num a, Integral b)+                => (b -> a -> b) -> b -> FixedEncoding b+genericVarFixedBound shiftRight bound =+    fixedEncoding n0 io+  where+    n0 = max 1 $ appsUntilZero (`shiftRight` 7) bound++    io !x0 !op+      | x0 > bound = error err+      | otherwise  = loop 0 x0+      where+        err = "genericVarFixedBound: value " ++ show x0 ++ " > bound " ++ show bound+        loop !n !x+          | n0 <= n + 1 = do poke8 (x .&. 0x7f)+          | otherwise   = do poke8 ((x .&. 0x7f) .|. 0x80)+                             loop (n + 1) (x `shiftRight` 7)+          where+            poke8 = pokeElemOff op n . fromIntegral++{-# INLINE wordVarFixedBound #-}+wordVarFixedBound :: Word -> FixedEncoding Word+wordVarFixedBound = genericVarFixedBound shiftr_w++{-# INLINE word64VarFixedBound #-}+word64VarFixedBound :: Word64 -> FixedEncoding Word64+word64VarFixedBound = genericVarFixedBound shiftr_w64+++-- Somehow this function doesn't really make sense, as the bound must be+-- greater when interpreted as an unsigned integer. These conversions and+-- decisions should be left to the user.+--+--{-# INLINE intVarFixed #-}+--intVarFixed :: Size -> FixedEncoding Size+--intVarFixed bound = fromIntegral >$< wordVarFixed (fromIntegral bound)++{-# INLINE genHexFixedBound #-}+genHexFixedBound :: (Num a, Bits a, Integral a)+                 => (a -> Int -> a) -> Char -> a -> FixedEncoding a+genHexFixedBound shiftr padding0 bound =+    fixedEncoding n0 io+  where+    n0 = max 1 $ appsUntilZero (`shiftr` 4) bound++    padding = fromIntegral (ord padding0) :: Word8++    io !x0 !op0 =+        loop (op0 `plusPtr` n0) x0+      where+        loop !op !x = do+           let !op' = op `plusPtr` (-1)+           poke op' =<< encode4_as_8 lowerTable (fromIntegral $ x .&. 0xf)+           let !x' = x `shiftr` 4+           unless (op' <= op0) $+             if x' == 0+               then pad (op' `plusPtr` (-1))+               else loop op' x'++        pad !op+          | op < op0  = return ()+          | otherwise = poke op padding >> pad (op `plusPtr` (-1))+++{-# INLINE wordHexFixedBound #-}+wordHexFixedBound :: Char -> Word -> FixedEncoding Word+wordHexFixedBound = genHexFixedBound shiftr_w++{-# INLINE word64HexFixedBound #-}+word64HexFixedBound :: Char -> Word64 -> FixedEncoding Word64+word64HexFixedBound = genHexFixedBound shiftr_w64++-- | Note: Works only for positive numbers.+{-# INLINE genDecFixedBound #-}+genDecFixedBound :: (Num a, Bits a, Integral a)+                 => Char -> a -> FixedEncoding a+genDecFixedBound padding0 bound =+    fixedEncoding n0 io+  where+    n0 = max 1 $ appsUntilZero (`div` 10) bound++    padding = fromIntegral (ord padding0) :: Word8++    io !x0 !op0 =+        loop (op0 `plusPtr` n0) x0+      where+        loop !op !x = do+           let !op' = op `plusPtr` (-1)+               !x'  = x `div` 10+           poke op' ((fromIntegral $ (x - x' * 10) + 48) :: Word8)+           unless (op' <= op0) $+             if x' == 0+               then pad (op' `plusPtr` (-1))+               else loop op' x'++        pad !op+          | op < op0  = return ()+          | otherwise = poke op padding >> pad (op `plusPtr` (-1))++{-# INLINE wordDecFixedBound #-}+wordDecFixedBound :: Char -> Word -> FixedEncoding Word+wordDecFixedBound = genDecFixedBound++{-# INLINE word64DecFixedBound #-}+word64DecFixedBound :: Char -> Word64 -> FixedEncoding Word64+word64DecFixedBound = genDecFixedBound+
+ Data/ByteString/Lazy/Builder/BasicEncoding/Internal.hs view
@@ -0,0 +1,353 @@+{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns #-}+{-# OPTIONS_HADDOCK hide #-}+-- |+-- Copyright   : 2010-2011 Simon Meier, 2010 Jasper van der Jeugt+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : GHC+--+-- This module is internal. It is only intended to be used by the 'bytestring'+-- and the 'text' library. Please contact the maintainer, if you need to use+-- this module in your library. We are glad to accept patches for further+-- standard encodings of standard Haskell values.+--+-- If you need to write your own primitive encoding, then be aware that you are+-- writing code with /all saftey belts off/; i.e.,+-- *this is the code that might make your application vulnerable to buffer-overflow attacks!*+-- The "Codec.Bounded.Encoding.Internal.Test" module provides you with+-- utilities for testing your encodings thoroughly.+--+module Data.ByteString.Lazy.Builder.BasicEncoding.Internal (+  -- * Fixed-size Encodings+    Size+  , FixedEncoding+  , fixedEncoding+  , size+  , runF++  , emptyF+  , contramapF+  , pairF+  -- , liftIOF++  , storableToF++  -- * Bounded-size Encodings+  , BoundedEncoding+  , boundedEncoding+  , sizeBound+  , runB++  , emptyB+  , contramapB+  , pairB+  , eitherB+  , ifB++  -- , liftIOB++  , toB+  , fromF++  -- , withSizeFB+  -- , withSizeBB++  -- * Shared operators+  , (>$<)+  , (>*<)++  ) where++import Foreign+import Prelude hiding (maxBound)++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 611+-- ghc-6.10 and older do not support {-# INLINE CONLIKE #-}+#define CONLIKE+#endif++------------------------------------------------------------------------------+-- Supporting infrastructure+------------------------------------------------------------------------------++-- | Contravariant functors as in the 'contravariant' package.+class Contravariant f where+    contramap :: (b -> a) -> f a -> f b++infixl 4 >$<++-- | An overloaded infix operator for 'contramapF' and 'contramapB'.+--+-- We can use it for example to prepend and/or append fixed values to an+-- encoding.+--+-- >showEncoding ((\x -> ('\'', (x, '\''))) >$< fixed3) 'x' = "'x'"+-- >  where+-- >    fixed3 = char7 >*< char7 >*< char7+--+-- Note that the rather verbose syntax for composition stems from the+-- requirement to be able to compute the 'size's and 'sizeBound's at+-- compile time.+--+(>$<) :: Contravariant f => (b -> a) -> f a -> f b+(>$<) = contramap+++instance Contravariant FixedEncoding where+    contramap = contramapF++instance Contravariant BoundedEncoding where+    contramap = contramapB+++-- | Type-constructors supporting lifting of type-products.+class Monoidal f where+    pair :: f a -> f b -> f (a, b)++instance Monoidal FixedEncoding where+    pair = pairF++instance Monoidal BoundedEncoding where+    pair = pairB++infixr 5 >*<++-- | An overloaded infix operator for 'pairF' and 'pairB'.+-- For example,+--+-- >showF (char7 >*< char7) ('x','y') = "xy"+--+-- We can combine multiple encodings using '>*<' multiple times.+--+-- >showEncoding (char7 >*< char7 >*< char7) ('x',('y','z')) = "xyz"+--+(>*<) :: Monoidal f => f a -> f b -> f (a, b)+(>*<) = pair+++-- | The type used for sizes and sizeBounds of sizes.+type Size = Int+++------------------------------------------------------------------------------+-- Fixed-size Encodings+------------------------------------------------------------------------------++-- | An encoding that always results in a sequence of bytes of a+-- pre-determined, fixed size.+data FixedEncoding a = FE {-# UNPACK #-} !Int (a -> Ptr Word8 -> IO ())++fixedEncoding :: Int -> (a -> Ptr Word8 -> IO ()) -> FixedEncoding a+fixedEncoding = FE++-- | The size of the sequences of bytes generated by this 'FixedEncoding'.+{-# INLINE CONLIKE size #-}+size :: FixedEncoding a -> Int+size (FE l _) = l++{-# INLINE CONLIKE runF #-}+runF :: FixedEncoding a -> a -> Ptr Word8 -> IO ()+runF (FE _ io) = io++-- | The 'FixedEncoding' that always results in the zero-length sequence.+{-# INLINE CONLIKE emptyF #-}+emptyF :: FixedEncoding a+emptyF = FE 0 (\_ _ -> return ())++-- | Encode a pair by encoding its first component and then its second component.+{-# INLINE CONLIKE pairF #-}+pairF :: FixedEncoding a -> FixedEncoding b -> FixedEncoding (a, b)+pairF (FE l1 io1) (FE l2 io2) =+    FE (l1 + l2) (\(x1,x2) op -> io1 x1 op >> io2 x2 (op `plusPtr` l1))++-- | Change an encoding such that it first applies a function to the value+-- to be encoded.+--+-- Note that encodings are 'Contrafunctors'+-- <http://hackage.haskell.org/package/contravariant>. Hence, the following+-- laws hold.+--+-- >contramapF id = id+-- >contramapF f . contramapF g = contramapF (g . f)+{-# INLINE CONLIKE contramapF #-}+contramapF :: (b -> a) -> FixedEncoding a -> FixedEncoding b+contramapF f (FE l io) = FE l (\x op -> io (f x) op)++-- | Convert a 'FixedEncoding' to a 'BoundedEncoding'.+{-# INLINE CONLIKE toB #-}+toB :: FixedEncoding a -> BoundedEncoding a+toB (FE l io) = BE l (\x op -> io x op >> (return $! op `plusPtr` l))++-- | Convert a 'FixedEncoding' to a 'BoundedEncoding'.+{-# INLINE CONLIKE fromF #-}+fromF :: FixedEncoding a -> BoundedEncoding a+fromF = toB++{-# INLINE CONLIKE storableToF #-}+storableToF :: forall a. Storable a => FixedEncoding a+storableToF = FE (sizeOf (undefined :: a)) (\x op -> poke (castPtr op) x)++{-+{-# INLINE CONLIKE liftIOF #-}+liftIOF :: FixedEncoding a -> FixedEncoding (IO a)+liftIOF (FE l io) = FE l (\xWrapped op -> do x <- xWrapped; io x op)+-}++------------------------------------------------------------------------------+-- Bounded-size Encodings+------------------------------------------------------------------------------++-- | An encoding that always results in sequence of bytes that is no longer+-- than a pre-determined bound.+data BoundedEncoding a = BE {-# UNPACK #-} !Int (a -> Ptr Word8 -> IO (Ptr Word8))++-- | The bound on the size of sequences of bytes generated by this 'BoundedEncoding'.+{-# INLINE CONLIKE sizeBound #-}+sizeBound :: BoundedEncoding a -> Int+sizeBound (BE b _) = b++boundedEncoding :: Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedEncoding a+boundedEncoding = BE++{-# INLINE CONLIKE runB #-}+runB :: BoundedEncoding a -> a -> Ptr Word8 -> IO (Ptr Word8)+runB (BE _ io) = io++-- | Change a 'BoundedEncoding' such that it first applies a function to the+-- value to be encoded.+--+-- Note that 'BoundedEncoding's are 'Contrafunctors'+-- <http://hackage.haskell.org/package/contravariant>. Hence, the following+-- laws hold.+--+-- >contramapB id = id+-- >contramapB f . contramapB g = contramapB (g . f)+{-# INLINE CONLIKE contramapB #-}+contramapB :: (b -> a) -> BoundedEncoding a -> BoundedEncoding b+contramapB f (BE b io) = BE b (\x op -> io (f x) op)++-- | The 'BoundedEncoding' that always results in the zero-length sequence.+{-# INLINE CONLIKE emptyB #-}+emptyB :: BoundedEncoding a+emptyB = BE 0 (\_ op -> return op)++-- | Encode a pair by encoding its first component and then its second component.+{-# INLINE CONLIKE pairB #-}+pairB :: BoundedEncoding a -> BoundedEncoding b -> BoundedEncoding (a, b)+pairB (BE b1 io1) (BE b2 io2) =+    BE (b1 + b2) (\(x1,x2) op -> io1 x1 op >>= io2 x2)++-- | Encode an 'Either' value using the first 'BoundedEncoding' for 'Left'+-- values and the second 'BoundedEncoding' for 'Right' values.+--+-- Note that the functions 'eitherB', 'pairB', and 'contramapB' (written below+-- using '>$<') suffice to construct 'BoundedEncoding's for all non-recursive+-- algebraic datatypes. For example,+--+-- @+--maybeB :: BoundedEncoding () -> BoundedEncoding a -> BoundedEncoding (Maybe a)+--maybeB nothing just = 'maybe' (Left ()) Right '>$<' eitherB nothing just+-- @+{-# INLINE CONLIKE eitherB #-}+eitherB :: BoundedEncoding a -> BoundedEncoding b -> BoundedEncoding (Either a b)+eitherB (BE b1 io1) (BE b2 io2) =+    BE (max b1 b2)+        (\x op -> case x of Left x1 -> io1 x1 op; Right x2 -> io2 x2 op)++-- | Conditionally select a 'BoundedEncoding'.+-- For example, we can implement the ASCII encoding that drops characters with+-- Unicode codepoints above 127 as follows.+--+-- @+--charASCIIDrop = 'ifB' (< '\128') ('fromF' 'char7') 'emptyB'+-- @+{-# INLINE CONLIKE ifB #-}+ifB :: (a -> Bool) -> BoundedEncoding a -> BoundedEncoding a -> BoundedEncoding a+ifB p be1 be2 =+    contramapB (\x -> if p x then Left x else Right x) (eitherB be1 be2)+++{-+{-# INLINE withSizeFB #-}+withSizeFB :: (Word -> FixedEncoding Word) -> BoundedEncoding a -> BoundedEncoding a+withSizeFB feSize (BE b io) =+    BE (lSize + b)+       (\x op0 -> do let !op1 = op0 `plusPtr` lSize+                     op2 <- io x op1+                     ioSize (fromIntegral $ op2 `minusPtr` op1) op0+                     return op2)+  where+    FE lSize ioSize = feSize (fromIntegral b)+++{-# INLINE withSizeBB #-}+withSizeBB :: BoundedEncoding Word -> BoundedEncoding a -> BoundedEncoding a+withSizeBB (BE bSize ioSize) (BE b io) =+    BE (bSize + 2*b)+       (\x op0 -> do let !opTmp = op0 `plusPtr` (bSize + b)+                     opTmp' <- io x opTmp+                     let !s = opTmp' `minusPtr` opTmp+                     op1 <- ioSize (fromIntegral s) op0+                     copyBytes op1 opTmp s+                     return $! op1 `plusPtr` s)++{-# INLINE CONLIKE liftIOB #-}+liftIOB :: BoundedEncoding a -> BoundedEncoding (IO a)+liftIOB (BE l io) = BE l (\xWrapped op -> do x <- xWrapped; io x op)+-}++------------------------------------------------------------------------------+-- Encodings from 'ByteString's.+------------------------------------------------------------------------------++{-+-- | A 'FixedEncoding' that always results in the same byte sequence given as a+-- strict 'S.ByteString'. We can use this encoding to insert fixed ...+{-# INLINE CONLIKE constByteStringF #-}+constByteStringF :: S.ByteString -> FixedEncoding ()+constByteStringF bs =+    FE len io+  where+    (S.PS fp off len) = bs+    io _ op = do+        copyBytes op (unsafeForeignPtrToPtr fp `plusPtr` off) len+        touchForeignPtr fp++-- | Encode a fixed-length prefix of a strict 'S.ByteString' as-is. We can use+-- this function to+{-# INLINE byteStringPrefixB #-}+byteStringTakeB :: Int  -- ^ Length of the prefix. It should be smaller than+                        -- 100 bytes, as otherwise+                -> BoundedEncoding S.ByteString+byteStringTakeB n0 =+    BE n io+  where+    n = max 0 n0 -- sanitize++    io (S.PS fp off len) op = do+        let !s = min len n+        copyBytes op (unsafeForeignPtrToPtr fp `plusPtr` off) s+        touchForeignPtr fp+        return $! op `plusPtr` s+-}++{-++httpChunkedTransfer :: Builder -> Builder+httpChunkedTransfer =+    encodeChunked 32 (word64HexFixedBound '0')+                     ((\_ -> ('\r',('\n',('\r','\n')))) >$< char8x4)+  where+    char8x4 = toB (char8 >*< char8 >*< char8 >*< char8)++++chunked :: Builder -> Builder+chunked = encodeChunked 16 word64VarFixedBound emptyB++-}+++
+ Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Base16.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE CPP #-}+-- |+-- Copyright   : (c) 2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : GHC+--+-- Hexadecimal encoding of nibbles (4-bit) and octets (8-bit) as ASCII+-- characters.+--+-- The current implementation is based on a table based encoding inspired by+-- the code in the 'base64-bytestring' library by Bryan O'Sullivan. In our+-- benchmarks on a 32-bit machine it turned out to be the fastest+-- implementation option.+--+module Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Base16 (+    EncodingTable+  -- , upperTable+  , lowerTable+  , encode4_as_8+  , encode8_as_16h+  -- , encode8_as_8_8+  ) where++import qualified Data.ByteString          as S+import qualified Data.ByteString.Internal as S++#if MIN_VERSION_base(4,4,0)+import           Foreign hiding (unsafePerformIO, unsafeForeignPtrToPtr)+import           Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import           System.IO.Unsafe (unsafePerformIO)+#else+import           Foreign+#endif++-- Creating the encoding tables+-------------------------------++-- TODO: Use table from C implementation.++-- | An encoding table for Base16 encoding.+newtype EncodingTable = EncodingTable (ForeignPtr Word8)++tableFromList :: [Word8] -> EncodingTable+tableFromList xs = case S.pack xs of S.PS fp _ _ -> EncodingTable fp++unsafeIndex :: EncodingTable -> Int -> IO Word8+unsafeIndex (EncodingTable table) = peekElemOff (unsafeForeignPtrToPtr table)++base16EncodingTable :: EncodingTable -> IO EncodingTable+base16EncodingTable alphabet = do+    xs <- sequence $ concat $ [ [ix j, ix k] | j <- [0..15], k <- [0..15] ]+    return $ tableFromList xs+  where+    ix = unsafeIndex alphabet++{-+{-# NOINLINE upperAlphabet #-}+upperAlphabet :: EncodingTable+upperAlphabet =+    tableFromList $ map (fromIntegral . fromEnum) $ ['0'..'9'] ++ ['A'..'F']++-- | The encoding table for hexadecimal values with upper-case characters;+-- e.g., DEADBEEF.+{-# NOINLINE upperTable #-}+upperTable :: EncodingTable+upperTable = unsafePerformIO $ base16EncodingTable upperAlphabet+-}++{-# NOINLINE lowerAlphabet #-}+lowerAlphabet :: EncodingTable+lowerAlphabet =+    tableFromList $ map (fromIntegral . fromEnum) $ ['0'..'9'] ++ ['a'..'f']++-- | The encoding table for hexadecimal values with lower-case characters;+-- e.g., deadbeef.+{-# NOINLINE lowerTable #-}+lowerTable :: EncodingTable+lowerTable = unsafePerformIO $ base16EncodingTable lowerAlphabet+++-- Encoding nibbles and octets+------------------------------++-- | Encode a nibble as an octet.+--+-- > encode4_as_8 lowerTable 10 = fromIntegral (char 'a')+--+{-# INLINE encode4_as_8 #-}+encode4_as_8 :: EncodingTable -> Word8 -> IO Word8+encode4_as_8 table x = unsafeIndex table (2 * fromIntegral x + 1)+-- TODO: Use a denser table to reduce cache utilization.++-- | Encode an octet as 16bit word comprising both encoded nibbles ordered+-- according to the host endianness. Writing these 16bit to memory will write+-- the nibbles in the correct order (i.e. big-endian).+{-# INLINE encode8_as_16h #-}+encode8_as_16h :: EncodingTable -> Word8 -> IO Word16+encode8_as_16h (EncodingTable table) =+    peekElemOff (castPtr $ unsafeForeignPtrToPtr table) . fromIntegral++{-+-- | Encode an octet as a big-endian ordered tuple of octets; i.e.,+--+-- >   encode8_as_8_8 lowerTable 10+-- > = (fromIntegral (chr '0'), fromIntegral (chr 'a'))+--+{-# INLINE encode8_as_8_8 #-}+encode8_as_8_8 :: EncodingTable -> Word8 -> IO (Word8, Word8)+encode8_as_8_8 table x =+    (,) <$> unsafeIndex table i <*> unsafeIndex table (i + 1)+  where+    i = 2 * fromIntegral x+-}
+ Data/ByteString/Lazy/Builder/BasicEncoding/Internal/Floating.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Copyright   : (c) 2010 Simon Meier+--+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : GHC+--+-- Conversion of 'Float's and 'Double's to 'Word32's and 'Word64's.+--+module Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Floating+    (+      -- coerceFloatToWord32+    -- , coerceDoubleToWord64+    encodeFloatViaWord32F+  , encodeDoubleViaWord64F+  ) where++import Foreign+import Data.ByteString.Lazy.Builder.BasicEncoding.Internal++{-+We work around ticket http://hackage.haskell.org/trac/ghc/ticket/4092 using the+FFI to store the Float/Double in the buffer and peek it out again from there.+-}+++-- | Encode a 'Float' using a 'Word32' encoding.+--+-- PRE: The 'Word32' encoding must have a size of at least 4 bytes.+{-# INLINE encodeFloatViaWord32F #-}+encodeFloatViaWord32F :: FixedEncoding Word32 -> FixedEncoding Float+encodeFloatViaWord32F w32fe+  | size w32fe < sizeOf (undefined :: Float) =+      error $ "encodeFloatViaWord32F: encoding not wide enough"+  | otherwise = fixedEncoding (size w32fe) $ \x op -> do+      poke (castPtr op) x+      x' <- peek (castPtr op)+      runF w32fe x' op++-- | Encode a 'Double' using a 'Word64' encoding.+--+-- PRE: The 'Word64' encoding must have a size of at least 8 bytes.+{-# INLINE encodeDoubleViaWord64F #-}+encodeDoubleViaWord64F :: FixedEncoding Word64 -> FixedEncoding Double+encodeDoubleViaWord64F w64fe+  | size w64fe < sizeOf (undefined :: Float) =+      error $ "encodeDoubleViaWord64F: encoding not wide enough"+  | otherwise = fixedEncoding (size w64fe) $ \x op -> do+      poke (castPtr op) x+      x' <- peek (castPtr op)+      runF w64fe x' op+
+ Data/ByteString/Lazy/Builder/BasicEncoding/Internal/UncheckedShifts.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE CPP, MagicHash #-}+-- |+-- Copyright   : (c) 2010 Simon Meier+--+--               Original serialization code from 'Data.Binary.Builder':+--               (c) Lennart Kolmodin, Ross Patterson+--+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Portability : GHC+--+-- Utilty module defining unchecked shifts.+--+-- These functions are undefined when the amount being shifted by is+-- greater than the size in bits of a machine Int#.-+--+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif++module Data.ByteString.Lazy.Builder.BasicEncoding.Internal.UncheckedShifts (+    shiftr_w16+  , shiftr_w32+  , shiftr_w64+  , shiftr_w++  , caseWordSize_32_64+  ) where+++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+import GHC.Base+import GHC.Word (Word32(..),Word16(..),Word64(..))++#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ >= 608+import GHC.Word (uncheckedShiftRL64#)+#endif+#else+import Data.Word+#endif++import Foreign+++------------------------------------------------------------------------+-- Unchecked shifts++-- | Right-shift of a 'Word16'.+{-# INLINE shiftr_w16 #-}+shiftr_w16 :: Word16 -> Int -> Word16++-- | Right-shift of a 'Word32'.+{-# INLINE shiftr_w32 #-}+shiftr_w32 :: Word32 -> Int -> Word32++-- | Right-shift of a 'Word64'.+{-# INLINE shiftr_w64 #-}+shiftr_w64 :: Word64 -> Int -> Word64++-- | Right-shift of a 'Word'.+{-# INLINE shiftr_w #-}+shiftr_w :: Word -> Int -> Word+#if WORD_SIZE_IN_BITS < 64+shiftr_w w s = fromIntegral $ (`shiftr_w32` s) $ fromIntegral w+#else+shiftr_w w s = fromIntegral $ (`shiftr_w64` s) $ fromIntegral w+#endif++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#`   i)+shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#`   i)++#if WORD_SIZE_IN_BITS < 64+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)++#if __GLASGOW_HASKELL__ <= 606+-- Exported by GHC.Word in GHC 6.8 and higher+foreign import ccall unsafe "stg_uncheckedShiftRL64"+    uncheckedShiftRL64#     :: Word64# -> Int# -> Word64#+#endif++#else+shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL#` i)+#endif++#else+shiftr_w16 = shiftR+shiftr_w32 = shiftR+shiftr_w64 = shiftR+#endif+++-- | Select an implementation depending on the bit-size of 'Word's.+-- Currently, it produces a runtime failure if the bitsize is different.+-- This is detected by the testsuite.+{-# INLINE caseWordSize_32_64 #-}+caseWordSize_32_64 :: a -- Value to use for 32-bit 'Word's+                   -> a -- Value to use for 64-bit 'Word's+                   -> a+caseWordSize_32_64 f32 f64 = case bitSize (undefined :: Word) of+    32 -> f32+    64 -> f64+    s  -> error $ "caseWordSize_32_64: unsupported Word bit-size " ++ show s++
+ Data/ByteString/Lazy/Builder/Extras.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE BangPatterns #-}+-----------------------------------------------------------------------------+-- | Copyright : (c) 2010      Jasper Van der Jeugt+--               (c) 2010-2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Portability : GHC+--+-- Extra functions for creating and executing 'Builder's. They are intended+-- for application-specific fine-tuning the performance of 'Builder's.+--+-----------------------------------------------------------------------------+module Data.ByteString.Lazy.Builder.Extras+    (+    -- * Execution strategies+      toLazyByteStringWith+    , AllocationStrategy+    , safeStrategy+    , untrimmedStrategy+    , smallChunkSize+    , defaultChunkSize++    -- * Controlling chunk boundaries+    , byteStringCopy+    , byteStringInsert+    , byteStringThreshold++    , lazyByteStringCopy+    , lazyByteStringInsert+    , lazyByteStringThreshold++    , flush++    -- * Host-specific binary encodings+    , intHost+    , int16Host+    , int32Host+    , int64Host++    , wordHost+    , word16Host+    , word32Host+    , word64Host++    , floatHost+    , doubleHost++    ) where+++import Data.ByteString.Lazy.Builder.Internal++import qualified Data.ByteString.Lazy.Builder.BasicEncoding as E+++import Foreign++++------------------------------------------------------------------------------+-- Host-specific encodings+------------------------------------------------------------------------------++-- | Encode a single native machine 'Int'. The 'Int' is encoded in host order,+-- host endian form, for the machine you're on. On a 64 bit machine the 'Int'+-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values encoded this way+-- are not portable to different endian or int sized machines, without+-- conversion.+--+{-# INLINE intHost #-}+intHost :: Int -> Builder+intHost = E.encodeWithF E.intHost++-- | Encode a 'Int16' in native host order and host endianness.+{-# INLINE int16Host #-}+int16Host :: Int16 -> Builder+int16Host = E.encodeWithF E.int16Host++-- | Encode a 'Int32' in native host order and host endianness.+{-# INLINE int32Host #-}+int32Host :: Int32 -> Builder+int32Host = E.encodeWithF E.int32Host++-- | Encode a 'Int64' in native host order and host endianness.+{-# INLINE int64Host #-}+int64Host :: Int64 -> Builder+int64Host = E.encodeWithF E.int64Host++-- | Encode a single native machine 'Word'. The 'Word' is encoded in host order,+-- host endian form, for the machine you're on. On a 64 bit machine the 'Word'+-- is an 8 byte value, on a 32 bit machine, 4 bytes. Values encoded this way+-- are not portable to different endian or word sized machines, without+-- conversion.+--+{-# INLINE wordHost #-}+wordHost :: Word -> Builder+wordHost = E.encodeWithF E.wordHost++-- | Encode a 'Word16' in native host order and host endianness.+{-# INLINE word16Host #-}+word16Host :: Word16 -> Builder+word16Host = E.encodeWithF E.word16Host++-- | Encode a 'Word32' in native host order and host endianness.+{-# INLINE word32Host #-}+word32Host :: Word32 -> Builder+word32Host = E.encodeWithF E.word32Host++-- | Encode a 'Word64' in native host order and host endianness.+{-# INLINE word64Host #-}+word64Host :: Word64 -> Builder+word64Host = E.encodeWithF E.word64Host++-- | Encode a 'Float' in native host order. Values encoded this way are not+-- portable to different endian machines, without conversion.+{-# INLINE floatHost #-}+floatHost :: Float -> Builder+floatHost = E.encodeWithF E.floatHost++-- | Encode a 'Double' in native host order.+{-# INLINE doubleHost #-}+doubleHost :: Double -> Builder+doubleHost = E.encodeWithF E.doubleHost+
+ Data/ByteString/Lazy/Builder/Internal.hs view
@@ -0,0 +1,854 @@+{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns, Rank2Types #-}+{-# OPTIONS_HADDOCK hide #-}+-- | Copyright : (c) 2010 - 2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : GHC+--+-- Core types and functions for the 'Builder' monoid and its generalization,+-- the 'Put' monad.+--+-- The design of the 'Builder' monoid is optimized such that+--+--   1. buffers of arbitrary size can be filled as efficiently as possible and+--+--   2. sequencing of 'Builder's is as cheap as possible.+--+-- We achieve (1) by completely handing over control over writing to the buffer+-- to the 'BuildStep' implementing the 'Builder'. This 'BuildStep' is just told+-- the start and the end of the buffer (represented as a 'BufferRange'). Then,+-- the 'BuildStep' can write to as big a prefix of this 'BufferRange' in any+-- way it desires. If the 'BuildStep' is done, the 'BufferRange' is full, or a+-- long sequence of bytes should be inserted directly, then the 'BuildStep'+-- signals this to its caller using a 'BuildSignal'.+--+-- We achieve (2) by requiring that every 'Builder' is implemented by a+-- 'BuildStep' that takes a continuation 'BuildStep', which it calls with the+-- updated 'BufferRange' after it is done. Therefore, only two pointers have+-- to be passed in a function call to implement concatentation of 'Builder's.+-- Moreover, many 'Builder's are completely inlined, which enables the compiler+-- to sequence them without a function call and with no boxing at all.+--+-- This design gives the implementation of a 'Builder' full access to the 'IO'+-- monad. Therefore, utmost care has to be taken to not overwrite anything+-- outside the given 'BufferRange's. Moreover, further care has to be taken to+-- ensure that 'Builder's and 'Put's are referentially transparent. See the+-- comments of the 'builder' and 'put' functions for further information.+-- Note that there are /no safety belts/ at all, when implementing a 'Builder'+-- using an 'IO' action: you are writing code that might enable the next+-- buffer-overlow attack on a Haskell server!+--+module Data.ByteString.Lazy.Builder.Internal (++  -- * Build signals and steps+    BufferRange(..)+  , LazyByteStringC++  , BuildSignal+  , BuildStep++  , done+  , bufferFull+  , insertChunks++  , fillWithBuildStep++  -- * The Builder monoid+  , Builder+  , builder+  , runBuilder+  , runBuilderWith++  -- ** Primitive combinators+  , empty+  , append+  , flush+  , ensureFree++  , byteStringCopy+  , byteStringInsert+  , byteStringThreshold++  , lazyByteStringCopy+  , lazyByteStringInsert+  , lazyByteStringThreshold++  , lazyByteStringC++  , maximalCopySize+  , byteString+  , lazyByteString++  -- ** Execution strategies+  , toLazyByteStringWith+  , AllocationStrategy+  , safeStrategy+  , untrimmedStrategy+  , L.smallChunkSize+  , L.defaultChunkSize++  -- * The Put monad+  , Put+  , put+  , runPut+  , hPut++  -- ** Streams of chunks interleaved with IO+  , ChunkIOStream(..)+  , buildStepToCIOS+  , ciosToLazyByteString++  -- ** Conversion to and from Builders+  , putBuilder+  , fromPut++  -- ** Lifting IO actions+  -- , putLiftIO++) where++import Control.Applicative (Applicative(..), (<$>))++import Data.Monoid+import qualified Data.ByteString               as S+import qualified Data.ByteString.Internal      as S+import qualified Data.ByteString.Lazy.Internal as L++#if __GLASGOW_HASKELL__ >= 611+import GHC.IO.Buffer (Buffer(..), newByteBuffer)+import GHC.IO.Handle.Internals (wantWritableHandle, flushWriteBuffer)+import GHC.IO.Handle.Types (Handle__, haByteBuffer, haBufferMode)+import System.IO (hFlush, BufferMode(..))+import Data.IORef+#else+import qualified Data.ByteString.Lazy as L+#endif+import System.IO (Handle)++#if MIN_VERSION_base(4,4,0)+import Foreign hiding (unsafePerformIO, unsafeForeignPtrToPtr)+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import System.IO.Unsafe (unsafePerformIO)+#else+import Foreign+#endif+++type LazyByteStringC = L.ByteString -> L.ByteString++-- | A range of bytes in a buffer represented by the pointer to the first byte+-- of the range and the pointer to the first byte /after/ the range.+data BufferRange = BufferRange {-# UNPACK #-} !(Ptr Word8)  -- First byte of range+                               {-# UNPACK #-} !(Ptr Word8)  -- First byte /after/ range+++------------------------------------------------------------------------------+-- Build signals+------------------------------------------------------------------------------++-- | 'BuildStep's may assume that they are called at most once. However,+-- they must not execute any function that may rise an async. exception,+-- as this would invalidate the code of 'hPut' below.+type BuildStep a = BufferRange -> IO (BuildSignal a)++-- | 'BuildSignal's abstract signals to the caller of a 'BuildStep'. There are+-- exactly three signals: 'done', 'bufferFull', and 'insertChunks'.+data BuildSignal a =+    Done {-# UNPACK #-} !(Ptr Word8) a+  | BufferFull+      {-# UNPACK #-} !Int+      {-# UNPACK #-} !(Ptr Word8)+                     !(BuildStep a)+  | InsertChunks+      {-# UNPACK #-} !(Ptr Word8)+      {-# UNPACK #-} !Int64                   -- size of bytes in continuation+                      LazyByteStringC+                     !(BuildStep a)++-- | Signal that the current 'BuildStep' is done and has computed a value.+{-# INLINE done #-}+done :: Ptr Word8      -- ^ Next free byte in current 'BufferRange'+     -> a              -- ^ Computed value+     -> BuildSignal a+done = Done++-- | Signal that the current buffer is full.+{-# INLINE bufferFull #-}+bufferFull :: Int+           -- ^ Minimal size of next 'BufferRange'.+           -> Ptr Word8+           -- ^ Next free byte in current 'BufferRange'.+           -> BuildStep a+           -- ^ 'BuildStep' to run on the next 'BufferRange'. This 'BuildStep'+           -- may assume that it is called with a 'BufferRange' of at least the+           -- required minimal size; i.e., the caller of this 'BuildStep' must+           -- guarantee this.+           -> BuildSignal a+bufferFull = BufferFull++-- TODO: Decide whether we should inline the bytestring constructor.+-- Therefore, making builders independent of strict bytestrings.++-- | Signal that several chunks should be inserted directly.+{-# INLINE insertChunks #-}+insertChunks :: Ptr Word8+            -- ^ Next free byte in current 'BufferRange'+            -> Int64+            -- ^ Number of bytes in 'L.ByteString' continuation.+            -> (L.ByteString -> L.ByteString)+            -- ^ Chunks to insert.+            -> BuildStep a+            -- ^ 'BuildStep' to run on next 'BufferRange'+            -> BuildSignal a+insertChunks = InsertChunks++-- | Fill a 'BufferRange' using a 'BuildStep'.+{-# INLINE fillWithBuildStep #-}+fillWithBuildStep+    :: BuildStep a+    -- ^ Build step to use for filling the 'BufferRange'.+    -> (Ptr Word8 -> a -> IO b)+    -- ^ Handling the 'done' signal+    -> (Ptr Word8 -> Int -> BuildStep a -> IO b)+    -- ^ Handling the 'bufferFull' signal+    -> (Ptr Word8 -> Int64 -> LazyByteStringC -> BuildStep a -> IO b)+    -- ^ Handling the 'insertChunks' signal+    -> BufferRange+    -- ^ Buffer range to fill.+    -> IO b+    -- ^ Value computed by filling this 'BufferRange'.+fillWithBuildStep step fDone fFull fChunk !br = do+    signal <- step br+    case signal of+        Done op x                         -> fDone op x+        BufferFull minSize op nextStep    -> fFull op minSize nextStep+        InsertChunks op len lbsC nextStep -> fChunk op len lbsC nextStep++++------------------------------------------------------------------------------+-- The 'Builder' monoid+------------------------------------------------------------------------------++-- | 'Builder's denote sequences of bytes.+-- They are 'Monoid's where+--   'mempty' is the zero-length sequence and+--   'mappend' is concatenation, which runs in /O(1)/.+newtype Builder = Builder (forall r. BuildStep r -> BuildStep r)++-- | Construct a 'Builder'. In contrast to 'BuildStep's, 'Builder's are+-- referentially transparent.+{-# INLINE builder #-}+builder :: (forall r. BuildStep r -> BuildStep r)+        -- ^ A function that fills a 'BufferRange', calls the continuation with+        -- the updated 'BufferRange' once its done, and signals its caller how+        -- to proceed using 'done', 'bufferFull', or 'insertChunk'.+        --+        -- This function must be referentially transparent; i.e., calling it+        -- multiple times must result in the same sequence of bytes being+        -- written. If you need mutable state, then you must allocate it newly+        -- upon each call of this function. Moroever, this function must call+        -- the continuation once its done. Otherwise, concatenation of+        -- 'Builder's does not work. Finally, this function must write to all+        -- bytes that it claims it has written. Otherwise, the resulting+        -- 'Builder' is not guaranteed to be referentially transparent and+        -- sensitive data might leak.+        -> Builder+builder = Builder++-- | Run a 'Builder'.+{-# INLINE runBuilder #-}+runBuilder :: Builder      -- ^ 'Builder' to run+           -> BuildStep () -- ^ 'BuildStep' that writes the byte stream of this+                           -- 'Builder' and signals 'done' upon completion.+runBuilder (Builder b) = b $ \(BufferRange op _) -> return $ done op ()++-- | Run a 'Builder'.+{-# INLINE runBuilderWith #-}+runBuilderWith :: Builder      -- ^ 'Builder' to run+               -> BuildStep a -- ^ Continuation 'BuildStep'+               -> BuildStep a+runBuilderWith (Builder b) = b++-- | The 'Builder' denoting a zero-length sequence of bytes. This function is+-- only exported for use in rewriting rules. Use 'mempty' otherwise.+{-# INLINE[1] empty #-}+empty :: Builder+empty = Builder id++-- | Concatenate two 'Builder's. This function is only exported for use in rewriting+-- rules. Use 'mappend' otherwise.+{-# INLINE[1] append #-}+append :: Builder -> Builder -> Builder+append (Builder b1) (Builder b2) = Builder $ b1 . b2++instance Monoid Builder where+  {-# INLINE mempty #-}+  mempty = empty+  {-# INLINE mappend #-}+  mappend = append+  {-# INLINE mconcat #-}+  mconcat = foldr mappend mempty++-- | Flush the current buffer. This introduces a chunk boundary.+--+{-# INLINE flush #-}+flush :: Builder+flush = builder step+  where+    step k !(BufferRange op _) = return $ insertChunks op 0 id k+++------------------------------------------------------------------------------+-- Put+------------------------------------------------------------------------------++-- | A 'Put' action denotes a computation of a value that writes a stream of+-- bytes as a side-effect. 'Put's are strict in their side-effect; i.e., the+-- stream of bytes will always be written before the computed value is+-- returned.+--+-- 'Put's are a generalization of 'Builder's. They are used when values need to+-- be returned during the computation of a stream of bytes. For example, when+-- performing a block-based encoding of 'S.ByteString's like Base64 encoding,+-- there might be a left-over partial block. Using the 'Put' monad, this+-- partial block can be returned after the complete blocks have been encoded.+-- Then, in a later step when more input is known, this partial block can be+-- completed and also encoded.+--+-- @Put ()@ actions are isomorphic to 'Builder's. The functions 'putBuilder'+-- and 'fromPut' convert between these two types. Where possible, you should+-- use 'Builder's, as they are slightly cheaper than 'Put's because they do not+-- carry a computed value.+newtype Put a = Put { unPut :: forall r. (a -> BuildStep r) -> BuildStep r }++-- | Construct a 'Put' action. In contrast to 'BuildStep's, 'Put's are+-- referentially transparent in the sense that sequencing the same 'Put'+-- multiple times yields every time the same value with the same side-effect.+{-# INLINE put #-}+put :: (forall r. (a -> BuildStep r) -> BuildStep r)+       -- ^ A function that fills a 'BufferRange', calls the continuation with+       -- the updated 'BufferRange' and its computed value once its done, and+       -- signals its caller how to proceed using 'done', 'bufferFull', or+       -- 'insertChunk'.+       --+       -- This function must be referentially transparent; i.e., calling it+       -- multiple times must result in the same sequence of bytes being+       -- written and the same value being computed. If you need mutable state,+       -- then you must allocate it newly upon each call of this function.+       -- Moroever, this function must call the continuation once its done.+       -- Otherwise, monadic sequencing of 'Put's does not work. Finally, this+       -- function must write to all bytes that it claims it has written.+       -- Otherwise, the resulting 'Put' is not guaranteed to be referentially+       -- transparent and sensitive data might leak.+       -> Put a+put = Put++-- | Run a 'Put'.+{-# INLINE runPut #-}+runPut :: Put a       -- ^ Put to run+       -> BuildStep a -- ^ 'BuildStep' that first writes the byte stream of+                      -- this 'Put' and then yields the computed value using+                      -- the 'done' signal.+runPut (Put p) = p $ \x (BufferRange op _) -> return $ Done op x++instance Functor Put where+  fmap f p = Put $ \k -> unPut p (\x -> k (f x))+  {-# INLINE fmap #-}++instance Applicative Put where+  {-# INLINE pure #-}+  pure x = Put $ \k -> k x+  {-# INLINE (<*>) #-}+  Put f <*> Put a = Put $ \k -> f (\f' -> a (\a' -> k (f' a')))+#if MIN_VERSION_base(4,2,0)+  {-# INLINE (<*) #-}+  Put a <* Put b = Put $ \k -> a (\a' -> b (\_ -> k a'))+  {-# INLINE (*>) #-}+  Put a *> Put b = Put $ \k -> a (\_ -> b k)+#endif++instance Monad Put where+  {-# INLINE return #-}+  return x = Put $ \k -> k x+  {-# INLINE (>>=) #-}+  Put m >>= f = Put $ \k -> m (\m' -> unPut (f m') k)+  {-# INLINE (>>) #-}+  Put m >> Put n = Put $ \k -> m (\_ -> n k)+++-- Conversion between Put and Builder+-------------------------------------++-- | Run a 'Builder' as a side-effect of a @Put ()@ action.+{-# INLINE putBuilder #-}+putBuilder :: Builder -> Put ()+putBuilder (Builder b) = Put $ \k -> b (k ())++-- | Convert a @Put ()@ action to a 'Builder'.+{-# INLINE fromPut #-}+fromPut :: Put () -> Builder+fromPut (Put p) = Builder $ \k -> p (\_ -> k)+++-- Lifting IO actions+---------------------++{-+-- | Lift an 'IO' action to a 'Put' action.+{-# INLINE putLiftIO #-}+putLiftIO :: IO a -> Put a+putLiftIO io = put $ \k br -> io >>= (`k` br)+-}+++------------------------------------------------------------------------------+-- Executing a Put directly on a buffered Handle+------------------------------------------------------------------------------++-- | Run a 'Put' action redirecting the produced output to a 'Handle'.+--+-- The output is buffered using the 'Handle's associated buffer. If this+-- buffer is too small to execute one step of the 'Put' action, then+-- it is replaced with a large enough buffer.+hPut :: forall a. Handle -> Put a -> IO a+#if __GLASGOW_HASKELL__ >= 611+hPut h p = do+    fillHandle 1 (runPut p)+  where+    fillHandle :: Int -> BuildStep a -> IO a+    fillHandle !minFree step = do+        next <- wantWritableHandle "hPut" h fillHandle_+        next+      where+        -- | We need to return an inner IO action that is executed outside+        -- the lock taken on the Handle for two reasons:+        --+        --   1. GHC.IO.Handle.Internals mentions in "Note [async]" that+        --      we should never do any side-effecting operations before+        --      an interuptible operation that may raise an async. exception+        --      as long as we are inside 'wantWritableHandle' and the like.+        --      We possibly run the interuptible 'flushWriteBuffer' right at+        --      the start of 'fillHandle', hence entering it a second time is+        --      not safe, as it could lead to a 'BuildStep' being run twice.+        --+        --   2. We use the 'S.hPut' function to also write to the handle.+        --      This function tries to take the same lock taken by+        --      'wantWritableHandle'. Therefore, we cannot call 'S.hPut'+        --      inside 'wantWritableHandle'.+        --+        fillHandle_ :: Handle__ -> IO (IO a)+        fillHandle_ h_ = do+            makeSpace  =<< readIORef refBuf+            fillBuffer =<< readIORef refBuf+          where+            refBuf        = haByteBuffer h_+            freeSpace buf = bufSize buf - bufR buf++            makeSpace buf+              | bufSize buf < minFree = do+                  flushWriteBuffer h_+                  s <- bufState <$> readIORef refBuf+                  newByteBuffer minFree s >>= writeIORef refBuf++              | freeSpace buf < minFree = flushWriteBuffer h_+              | otherwise               =+#if __GLASGOW_HASKELL__ >= 613+                                          return ()+#else+                                          -- required for ghc-6.12+                                          flushWriteBuffer h_+#endif++            fillBuffer buf+              | freeSpace buf < minFree =+                  error $ unlines+                    [ "Data.ByteString.Lazy.Builder.Internal.hPut: internal error."+                    , "  Not enough space after flush."+                    , "    required: " ++ show minFree+                    , "    free: "     ++ show (freeSpace buf)+                    ]+              | otherwise = do+                  let !br = BufferRange op (pBuf `plusPtr` bufSize buf)+                  res <- fillWithBuildStep step doneH fullH insertChunksH br+                  touchForeignPtr fpBuf+                  return res+              where+                fpBuf = bufRaw buf+                pBuf  = unsafeForeignPtrToPtr fpBuf+                op    = pBuf `plusPtr` bufR buf++                {-# INLINE updateBufR #-}+                updateBufR op' = do+                    let !off' = op' `minusPtr` pBuf+                        !buf' = buf {bufR = off'}+                    writeIORef refBuf buf'++                doneH op' x = do+                    updateBufR op'+                    -- We must flush if this Handle is set to NoBuffering.+                    -- If it is set to LineBuffering, be conservative and+                    -- flush anyway (we didn't check for newlines in the data).+                    -- Flushing must happen outside this 'wantWriteableHandle'+                    -- due to the possible async. exception.+                    case haBufferMode h_ of+                        BlockBuffering _      -> return $ return x+                        _line_or_no_buffering -> return $ hFlush h >> return x++                fullH op' minSize nextStep = do+                    updateBufR op'+                    return $ fillHandle minSize nextStep+                    -- 'fillHandle' will flush the buffer (provided there is+                    -- really less than 'minSize' space left) before executing+                    -- the 'nextStep'.++                insertChunksH op' _ lbsC nextStep = do+                    updateBufR op'+                    return $ do+                        L.foldrChunks (\c rest -> S.hPut h c >> rest) (return ())+                                      (lbsC L.Empty)+                        fillHandle 1 nextStep+#else+hPut h p =+    go =<< buildStepToCIOS strategy (return . Finished) (runPut p)+  where+    go (Finished k)       = return k+    go (Yield1 bs io)     = S.hPut h bs >> io >>= go+    go (YieldC _ lbsC io) = L.hPut h (lbsC L.Empty) >> io >>= go+    strategy = untrimmedStrategy L.smallChunkSize L.defaultChunkSize+#endif++------------------------------------------------------------------------------+-- ByteString insertion / controlling chunk boundaries+------------------------------------------------------------------------------++-- Raw memory+-------------++-- | Ensure that there are at least 'n' free bytes for the following 'Builder'.+{-# INLINE ensureFree #-}+ensureFree :: Int -> Builder+ensureFree minFree =+    builder step+  where+    step k br@(BufferRange op ope)+      | ope `minusPtr` op < minFree = return $ bufferFull minFree op k+      | otherwise                   = k br++-- | Copy the bytes from a 'BufferRange' into the output stream.+{-# INLINE bytesCopyStep #-}+bytesCopyStep :: BufferRange  -- ^ Input 'BufferRange'.+              -> BuildStep a -> BuildStep a+bytesCopyStep !(BufferRange ip0 ipe) k =+    go ip0+  where+    go !ip !(BufferRange op ope)+      | inpRemaining <= outRemaining = do+          copyBytes op ip inpRemaining+          let !br' = BufferRange (op `plusPtr` inpRemaining) ope+          k br'+      | otherwise = do+          copyBytes op ip outRemaining+          let !ip' = ip `plusPtr` outRemaining+          return $ bufferFull 1 ope (go ip')+      where+        outRemaining = ope `minusPtr` op+        inpRemaining = ipe `minusPtr` ip++++-- Strict ByteStrings+------------------------------------------------------------------------------+++-- | Construct a 'Builder' that copies the strict 'S.ByteString's, if it is+-- smaller than the treshold, and inserts it directly otherwise.+--+-- For example, @byteStringThreshold 1024@ copies strict 'S.ByteString's whose size+-- is less or equal to 1kb, and inserts them directly otherwise. This implies+-- that the average chunk-size of the generated lazy 'L.ByteString' may be as+-- low as 513 bytes, as there could always be just a single byte between the+-- directly inserted 1025 byte, strict 'S.ByteString's.+--+{-# INLINE byteStringThreshold #-}+byteStringThreshold :: Int -> S.ByteString -> Builder+byteStringThreshold maxCopySize =+    \bs -> builder $ step bs+  where+    step !bs@(S.PS _ _ len) !k br@(BufferRange !op _)+      | len <= maxCopySize = byteStringCopyStep bs k br+      | otherwise          =+          return $! insertChunks op (fromIntegral len) (L.chunk bs) k++-- | Construct a 'Builder' that copies the strict 'S.ByteString'.+--+-- Use this function to create 'Builder's from smallish (@<= 4kb@)+-- 'S.ByteString's or if you need to guarantee that the 'S.ByteString' is not+-- shared with the chunks generated by the 'Builder'.+--+{-# INLINE byteStringCopy #-}+byteStringCopy :: S.ByteString -> Builder+byteStringCopy = \bs -> builder $ byteStringCopyStep bs++{-# INLINE byteStringCopyStep #-}+byteStringCopyStep :: S.ByteString -> BuildStep a -> BuildStep a+byteStringCopyStep (S.PS ifp ioff isize) !k0 =+    bytesCopyStep (BufferRange ip ipe) k+  where+    ip   = unsafeForeignPtrToPtr ifp `plusPtr` ioff+    ipe  = ip `plusPtr` isize+    k br = do touchForeignPtr ifp  -- input consumed: OK to release here+              k0 br++-- | Construct a 'Builder' that always inserts the strict 'S.ByteString'+-- directly as a chunk.+--+-- This implies flushing the output buffer, even if it contains just+-- a single byte. You should therefore use 'byteStringInsert' only for large+-- (@> 8kb@) 'S.ByteString's. Otherwise, the generated chunks are too+-- fragmented to be processed efficiently afterwards.+--+{-# INLINE byteStringInsert #-}+byteStringInsert :: S.ByteString -> Builder+byteStringInsert =+    \bs -> builder $ step bs+  where+    step !bs k !br@(BufferRange op _)+      | S.null bs = k br+      | otherwise =+          return $ insertChunks op (fromIntegral $ S.length bs) (L.Chunk bs) k+++-- Lazy bytestrings+------------------------------------------------------------------------------++-- | Construct a 'Builder' that uses the thresholding strategy of 'byteStringThreshold'+-- for each chunk of the lazy 'L.ByteString'.+--+{-# INLINE lazyByteStringThreshold #-}+lazyByteStringThreshold :: Int -> L.ByteString -> Builder+lazyByteStringThreshold maxCopySize =+    L.foldrChunks (\bs b -> byteStringThreshold maxCopySize bs `mappend` b) mempty+    -- TODO: We could do better here. Currently, Large, Small, Large, leads to+    -- an unnecessary copy of the 'Small' chunk.++-- | Construct a 'Builder' that copies the lazy 'L.ByteString'.+--+{-# INLINE lazyByteStringCopy #-}+lazyByteStringCopy :: L.ByteString -> Builder+lazyByteStringCopy =+    L.foldrChunks (\bs b -> byteStringCopy bs `mappend` b) mempty+++-- | Construct a 'Builder' that inserts all chunks of the lazy 'L.ByteString'+-- directly.+--+{-# INLINE lazyByteStringInsert #-}+lazyByteStringInsert :: L.ByteString -> Builder+lazyByteStringInsert =+    \lbs -> builder $ step lbs+  where+    step L.Empty k br                 = k br+    step lbs     k (BufferRange op _) = case go 0 id lbs of+        (n, lbsC) -> return $ insertChunks op n lbsC k++    go !n lbsC L.Empty          = (n, lbsC)+    go !n lbsC (L.Chunk bs lbs) =+        go (n + fromIntegral (S.length bs)) (lbsC . L.Chunk bs) lbs+++-- | Create a 'Builder' denoting the same sequence of bytes as a strict+-- 'S.ByteString'.+-- The 'Builder' inserts large 'S.ByteString's directly, but copies small ones+-- to ensure that the generated chunks are large on average.+--+{-# INLINE byteString #-}+byteString :: S.ByteString -> Builder+byteString = byteStringThreshold maximalCopySize++-- | Create a 'Builder' denoting the same sequence of bytes as a lazy+-- 'S.ByteString'.+-- The 'Builder' inserts large chunks of the lazy 'L.ByteString' directly,+-- but copies small ones to ensure that the generated chunks are large on+-- average.+--+{-# INLINE lazyByteString #-}+lazyByteString :: L.ByteString -> Builder+lazyByteString = lazyByteStringThreshold maximalCopySize+-- FIXME: also insert the small chunk for [large,small,large] directly.+-- Perhaps it makes even sense to concatenate the small chunks in+-- [large,small,small,small,large] and insert them directly afterwards to avoid+-- unnecessary buffer spilling. Hmm, but that uncontrollably increases latency+-- => no good!++-- | The maximal size of a 'S.ByteString' that is copied.+-- @2 * 'L.smallChunkSize'@ to guarantee that on average a chunk is of+-- 'L.smallChunkSize'.+maximalCopySize :: Int+maximalCopySize = 2 * L.smallChunkSize++-- LazyByteStringC: difference lists of lazy bytestrings+--------------------------------------------------------++-- | Insert a 'LazyByteStringC' of the given size directly.+{-# INLINE lazyByteStringC #-}+lazyByteStringC :: Int64 -> LazyByteStringC -> Builder+lazyByteStringC n lbsC =+    builder $ \k (BufferRange op _) -> return $ insertChunks op n lbsC k++------------------------------------------------------------------------------+-- Builder execution+------------------------------------------------------------------------------++-- | A buffer allocation strategy for executing 'Builder's.++-- The strategy+--+-- > 'AllocationStrategy' firstBufSize bufSize trim+--+-- states that the first buffer is of size @firstBufSize@, all following buffers+-- are of size @bufSize@, and a buffer of size @n@ filled with @k@ bytes should+-- be trimmed iff @trim k n@ is 'True'.+data AllocationStrategy = AllocationStrategy+         {-# UNPACK #-} !Int  -- size of first buffer+         {-# UNPACK #-} !Int  -- size of successive buffers+         (Int -> Int -> Bool) -- trim++-- | Sanitize a buffer size; i.e., make it at least the size of a 'Int'.+{-# INLINE sanitize #-}+sanitize :: Int -> Int+sanitize = max (sizeOf (undefined :: Int))++-- | Use this strategy for generating lazy 'L.ByteString's whose chunks are+-- discarded right after they are generated. For example, if you just generate+-- them to write them to a network socket.+{-# INLINE untrimmedStrategy #-}+untrimmedStrategy :: Int -- ^ Size of the first buffer+                  -> Int -- ^ Size of successive buffers+                  -> AllocationStrategy+                  -- ^ An allocation strategy that does not trim any of the+                  -- filled buffers before converting it to a chunk.+untrimmedStrategy firstSize bufSize =+    AllocationStrategy (sanitize firstSize) (sanitize bufSize) (\_ _ -> False)+++-- | Use this strategy for generating lazy 'L.ByteString's whose chunks are+-- likely to survive one garbage collection. This strategy trims buffers+-- that are filled less than half in order to avoid spilling too much memory.+{-# INLINE safeStrategy #-}+safeStrategy :: Int  -- ^ Size of first buffer+             -> Int  -- ^ Size of successive buffers+             -> AllocationStrategy+             -- ^ An allocation strategy that guarantees that at least half+             -- of the allocated memory is used for live data+safeStrategy firstSize bufSize =+    AllocationStrategy (sanitize firstSize) (sanitize bufSize)+                       (\used size -> 2*used < size)++-- | Execute a 'Builder' with custom execution parameters.+--+-- This function is forced to be inlined to allow fusing with the allocation+-- strategy despite its rather heavy code-size. We therefore recommend+-- that you introduce a top-level function once you have fixed your strategy.+-- This avoids unnecessary code duplication.+-- For example, the default 'Builder' execution function 'toLazyByteString' is+-- defined as follows.+--+-- @+-- {-# NOINLINE toLazyByteString #-}+-- toLazyByteString =+--   toLazyByteStringWith ('safeStrategy' 'L.smallChunkSize' 'L.defaultChunkSize') empty+-- @+--+-- where @empty@ is the zero-length lazy 'L.ByteString'.+--+-- In most cases, the parameters used by 'toLazyByteString' give good+-- performance. A sub-performing case of 'toLazyByteString' is executing short+-- (<128 bytes) 'Builder's. In this case, the allocation overhead for the first+-- 4kb buffer and the trimming cost dominate the cost of executing the+-- 'Builder'. You can avoid this problem using+--+-- >toLazyByteStringWith (safeStrategy 128 smallChunkSize) empty+--+-- This reduces the allocation and trimming overhead, as all generated+-- 'L.ByteString's fit into the first buffer and there is no trimming+-- required, if more than 64 bytes are written.+--+{-# INLINE toLazyByteStringWith #-}+toLazyByteStringWith+    :: AllocationStrategy+       -- ^ Buffer allocation strategy to use+    -> L.ByteString+       -- ^ Lazy 'L.ByteString' to use as the tail of the generated lazy+       -- 'L.ByteString'+    -> Builder+       -- ^ Builder to execute+    -> L.ByteString+       -- ^ Resulting lazy 'L.ByteString'+toLazyByteStringWith strategy k b =+    ciosToLazyByteString k $ unsafePerformIO $+        buildStepToCIOS strategy (return . Finished) (runBuilder b)++-- | A stream of non-empty chunks interleaved with 'IO'.+data ChunkIOStream a =+       Finished a+     | Yield1 {-# UNPACK #-} !S.ByteString (IO (ChunkIOStream a))+     | YieldC {-# UNPACK #-} !Int64 LazyByteStringC (IO (ChunkIOStream a))++{-# INLINE ciosToLazyByteString #-}+ciosToLazyByteString :: L.ByteString -> ChunkIOStream () -> L.ByteString+ciosToLazyByteString k = go+  where+    go (Finished _)       = k+    go (Yield1 bs io)     = L.Chunk bs $ unsafePerformIO (go <$> io)+    go (YieldC _ lbsC io) = lbsC $ unsafePerformIO (go <$> io)++{-# INLINE buildStepToCIOS #-}+buildStepToCIOS+    :: AllocationStrategy          -- ^ Buffer allocation strategy to use+    -> (a -> IO (ChunkIOStream b)) -- ^ Continuation stream constructor.+    -> BuildStep a                 -- ^ 'Put' to execute+    -> IO (ChunkIOStream b)+buildStepToCIOS (AllocationStrategy firstSize bufSize trim) k =+    \step -> fillNew step firstSize+  where+    fillNew !step0 !size = do+        S.mallocByteString size >>= fill step0+      where+        fill !step !fpbuf = do+            res <- fillWithBuildStep step doneH fullH insertChunksH br+            touchForeignPtr fpbuf+            return res+          where+            op = unsafeForeignPtrToPtr fpbuf -- safe due to mkCIOS+            pe = op `plusPtr` size+            br = BufferRange op pe++            doneH op' x = wrapChunk op' (const $ k x)++            fullH op' minSize nextStep =+                wrapChunk op' (const $ fillNew nextStep (max minSize bufSize))++            insertChunksH op' n lbsC nextStep =+                wrapChunk op' $ \isEmpty -> return $ YieldC n lbsC $+                    -- Checking for empty case avoids allocating 'n-1' empty+                    -- buffers for 'n' insertChunksH right after each other.+                    if isEmpty+                      then fill nextStep fpbuf+                      else fillNew nextStep bufSize++            -- Yield a chunk, trimming it if necesary+            {-# INLINE wrapChunk #-}+            wrapChunk !op' mkCIOS+              | pe < op'            = error $+                  "buildStepToCIOS: overwrite by " ++ show (op' `minusPtr` pe) ++ " bytes"+              | chunkSize == 0      = mkCIOS True+              | trim chunkSize size = do+                  bs <- S.create chunkSize $ \pbuf -> copyBytes pbuf op chunkSize+                  return $ Yield1 bs (mkCIOS False)+              | otherwise            =+                  return $ Yield1 (S.PS fpbuf 0 chunkSize) (mkCIOS False)+              where+                chunkSize = op' `minusPtr` op
Data/ByteString/Lazy/Char8.hs view
@@ -6,12 +6,13 @@  -- | -- Module      : Data.ByteString.Lazy.Char8--- Copyright   : (c) Don Stewart 2006+-- Copyright   : (c) Don Stewart 2006-2008+--               (c) Duncan Coutts 2006-2011 -- License     : BSD-style ----- Maintainer  : dons@cse.unsw.edu.au--- Stability   : experimental--- Portability : non-portable (imports Data.ByteString.Lazy)+-- Maintainer  : dons00@gmail.com, duncan@community.haskell.org+-- Stability   : stable+-- Portability : portable -- -- Manipulate /lazy/ 'ByteString's using 'Char' operations. All Chars will -- be truncated to 8 bits. It can be expected that these functions will@@ -23,6 +24,11 @@ -- -- > import qualified Data.ByteString.Lazy.Char8 as C --+-- The Char8 interface to bytestrings provides an instance of IsString+-- for the ByteString type, enabling you to use string literals, and+-- have them implicitly packed to ByteStrings.+-- Use @{-\# LANGUAGE OverloadedStrings \#-}@ to enable this.+--  module Data.ByteString.Lazy.Char8 ( @@ -36,6 +42,8 @@         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@@ -183,7 +191,7 @@  -- 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@@ -216,10 +224,6 @@ import IO                   (bracket) #endif -#if __GLASGOW_HASKELL__ >= 608-import Data.String          (IsString(..))-#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@@ -234,20 +238,16 @@ singleton = L.singleton . c2w {-# INLINE singleton #-} -#if __GLASGOW_HASKELL__ >= 608-instance IsString ByteString where-    fromString = pack-    {-# INLINE fromString #-}-#endif- -- | /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`  -- | /O(1)/ 'cons' is analogous to '(:)' for lists. cons :: Char -> ByteString -> ByteString
Data/ByteString/Lazy/Internal.hs view
@@ -1,15 +1,17 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}--- We cannot actually specify all the language pragmas, see ghc ticket #--- If we could, these are what they would be:-{- LANGUAGE DeriveDataTypeable -}+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-}+#if __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable #-}+#endif {-# OPTIONS_HADDOCK hide #-}  -- | -- Module      : Data.ByteString.Lazy.Internal+-- Copyright   : (c) Don Stewart 2006-2008+--               (c) Duncan Coutts 2006-2011 -- License     : BSD-style--- Maintainer  : dons@galois.com, duncan@haskell.org--- Stability   : experimental--- Portability : portable+-- Maintainer  : dons00@gmail.com, duncan@community.haskell.org+-- Stability   : unstable+-- Portability : non-portable --  -- A module containing semi-public 'ByteString' internals. This exposes -- the 'ByteString' representation and low level construction functions.@@ -32,21 +34,39 @@         -- * Chunk allocation sizes         defaultChunkSize,         smallChunkSize,-        chunkOverhead+        chunkOverhead, +        -- * Conversion with lists: packing and unpacking+        packBytes, packChars,+        unpackBytes, unpackChars,+   ) where +import Prelude hiding (concat)+ import qualified Data.ByteString.Internal as S+import qualified Data.ByteString          as S (length, take, drop) +import Data.Word        (Word8) import Foreign.Storable (Storable(sizeOf)) -#if defined(__GLASGOW_HASKELL__)-import Data.Typeable    (Typeable)-#if __GLASGOW_HASKELL__ >= 610-import Data.Data        (Data)+import Data.Monoid      (Monoid(..))+import Control.DeepSeq  (NFData, rnf)++#if MIN_VERSION_base(3,0,0)+import Data.String      (IsString(..))+#endif++import Data.Typeable            (Typeable)+#if MIN_VERSION_base(4,1,0)+import Data.Data                (Data(..))+#if MIN_VERSION_base(4,2,0)+import Data.Data                (mkNoRepType) #else-import Data.Generics    (Data)+import Data.Data                (mkNorepType) #endif+#else+import Data.Generics            (Data(..), mkNorepType) #endif  -- | A space-efficient representation of a Word8 vector, supporting many@@ -55,14 +75,76 @@ -- Instances of Eq, Ord, Read, Show, Data, Typeable -- data ByteString = Empty | Chunk {-# UNPACK #-} !S.ByteString ByteString-    deriving (Show, Read+ #if defined(__GLASGOW_HASKELL__)-                        ,Data, Typeable+    deriving (Typeable) #endif-             ) +instance Eq  ByteString where+    (==)    = eq++instance Ord ByteString where+    compare = cmp++instance Monoid ByteString where+    mempty  = Empty+    mappend = append+    mconcat = concat++instance NFData ByteString where+    rnf Empty       = ()+    rnf (Chunk _ b) = rnf b++instance Show ByteString where+    showsPrec p ps r = showsPrec p (unpackChars ps) r++instance Read ByteString where+    readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ]++#if MIN_VERSION_base(3,0,0)+instance IsString ByteString where+    fromString = packChars+#endif++instance Data ByteString where+  gfoldl f z txt = z packBytes `f` unpackBytes txt+  toConstr _     = error "Data.ByteString.Lazy.ByteString.toConstr"+  gunfold _ _    = error "Data.ByteString.Lazy.ByteString.gunfold"+#if MIN_VERSION_base(4,2,0)+  dataTypeOf _   = mkNoRepType "Data.ByteString.Lazy.ByteString"+#else+  dataTypeOf _   = mkNorepType "Data.ByteString.Lazy.ByteString"+#endif+ ------------------------------------------------------------------------+-- Packing and unpacking from lists +packBytes :: [Word8] -> ByteString+packBytes cs0 =+    packChunks 32 cs0+  where+    packChunks n cs = case S.packUptoLenBytes n cs of+      (bs, [])  -> chunk bs Empty+      (bs, cs') -> Chunk bs (packChunks (min (n * 2) smallChunkSize) cs')++packChars :: [Char] -> ByteString+packChars cs0 =+    packChunks 32 cs0+  where+    packChunks n cs = case S.packUptoLenChars n cs of+      (bs, [])  -> chunk bs Empty+      (bs, cs') -> Chunk bs (packChunks (min (n * 2) smallChunkSize) cs')++unpackBytes :: ByteString -> [Word8]+unpackBytes Empty        = []+unpackBytes (Chunk c cs) = S.unpackAppendBytesLazy c (unpackBytes cs)++unpackChars :: ByteString -> [Char]+unpackChars Empty        = []+unpackChars (Chunk c cs) = S.unpackAppendCharsLazy c (unpackChars cs)++------------------------------------------------------------------------+ -- | The data type invariant: -- Every ByteString is either 'Empty' or consists of non-null 'S.ByteString's. -- All functions must preserve this, and the QC properties must check this.@@ -116,12 +198,12 @@ -- The following value assumes people have something greater than 128k, -- and need to share the cache with other programs. --- | Currently set to 32k, less the memory management overhead+-- | The chunk size used for I\/O. Currently set to 32k, less the memory management overhead defaultChunkSize :: Int defaultChunkSize = 32 * k - chunkOverhead    where k = 1024 --- | Currently set to 4k, less the memory management overhead+-- | The recommended chunk size. Currently set to 4k, less the memory management overhead smallChunkSize :: Int smallChunkSize = 4 * k - chunkOverhead    where k = 1024@@ -129,3 +211,43 @@ -- | The memory management overhead. Currently this is tuned for GHC only. chunkOverhead :: Int chunkOverhead = 2 * sizeOf (undefined :: Int)++------------------------------------------------------------------------+-- Implementations for Eq, Ord and Monoid instances++eq :: ByteString -> ByteString -> Bool+eq Empty Empty = True+eq Empty _     = False+eq _     Empty = False+eq (Chunk a as) (Chunk b bs) =+  case compare (S.length a) (S.length b) of+    LT -> a == (S.take (S.length a) b) && eq as (Chunk (S.drop (S.length a) b) bs)+    EQ -> a == b                       && eq as bs+    GT -> (S.take (S.length b) a) == b && eq (Chunk (S.drop (S.length b) a) as) bs++cmp :: ByteString -> ByteString -> Ordering+cmp Empty Empty = EQ+cmp Empty _     = LT+cmp _     Empty = GT+cmp (Chunk a as) (Chunk b bs) =+  case compare (S.length a) (S.length b) of+    LT -> case compare a (S.take (S.length a) b) of+            EQ     -> cmp as (Chunk (S.drop (S.length a) b) bs)+            result -> result+    EQ -> case compare a b of+            EQ     -> cmp as bs+            result -> result+    GT -> case compare (S.take (S.length b) a) b of+            EQ     -> cmp (Chunk (S.drop (S.length b) a) as) bs+            result -> result++append :: ByteString -> ByteString -> ByteString+append xs ys = foldrChunks Chunk ys xs++concat :: [ByteString] -> ByteString+concat css0 = to css0+  where+    go Empty        css = to css+    go (Chunk c cs) css = Chunk c (go cs css)+    to []               = Empty+    to (cs:css)         = go cs css
Data/ByteString/Unsafe.hs view
@@ -1,14 +1,16 @@ {-# LANGUAGE CPP #-}--- We cannot actually specify all the language pragmas, see ghc ticket #--- If we could, these are what they would be:-{- LANGUAGE MagicHash -}+#if __GLASGOW_HASKELL__+{-# LANGUAGE MagicHash #-}+#endif  -- | -- Module      : Data.ByteString.Unsafe+-- Copyright   : (c) Don Stewart 2006-2008+--               (c) Duncan Coutts 2006-2011 -- License     : BSD-style--- Maintainer  : dons@cse.unsw.edu.au, duncan@haskell.org--- Stability   : experimental--- Portability : portable+-- Maintainer  : dons00@gmail.com, duncan@community.haskell.org+-- Stability   : provisional+-- Portability : non-portable -- -- A module containing unsafe 'ByteString' operations. --
LICENSE view
@@ -1,6 +1,7 @@ Copyright (c) Don Stewart 2005-2009-          (c) Duncan Coutts 2006-2009-          (c) David Roundy 2003-2005.+          (c) Duncan Coutts 2006-2011+          (c) David Roundy 2003-2005+          (c) Simon Meier 2010-2011  All rights reserved.
+ bench/BenchAll.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE PackageImports, ScopedTypeVariables, BangPatterns #-}+-- |+-- Copyright   : (c) 2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : tested on GHC only+--+-- Benchmark all 'Builder' functions.+module Main (main) where++import Prelude hiding (words)+import Criterion.Main+import Data.Foldable (foldMap)++import qualified Data.ByteString                  as S+import qualified Data.ByteString.Lazy             as L++import           Data.ByteString.Lazy.Builder+import           Data.ByteString.Lazy.Builder.ASCII+import           Data.ByteString.Lazy.Builder.BasicEncoding+                   ( FixedEncoding, BoundedEncoding, (>$<) )+import qualified Data.ByteString.Lazy.Builder.BasicEncoding          as E+import qualified Data.ByteString.Lazy.Builder.BasicEncoding.Internal as EI++import Foreign++------------------------------------------------------------------------------+-- Benchmark support+------------------------------------------------------------------------------++countToZero :: Int -> Maybe (Int, Int)+countToZero 0 = Nothing+countToZero n = Just (n, n - 1)+++------------------------------------------------------------------------------+-- Benchmark+------------------------------------------------------------------------------++-- input data (NOINLINE to ensure memoization)+----------------------------------------------++-- | Few-enough repetitions to avoid making GC too expensive.+nRepl :: Int+nRepl = 10000++{-# NOINLINE intData #-}+intData :: [Int]+intData = [1..nRepl]++-- Half of the integers inside the range of an Int and half of them outside.+{-# NOINLINE integerData #-}+integerData :: [Integer]+integerData = map (\x -> fromIntegral x + fromIntegral (maxBound - nRepl `div` 2)) intData++{-# NOINLINE floatData #-}+floatData :: [Float]+floatData = map (\x -> (3.14159 * fromIntegral x) ^ (3 :: Int)) intData++{-# NOINLINE doubleData #-}+doubleData :: [Double]+doubleData = map (\x -> (3.14159 * fromIntegral x) ^ (3 :: Int)) intData++{-# NOINLINE byteStringData #-}+byteStringData :: S.ByteString+byteStringData = S.pack $ map fromIntegral intData++{-# NOINLINE lazyByteStringData #-}+lazyByteStringData :: L.ByteString+lazyByteStringData = case S.splitAt (nRepl `div` 2) byteStringData of+    (bs1, bs2) -> L.fromChunks [bs1, bs2]+++-- benchmark wrappers+---------------------++{-# INLINE benchB #-}+benchB :: String -> a -> (a -> Builder) -> Benchmark+benchB name x b =+    bench (name ++" (" ++ show nRepl ++ ")") $+        whnf (L.length . toLazyByteString . b) x++{-# INLINE benchBInts #-}+benchBInts :: String -> ([Int] -> Builder) -> Benchmark+benchBInts name = benchB name intData++-- | Benchmark a 'FixedEncoding'. Full inlining to enable specialization.+{-# INLINE benchFE #-}+benchFE :: String -> FixedEncoding Int -> Benchmark+benchFE name = benchBE name . E.fromF++-- | Benchmark a 'BoundedEncoding'. Full inlining to enable specialization.+{-# INLINE benchBE #-}+benchBE :: String -> BoundedEncoding Int -> Benchmark+benchBE name e =+  bench (name ++" (" ++ show nRepl ++ ")") $ benchIntEncodingB nRepl e++-- We use this construction of just looping through @n,n-1,..,1@ to ensure that+-- we measure the speed of the encoding and not the speed of generating the+-- values to be encoded.+{-# INLINE benchIntEncodingB #-}+benchIntEncodingB :: Int                  -- ^ Maximal 'Int' to write+                  -> BoundedEncoding Int  -- ^ 'BoundedEncoding' to execute+                  -> IO ()                -- ^ 'IO' action to benchmark+benchIntEncodingB n0 w+  | n0 <= 0   = return ()+  | otherwise = do+      fpbuf <- mallocForeignPtrBytes (n0 * EI.sizeBound w)+      withForeignPtr fpbuf (loop n0) >> return ()+  where+    loop !n !op+      | n <= 0    = return op+      | otherwise = EI.runB w n op >>= loop (n - 1)++++-- benchmarks+-------------++sanityCheckInfo :: [String]+sanityCheckInfo =+  [ "Sanity checks:"+  , " lengths of input data: " ++ show+      [ length intData, length floatData, length doubleData, length integerData+      , S.length byteStringData, fromIntegral (L.length lazyByteStringData)+      ]+  ]++main :: IO ()+main = do+  mapM_ putStrLn sanityCheckInfo+  putStrLn ""+  Criterion.Main.defaultMain+    [ bgroup "Data.ByteString.Lazy.Builder"+      [ bgroup "Encoding wrappers"+        [ benchBInts "foldMap word8" $+            foldMap (word8 . fromIntegral)+        , benchBInts "encodeListWithF word8" $+            E.encodeListWithF (fromIntegral >$< E.word8)+        , benchB     "encodeUnfoldrWithF word8" nRepl $+            E.encodeUnfoldrWithF (fromIntegral >$< E.word8) countToZero+        , benchB     "encodeByteStringWithF word8" byteStringData $+            E.encodeByteStringWithF E.word8+        , benchB     "encodeLazyByteStringWithF word8" lazyByteStringData $+            E.encodeLazyByteStringWithF E.word8+        ]++      , bgroup "Non-bounded encodings"+        [ benchB "foldMap floatDec"        floatData          $ foldMap floatDec+        , benchB "foldMap doubleDec"       doubleData         $ foldMap doubleDec+        , benchB "foldMap integerDec"      integerData        $ foldMap integerDec+        , benchB "byteStringHexFixed"      byteStringData     $ byteStringHexFixed+        , benchB "lazyByteStringHexFixed"  lazyByteStringData $ lazyByteStringHexFixed+        ]+      ]++    , bgroup "Data.ByteString.Lazy.Builder.BasicEncoding"+      [ benchFE "char7"      $ toEnum       >$< E.char7+      , benchFE "char8"      $ toEnum       >$< E.char8+      , benchBE "charUtf8"   $ toEnum       >$< E.charUtf8++      -- binary encoding+      , benchFE "int8"       $ fromIntegral >$< E.int8+      , benchFE "word8"      $ fromIntegral >$< E.word8++      -- big-endian+      , benchFE "int16BE"    $ fromIntegral >$< E.int16BE+      , benchFE "int32BE"    $ fromIntegral >$< E.int32BE+      , benchFE "int64BE"    $ fromIntegral >$< E.int64BE++      , benchFE "word16BE"   $ fromIntegral >$< E.word16BE+      , benchFE "word32BE"   $ fromIntegral >$< E.word32BE+      , benchFE "word64BE"   $ fromIntegral >$< E.word64BE++      , benchFE "floatBE"    $ fromIntegral >$< E.floatBE+      , benchFE "doubleBE"   $ fromIntegral >$< E.doubleBE++      -- little-endian+      , benchFE "int16LE"    $ fromIntegral >$< E.int16LE+      , benchFE "int32LE"    $ fromIntegral >$< E.int32LE+      , benchFE "int64LE"    $ fromIntegral >$< E.int64LE++      , benchFE "word16LE"   $ fromIntegral >$< E.word16LE+      , benchFE "word32LE"   $ fromIntegral >$< E.word32LE+      , benchFE "word64LE"   $ fromIntegral >$< E.word64LE++      , benchFE "floatLE"    $ fromIntegral >$< E.floatLE+      , benchFE "doubleLE"   $ fromIntegral >$< E.doubleLE++      -- host-dependent+      , benchFE "int16Host"  $ fromIntegral >$< E.int16Host+      , benchFE "int32Host"  $ fromIntegral >$< E.int32Host+      , benchFE "int64Host"  $ fromIntegral >$< E.int64Host+      , benchFE "intHost"    $ fromIntegral >$< E.intHost++      , benchFE "word16Host" $ fromIntegral >$< E.word16Host+      , benchFE "word32Host" $ fromIntegral >$< E.word32Host+      , benchFE "word64Host" $ fromIntegral >$< E.word64Host+      , benchFE "wordHost"   $ fromIntegral >$< E.wordHost++      , benchFE "floatHost"  $ fromIntegral >$< E.floatHost+      , benchFE "doubleHost" $ fromIntegral >$< E.doubleHost+      ]++    , bgroup "Data.ByteString.Lazy.Builder.BoundedEncoding.ASCII"+      [+      -- decimal number+        benchBE "int8Dec"     $ fromIntegral >$< E.int8Dec+      , benchBE "int16Dec"    $ fromIntegral >$< E.int16Dec+      , benchBE "int32Dec"    $ fromIntegral >$< E.int32Dec+      , benchBE "int64Dec"    $ fromIntegral >$< E.int64Dec+      , benchBE "intDec"      $ fromIntegral >$< E.intDec++      , benchBE "word8Dec"    $ fromIntegral >$< E.word8Dec+      , benchBE "word16Dec"   $ fromIntegral >$< E.word16Dec+      , benchBE "word32Dec"   $ fromIntegral >$< E.word32Dec+      , benchBE "word64Dec"   $ fromIntegral >$< E.word64Dec+      , benchBE "wordDec"     $ fromIntegral >$< E.wordDec++      -- hexadecimal number+      , benchBE "word8Hex"    $ fromIntegral >$< E.word8Hex+      , benchBE "word16Hex"   $ fromIntegral >$< E.word16Hex+      , benchBE "word32Hex"   $ fromIntegral >$< E.word32Hex+      , benchBE "word64Hex"   $ fromIntegral >$< E.word64Hex+      , benchBE "wordHex"     $ fromIntegral >$< E.wordHex++      -- fixed-width hexadecimal numbers+      , benchFE "int8HexFixed"     $ fromIntegral >$< E.int8HexFixed+      , benchFE "int16HexFixed"    $ fromIntegral >$< E.int16HexFixed+      , benchFE "int32HexFixed"    $ fromIntegral >$< E.int32HexFixed+      , benchFE "int64HexFixed"    $ fromIntegral >$< E.int64HexFixed++      , benchFE "word8HexFixed"    $ fromIntegral >$< E.word8HexFixed+      , benchFE "word16HexFixed"   $ fromIntegral >$< E.word16HexFixed+      , benchFE "word32HexFixed"   $ fromIntegral >$< E.word32HexFixed+      , benchFE "word64HexFixed"   $ fromIntegral >$< E.word64HexFixed++      , benchFE "floatHexFixed"    $ fromIntegral >$< E.floatHexFixed+      , benchFE "doubleHexFixed"   $ fromIntegral >$< E.doubleHexFixed+      ]+    ]
+ bench/BoundsCheckFusion.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE PackageImports, ScopedTypeVariables, BangPatterns #-}+-- |+-- Copyright   : (c) 2011 Simon Meier+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Simon Meier <iridcode@gmail.com>+-- Stability   : experimental+-- Portability : tested on GHC only+--+-- Benchmark that the bounds checks fuse.+module Main (main) where++import Prelude hiding (words)+import Criterion.Main+import Data.Monoid+import Data.Foldable (foldMap)++import qualified Data.ByteString                  as S+import qualified Data.ByteString.Lazy             as L++import           Data.ByteString.Lazy.Builder+import           Data.ByteString.Lazy.Builder.Extras+import           Data.ByteString.Lazy.Builder.BasicEncoding+                   ( FixedEncoding, BoundedEncoding, (>$<), (>*<) )+import qualified Data.ByteString.Lazy.Builder.BasicEncoding          as E+import qualified Data.ByteString.Lazy.Builder.Internal               as I+import qualified Data.ByteString.Lazy.Builder.BasicEncoding.Internal as I++import Foreign++------------------------------------------------------------------------------+-- Benchmark support+------------------------------------------------------------------------------++countToZero :: Int -> Maybe (Int, Int)+countToZero 0 = Nothing+countToZero n = Just (n, n - 1)+++------------------------------------------------------------------------------+-- Benchmark+------------------------------------------------------------------------------++-- input data (NOINLINE to ensure memoization)+----------------------------------------------++-- | Few-enough repetitions to avoid making GC too expensive.+nRepl :: Int+nRepl = 10000++{-# NOINLINE intData #-}+intData :: [Int]+intData = [1..nRepl]++-- benchmark wrappers+---------------------++{-# INLINE benchB #-}+benchB :: String -> a -> (a -> Builder) -> Benchmark+benchB name x b =+    bench (name ++" (" ++ show nRepl ++ ")") $+        whnf (L.length . toLazyByteString . b) x++{-# INLINE benchBInts #-}+benchBInts :: String -> ([Int] -> Builder) -> Benchmark+benchBInts name = benchB name intData+++-- benchmarks+-------------++sanityCheckInfo :: [String]+sanityCheckInfo =+  [ "Sanity checks:"+  , " lengths of input data: " ++ show+      [ length intData ]+  ]++main :: IO ()+main = do+  mapM_ putStrLn sanityCheckInfo+  putStrLn ""+  Criterion.Main.defaultMain+    [ bgroup "Data.ByteString.Lazy.Builder"+        [ -- benchBInts "foldMap intHost" $+            -- foldMap (intHost . fromIntegral)++{-+          benchBInts "mapM_ (\\x -> intHost x `mappend` intHost x)" $+            foldMap ((\x -> intHost x `mappend` intHost x)++        , benchBInts "foldMap (\\x -> intHost x `mappend` intHost x)" $+            foldMap (\x -> intHost x `mappend` intHost x)+-}++          benchBInts "foldMap (left-assoc)" $+            foldMap (\x -> (stringUtf8 "s" `mappend` intHost x) `mappend` intHost x)++        , benchBInts "foldMap (right-assoc)" $+            foldMap (\x -> intHost x `mappend` (intHost x `mappend` stringUtf8 "s"))++        , benchBInts "foldMap [manually fused, left-assoc]" $+            foldMap (\x -> stringUtf8 "s" `mappend` E.encodeWithB (E.fromF $ E.intHost >*< E.intHost) (x, x))++        , benchBInts "foldMap [manually fused, right-assoc]" $+            foldMap (\x -> E.encodeWithB (E.fromF $ E.intHost >*< E.intHost) (x, x) `mappend` stringUtf8 "s")++        -- , benchBInts "encodeListWithF intHost" $+            -- E.encodeListWithF (fromIntegral >$< E.intHost)+        ]+    ]++{-# RULES++"append/encodeWithB" forall w1 w2 x1 x2.+       I.append (E.encodeWithB w1 x1) (E.encodeWithB w2 x2)+     = E.encodeWithB (E.pairB w1 w2) (x1, x2)++"append/encodeWithB/assoc_r" forall w1 w2 x1 x2 b.+       I.append (E.encodeWithB w1 x1) (I.append (E.encodeWithB w2 x2) b)+     = I.append (E.encodeWithB (E.pairB w1 w2) (x1, x2)) b++"append/encodeWithB/assoc_l" forall w1 w2 x1 x2 b.+       I.append (I.append b (E.encodeWithB w1 x1)) (E.encodeWithB w2 x2)+     = I.append b (E.encodeWithB (E.pairB w1 w2) (x1, x2))+  #-}+
bytestring.cabal view
@@ -1,33 +1,64 @@ Name:                bytestring-Version:             0.9.2.1-Synopsis:            Fast, packed, strict and lazy byte arrays with a list interface+Version:             0.10.0.0+Synopsis:            Fast, compact, strict and lazy byte strings with a list interface Description:-    A time and space-efficient implementation of byte vectors using-    packed Word8 arrays, suitable for high performance use, both in terms-    of large data quantities, or high speed requirements. Byte vectors-    are encoded as strict 'Word8' arrays of bytes, and lazy lists of-    strict chunks, held in a 'ForeignPtr', and can be passed between C-    and Haskell with little effort.+    An efficient compact, immutable byte string type (both strict and lazy)+    suitable for binary or 8-bit character data.     .-    Test coverage data for this library is available at:-        <http://code.haskell.org/~dons/tests/bytestring/hpc_index.html>+    The 'ByteString' type represents sequences of bytes or 8-bit characters.+    It is suitable for high performance use, both in terms of large data+    quantities, or high speed requirements. The 'ByteStrin'g functions follow+    the same style as Haskell\'s ordinary lists, so it is easy to convert code+    from using 'String' to 'ByteString'.+    .+    Two 'ByteString' variants are provided:+    .+      * Strict 'ByteString's keep the string as a single large array. This+        makes them convenient for passing data between C and Haskell.+    .+      * Lazy 'ByteStrings' use a lazy list of strict chunks which makes it+        suitable for I\/O streaming tasks.+    .+    The @Char8@ modules provide a character-based view of the same+    underlying 'ByteString' types. This makes it convenient to handle mixed+    binary and 8-bit character content (which is common in many file formats+    and network protocols).+    .+    'ByteString's are not designed for Unicode. For Unicode strings you should+    use the 'Text' type from the @text@ package.+    .+    These modules are intended to be imported qualified, to avoid name clashes+    with "Prelude" functions, e.g.+    .+    > import qualified Data.ByteString as BS  License:             BSD3 License-file:        LICENSE Category:            Data-Copyright:           Copyright (c) Don Stewart   2005-2009,-                               (c) Duncan Coutts 2006-2009,-                               (c) David Roundy  2003-2005.-Author:              Don Stewart, Duncan Coutts-Maintainer:          dons00@gmail.com, duncan@community.haskell.org-Homepage:            http://www.cse.unsw.edu.au/~dons/fps.html-Tested-With:         GHC==7.0.2, GHC==6.12.3, GHC==6.10.4, GHC ==6.8.2+Copyright:           Copyright (c) Don Stewart          2005-2009,+                               (c) Duncan Coutts        2006-2011,+                               (c) David Roundy         2003-2005,+                               (c) Jasper Van der Jeugt 2010,+                               (c) Simon Meier          2010-2011.++Author:              Don Stewart,+                     Duncan Coutts+Maintainer:          Don Stewart <dons00@gmail.com>,+                     Duncan Coutts <duncan@community.haskell.org>+Bug-reports:         dons00@gmail.com,+                     duncan@community.haskell.org+Tested-With:         GHC==7.2.1, GHC==7.0.2, GHC==6.12.3,+                     GHC==6.10.4, GHC ==6.8.2 Build-Type:          Simple Cabal-Version:       >= 1.8 extra-source-files:  README TODO +source-repository head+  type:     darcs+  location: http://darcs.haskell.org/bytestring/+ library-  build-depends:     base >= 3 && < 5+  build-depends:     base >= 3 && < 5, deepseq    if impl(ghc >= 6.10)     build-depends:   ghc-prim, base >= 4@@ -39,27 +70,48 @@                      Data.ByteString.Lazy                      Data.ByteString.Lazy.Char8                      Data.ByteString.Lazy.Internal-                     Data.ByteString.Fusion -  extensions:        CPP, ForeignFunctionInterface+                     Data.ByteString.Lazy.Builder+                     Data.ByteString.Lazy.Builder.Extras+                     Data.ByteString.Lazy.Builder.ASCII +  other-modules:+                     -- these three modules should be exposed in a future+                     -- release once we're confident the API is stable.+                     Data.ByteString.Lazy.Builder.Internal+                     Data.ByteString.Lazy.Builder.BasicEncoding+                     Data.ByteString.Lazy.Builder.BasicEncoding.Extras+                     Data.ByteString.Lazy.Builder.BasicEncoding.Internal++                     Data.ByteString.Lazy.Builder.BasicEncoding.Binary+                     Data.ByteString.Lazy.Builder.BasicEncoding.ASCII+                     Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Floating+                     Data.ByteString.Lazy.Builder.BasicEncoding.Internal.UncheckedShifts+                     Data.ByteString.Lazy.Builder.BasicEncoding.Internal.Base16++  extensions:        CPP,+                     ForeignFunctionInterface,+                     BangPatterns+   if impl(ghc)       extensions:   UnliftedFFITypes,                     MagicHash,                     UnboxedTuples,                     DeriveDataTypeable                     ScopedTypeVariables+                    Rank2Types   if impl(ghc >= 6.11)       extensions:   NamedFieldPuns -  --TODO: eliminate orphan instances:-  ghc-options:      -Wall -fno-warn-orphans+  ghc-options:      -Wall                     -O2-                    -funbox-strict-fields -                    -fmax-simplifier-iterations10+                    -fmax-simplifier-iterations=10                     -fdicts-cheap+  if impl(ghc >= 6.10)+    ghc-options:    -fspec-constr-count=6    c-sources:         cbits/fpstring.c+                     cbits/itoa.c   include-dirs:      include   includes:          fpstring.h   install-includes:  fpstring.h@@ -71,16 +123,18 @@   type:             exitcode-stdio-1.0   main-is:          Properties.hs   hs-source-dirs:   . tests-  build-depends:    base, random, directory,+  build-depends:    base, deepseq, random, directory,                     QuickCheck >= 2.3 && < 3   if impl(ghc >= 6.10)     build-depends:  ghc-prim   c-sources:        cbits/fpstring.c   include-dirs:     include+  ghc-options:      -fwarn-unused-binds   if impl(ghc >= 6.10)     ghc-options:    -fno-enable-rewrite-rules   else     ghc-options:    -fno-rewrite-rules+  extensions:       BangPatterns   if impl(ghc)       extensions:   UnliftedFFITypes,                     MagicHash,@@ -89,3 +143,79 @@                     ScopedTypeVariables   if impl(ghc >= 6.11)       extensions:   NamedFieldPuns++test-suite test-builder+  type:             exitcode-stdio-1.0+  hs-source-dirs:   . tests tests/builder+  main-is:          TestSuite.hs++  build-depends:    base, ghc-prim,+                    deepseq,+                    QuickCheck                 >= 2.4 && < 3,+                    byteorder                  == 1.0.*,+                    dlist                      == 0.5.*,+                    directory                  >= 1.0 && < 1.2,+                    mtl                        == 2.0.*++  ghc-options:      -Wall -fwarn-tabs++  extensions:       CPP, ForeignFunctionInterface+                    UnliftedFFITypes,+                    MagicHash,+                    UnboxedTuples,+                    DeriveDataTypeable+                    ScopedTypeVariables+                    Rank2Types+                    BangPatterns+                    NamedFieldPuns++  c-sources:        cbits/fpstring.c+                    cbits/itoa.c+  include-dirs:     include+  includes:         fpstring.h+  install-includes: fpstring.h++benchmark bench-builder-all+  type:             exitcode-stdio-1.0+  hs-source-dirs:   . bench+  main-is:          BenchAll.hs+  build-depends:    base, deepseq, ghc-prim,+                    criterion+  c-sources:        cbits/fpstring.c+                    cbits/itoa.c+  include-dirs:     include+  ghc-options:      -O2+                    -fmax-simplifier-iterations=10+                    -fdicts-cheap+                    -fspec-constr-count=6++benchmark bench-builder-boundscheck+  type:             exitcode-stdio-1.0+  hs-source-dirs:   . bench+  main-is:          BoundsCheckFusion.hs+  build-depends:    base, deepseq, ghc-prim,+                    criterion+  c-sources:        cbits/fpstring.c+                    cbits/itoa.c+  include-dirs:     include+  ghc-options:      -O2+                    -fmax-simplifier-iterations=10+                    -fdicts-cheap+                    -fspec-constr-count=6++-- Sadly we cannot use benchmark bench-builder-csv currently because it+-- depends on both text and binary, which both depend on bytestring+-- which gives cabal fits about cyclic dependencies.+--  type:             exitcode-stdio-1.0+--  hs-source-dirs:   . bench+--  main-is:          CSV.hs+--  build-depends:    base, deepseq, ghc-prim,+--                    text, binary,+--                    criterion+--  c-sources:        cbits/fpstring.c+--                    cbits/itoa.c+--  include-dirs:     include+--  ghc-options:      -O2+--                    -fmax-simplifier-iterations=10+--                    -fdicts-cheap+--                    -fspec-constr-count=6
+ cbits/itoa.c view
@@ -0,0 +1,171 @@+///////////////////////////////////////////////////////////////+// Encoding numbers using ASCII characters                   //+//                                                           //+// inspired by: http://www.jb.man.ac.uk/~slowe/cpp/itoa.html //+///////////////////////////////////////////////////////////////++#include <stdio.h>++// Decimal Encoding+///////////////////++const char* digits = "0123456789abcdef";++// signed integers+char* _hs_bytestring_int_dec (int x, char* buf)+{+    char c, *ptr = buf, *next_free;+    int x_tmp;++    // we cannot negate directly as  0 - (minBound :: Int) = minBound+    if (x < 0) {+        *ptr++ = '-';+        buf++;+        x_tmp = x;+        x /= 10;+        *ptr++ = digits[x * 10 - x_tmp];+        if (x == 0)+          return ptr;+        else+          x = -x;+    }++    // encode positive number as little-endian decimal+    do {+        x_tmp = x;+        x /= 10;+        *ptr++ = digits[x_tmp - x * 10];+    } while ( x );++    // reverse written digits+    next_free = ptr--;+    while (buf < ptr) {+        c       = *ptr;+        *ptr--  = *buf;+        *buf++  = c;+    }+    return next_free;+}++// signed long long ints (64 bit integers)+char* _hs_bytestring_long_long_int_dec (long long int x, char* buf)+{+    char c, *ptr = buf, *next_free;+    long long int x_tmp;++    // we cannot negate directly as  0 - (minBound :: Int) = minBound+    if (x < 0) {+        *ptr++ = '-';+        buf++;+        x_tmp = x;+        x /= 10;+        *ptr++ = digits[x * 10 - x_tmp];+        if (x == 0)+          return ptr;+        else+          x = -x;+    }++    // encode positive number as little-endian decimal+    do {+        x_tmp = x;+        x /= 10;+        *ptr++ = digits[x_tmp - x * 10];+    } while ( x );++    // reverse written digits+    next_free = ptr--;+    while (buf < ptr) {+        c       = *ptr;+        *ptr--  = *buf;+        *buf++  = c;+    }+    return next_free;+}++// unsigned integers+char* _hs_bytestring_uint_dec (unsigned int x, char* buf)+{+    char c, *ptr = buf, *next_free;+    unsigned int x_tmp;++    // encode positive number as little-endian decimal+    do {+        x_tmp = x;+        x /= 10;+        *ptr++ = digits[x_tmp - x * 10];+    } while ( x );++    // reverse written digits+    next_free = ptr--;+    while (buf < ptr) {+        c       = *ptr;+        *ptr--  = *buf;+        *buf++  = c;+    }+    return next_free;+}++// unsigned long ints+char* _hs_bytestring_long_long_uint_dec (long long unsigned int x, char* buf)+{+    char c, *ptr = buf, *next_free;+    long long unsigned int x_tmp;++    // encode positive number as little-endian decimal+    do {+        x_tmp = x;+        x /= 10;+        *ptr++ = digits[x_tmp - x * 10];+    } while ( x );++    // reverse written digits+    next_free = ptr--;+    while (buf < ptr) {+        c       = *ptr;+        *ptr--  = *buf;+        *buf++  = c;+    }+    return next_free;+}+++///////////////////////+// Hexadecimal encoding+///////////////////////++// unsigned ints (32 bit words)+char* _hs_bytestring_uint_hex (unsigned int x, char* buf) {+    // write hex representation in reverse order+    char c, *ptr = buf, *next_free;+    do {+        *ptr++ = digits[x & 0xf];+        x >>= 4;+    } while ( x );+    // invert written digits+    next_free = ptr--;+    while(buf < ptr) {+        c      = *ptr;+        *ptr-- = *buf;+        *buf++ = c;+    }+    return next_free;+};++// unsigned long ints (64 bit words)+char* _hs_bytestring_long_long_uint_hex (long long unsigned int x, char* buf) {+    // write hex representation in reverse order+    char c, *ptr = buf, *next_free;+    do {+        *ptr++ = digits[x & 0xf];+        x >>= 4;+    } while ( x );+    // invert written digits+    next_free = ptr--;+    while(buf < ptr) {+        c      = *ptr;+        *ptr-- = *buf;+        *buf++ = c;+    }+    return next_free;+};
include/fpstring.h view
@@ -1,6 +1,21 @@ +#include <string.h>+ void fps_reverse(unsigned char *dest, unsigned char *from, unsigned long  len); void fps_intersperse(unsigned char *dest, unsigned char *from, unsigned long  len, unsigned char c); unsigned char fps_maximum(unsigned char *p, unsigned long  len); unsigned char fps_minimum(unsigned char *p, unsigned long  len); unsigned long fps_count(unsigned char *p, unsigned long  len, unsigned char w);++#ifndef INLINE+# if defined(_MSC_VER)+#  define INLINE extern __inline+# else+#  define INLINE static inline+# endif+#endif+INLINE void *+__hscore_memcpy_src_off( char *dst, char *src, int src_off, size_t sz )+{ return memcpy(dst, src+src_off, sz); }++
tests/Properties.hs view
@@ -1,2348 +1,2467 @@-{-# LANGUAGE PatternSignatures #-}------ Must have rules off, otherwise the fusion rules will replace the rhs--- with the lhs, and we only end up testing lhs == lhs---------- -fhpc interferes with rewrite rules firing.-----import Foreign-import Foreign.ForeignPtr-import Foreign.Marshal.Array-import GHC.Ptr-import Test.QuickCheck-import Control.Monad-import Control.Concurrent-import Control.Exception-import System.Directory--import Data.List-import Data.Char-import Data.Word-import Data.Maybe-import Data.Int (Int64)-import Data.Monoid--import Text.Printf-import Debug.Trace-import Data.String--import System.Environment-import System.IO-import System.IO.Unsafe-import System.Random--import Foreign.Ptr--import Data.ByteString.Lazy (ByteString(..), pack , unpack)-import qualified Data.ByteString.Lazy as L-import Data.ByteString.Lazy.Internal (ByteString(..))--import qualified Data.ByteString            as P-import qualified Data.ByteString.Internal   as P-import qualified Data.ByteString.Unsafe     as P-import qualified Data.ByteString.Char8      as C--import qualified Data.ByteString.Lazy.Char8 as LC-import qualified Data.ByteString.Lazy.Char8 as D--import qualified Data.ByteString.Lazy.Internal as LP-import Data.ByteString.Fusion-import Prelude hiding (abs)--import Rules-import QuickCheckUtils--f = C.dropWhile isSpace------- ByteString.Lazy.Char8 <=> ByteString.Char8-----prop_concatCC       = D.concat      `eq1`  C.concat-prop_nullCC         = D.null        `eq1`  C.null-prop_reverseCC      = D.reverse     `eq1`  C.reverse-prop_transposeCC    = D.transpose   `eq1`  C.transpose-prop_groupCC        = D.group       `eq1`  C.group-prop_initsCC        = D.inits       `eq1`  C.inits-prop_tailsCC        = D.tails       `eq1`  C.tails-prop_allCC          = D.all         `eq2`  C.all-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) $-                      D.concatMap   `eq2`  C.concatMap-prop_consCC         = D.cons        `eq2`  C.cons-prop_unconsCC       = D.uncons      `eq1`  C.uncons-prop_countCC        = D.count       `eq2`  C.count-prop_dropCC         = D.drop        `eq2`  C.drop-prop_dropWhileCC    = D.dropWhile   `eq2`  C.dropWhile-prop_filterCC       = D.filter      `eq2`  C.filter-prop_findCC         = D.find        `eq2`  C.find-prop_findIndexCC    = D.findIndex   `eq2`  C.findIndex-prop_findIndicesCC  = D.findIndices `eq2`  C.findIndices-prop_isPrefixOfCC   = D.isPrefixOf  `eq2`  C.isPrefixOf-prop_mapCC          = D.map         `eq2`  C.map-prop_replicateCC    = forAll arbitrarySizedIntegral $-                      D.replicate   `eq2`  C.replicate-prop_snocCC         = D.snoc        `eq2`  C.snoc-prop_spanCC         = D.span        `eq2`  C.span-prop_splitCC        = D.split       `eq2`  C.split-prop_splitAtCC      = D.splitAt     `eq2`  C.splitAt-prop_takeCC         = D.take        `eq2`  C.take-prop_takeWhileCC    = D.takeWhile   `eq2`  C.takeWhile-prop_elemCC         = D.elem        `eq2`  C.elem-prop_notElemCC      = D.notElem     `eq2`  C.notElem-prop_elemIndexCC    = D.elemIndex   `eq2`  C.elemIndex-prop_elemIndicesCC  = D.elemIndices `eq2`  C.elemIndices-prop_lengthCC       = D.length      `eq1`  (fromIntegral . C.length :: C.ByteString -> Int64)--prop_headCC         = D.head        `eqnotnull1` C.head-prop_initCC         = D.init        `eqnotnull1` C.init-prop_lastCC         = D.last        `eqnotnull1` C.last-prop_maximumCC      = D.maximum     `eqnotnull1` C.maximum-prop_minimumCC      = D.minimum     `eqnotnull1` C.minimum-prop_tailCC         = D.tail        `eqnotnull1` C.tail-prop_foldl1CC       = D.foldl1      `eqnotnull2` C.foldl1-prop_foldl1CC'      = D.foldl1'     `eqnotnull2` C.foldl1'-prop_foldr1CC       = D.foldr1      `eqnotnull2` C.foldr1-prop_foldr1CC'      = D.foldr1      `eqnotnull2` C.foldr1'-prop_scanlCC        = D.scanl       `eqnotnull3` C.scanl--prop_intersperseCC = D.intersperse  `eq2` C.intersperse--prop_foldlCC     = eq3-    (D.foldl     :: (X -> Char -> X) -> X -> B -> X)-    (C.foldl     :: (X -> Char -> X) -> X -> P -> X)-prop_foldlCC'    = eq3-    (D.foldl'    :: (X -> Char -> X) -> X -> B -> X)-    (C.foldl'    :: (X -> Char -> X) -> X -> P -> X)-prop_foldrCC     = eq3-    (D.foldr     :: (Char -> X -> X) -> X -> B -> X)-    (C.foldr     :: (Char -> X -> X) -> X -> P -> X)-prop_foldrCC'    = eq3-    (D.foldr     :: (Char -> X -> X) -> X -> B -> X)-    (C.foldr'    :: (Char -> X -> X) -> X -> P -> X)-prop_mapAccumLCC = eq3-    (D.mapAccumL :: (X -> Char -> (X,Char)) -> X -> B -> (X, B))-    (C.mapAccumL :: (X -> Char -> (X,Char)) -> X -> P -> (X, P))----prop_mapIndexedCC = D.mapIndexed `eq2` C.mapIndexed---prop_mapIndexedPL = L.mapIndexed `eq2` P.mapIndexed----prop_mapAccumL_mapIndexedBP =---        P.mapIndexed `eq2`---        (\k p -> snd $ P.mapAccumL (\i w -> (i+1, k i w)) (0::Int) p)------- ByteString.Lazy <=> ByteString-----prop_concatBP       = adjustSize (`div` 2) $-                      L.concat      `eq1`  P.concat-prop_nullBP         = L.null        `eq1`  P.null-prop_reverseBP      = L.reverse     `eq1`  P.reverse--prop_transposeBP    = L.transpose   `eq1`  P.transpose-prop_groupBP        = L.group       `eq1`  P.group-prop_initsBP        = L.inits       `eq1`  P.inits-prop_tailsBP        = L.tails       `eq1`  P.tails-prop_allBP          = L.all         `eq2`  P.all-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) $-                      L.concatMap   `eq2`  P.concatMap-prop_consBP         = L.cons        `eq2`  P.cons-prop_consBP'        = L.cons'       `eq2`  P.cons-prop_consLP'        = LC.cons'      `eq2`  P.cons-prop_unconsBP       = L.uncons      `eq1`  P.uncons-prop_countBP        = L.count       `eq2`  P.count-prop_dropBP         = L.drop        `eq2`  P.drop-prop_dropWhileBP    = L.dropWhile   `eq2`  P.dropWhile-prop_filterBP       = L.filter      `eq2`  P.filter-prop_findBP         = L.find        `eq2`  P.find-prop_findIndexBP    = L.findIndex   `eq2`  P.findIndex-prop_findIndicesBP  = L.findIndices `eq2`  P.findIndices-prop_isPrefixOfBP   = L.isPrefixOf  `eq2`  P.isPrefixOf-prop_mapBP          = L.map         `eq2`  P.map-prop_replicateBP    = forAll arbitrarySizedIntegral $-                      L.replicate   `eq2`  P.replicate-prop_snocBP         = L.snoc        `eq2`  P.snoc-prop_spanBP         = L.span        `eq2`  P.span-prop_splitBP        = L.split       `eq2`  P.split-prop_splitAtBP      = L.splitAt     `eq2`  P.splitAt-prop_takeBP         = L.take        `eq2`  P.take-prop_takeWhileBP    = L.takeWhile   `eq2`  P.takeWhile-prop_elemBP         = L.elem        `eq2`  P.elem-prop_notElemBP      = L.notElem     `eq2`  P.notElem-prop_elemIndexBP    = L.elemIndex   `eq2`  P.elemIndex-prop_elemIndicesBP  = L.elemIndices `eq2`  P.elemIndices-prop_intersperseBP  = L.intersperse  `eq2` P.intersperse-prop_lengthBP       = L.length      `eq1`  (fromIntegral . P.length :: P.ByteString -> Int64)-prop_readIntBP      = D.readInt     `eq1`  C.readInt-prop_linesBP        = D.lines       `eq1`  C.lines---- double check:--- Currently there's a bug in the lazy bytestring version of lines, this--- catches it:-prop_linesNLBP      = eq1 D.lines C.lines x-    where x = D.pack "one\ntwo\n\n\nfive\n\nseven\n"--prop_headBP         = L.head        `eqnotnull1` P.head-prop_initBP         = L.init        `eqnotnull1` P.init-prop_lastBP         = L.last        `eqnotnull1` P.last-prop_maximumBP      = L.maximum     `eqnotnull1` P.maximum-prop_minimumBP      = L.minimum     `eqnotnull1` P.minimum-prop_tailBP         = L.tail        `eqnotnull1` P.tail-prop_foldl1BP       = L.foldl1      `eqnotnull2` P.foldl1-prop_foldl1BP'      = L.foldl1'     `eqnotnull2` P.foldl1'-prop_foldr1BP       = L.foldr1      `eqnotnull2` P.foldr1-prop_foldr1BP'      = L.foldr1      `eqnotnull2` P.foldr1'-prop_scanlBP        = L.scanl       `eqnotnull3` P.scanl---prop_eqBP        = eq2-    ((==) :: B -> B -> Bool)-    ((==) :: P -> P -> Bool)-prop_compareBP   = eq2-    ((compare) :: B -> B -> Ordering)-    ((compare) :: P -> P -> Ordering)-prop_foldlBP     = eq3-    (L.foldl     :: (X -> W -> X) -> X -> B -> X)-    (P.foldl     :: (X -> W -> X) -> X -> P -> X)-prop_foldlBP'    = eq3-    (L.foldl'    :: (X -> W -> X) -> X -> B -> X)-    (P.foldl'    :: (X -> W -> X) -> X -> P -> X)-prop_foldrBP     = eq3-    (L.foldr     :: (W -> X -> X) -> X -> B -> X)-    (P.foldr     :: (W -> X -> X) -> X -> P -> X)-prop_foldrBP'    = eq3-    (L.foldr     :: (W -> X -> X) -> X -> B -> X)-    (P.foldr'    :: (W -> X -> X) -> X -> P -> X)-prop_mapAccumLBP = eq3-    (L.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))-    (P.mapAccumL :: (X -> W -> (X,W)) -> X -> P -> (X, P))--prop_unfoldrBP   =-  forAll arbitrarySizedIntegral $-  eq3-    ((\n f a -> L.take (fromIntegral n) $-        L.unfoldr    f a) :: Int -> (X -> Maybe (W,X)) -> X -> B)-    ((\n f a ->                     fst $-        P.unfoldrN n f a) :: Int -> (X -> Maybe (W,X)) -> X -> P)--prop_unfoldr2BP   =-  forAll arbitrarySizedIntegral $ \n ->-  forAll arbitrarySizedIntegral $ \a ->-  eq2-    ((\n a -> P.take (n*100) $-        P.unfoldr    (\x -> if x <= (n*100) then Just (fromIntegral x, x + 1) else Nothing) a)-                :: Int -> Int -> P)-    ((\n a ->                     fst $-        P.unfoldrN (n*100) (\x -> if x <= (n*100) then Just (fromIntegral x, x + 1) else Nothing) a)-                :: Int -> Int -> P)-    n a--prop_unfoldr2CP   =-  forAll arbitrarySizedIntegral $ \n ->-  forAll arbitrarySizedIntegral $ \a ->-  eq2-    ((\n a -> C.take (n*100) $-        C.unfoldr    (\x -> if x <= (n*100) then Just (chr (x `mod` 256), x + 1) else Nothing) a)-                :: Int -> Int -> P)-    ((\n a ->                     fst $-        C.unfoldrN (n*100) (\x -> if x <= (n*100) then Just (chr (x `mod` 256), x + 1) else Nothing) a)-                :: Int -> Int -> P)-    n a---prop_unfoldrLC   =-  forAll arbitrarySizedIntegral $-  eq3-    ((\n f a -> LC.take (fromIntegral n) $-        LC.unfoldr    f a) :: Int -> (X -> Maybe (Char,X)) -> X -> B)-    ((\n f a ->                     fst $-        C.unfoldrN n f a) :: Int -> (X -> Maybe (Char,X)) -> X -> P)--prop_cycleLC  a   =-  not (LC.null a) ==>-  forAll arbitrarySizedIntegral $-  eq1-    ((\n   -> LC.take (fromIntegral n) $-              LC.cycle a-     ) :: Int -> B)--    ((\n   -> LC.take (fromIntegral (n::Int)) . LC.concat $-              unfoldr (\x ->  Just (x,x) ) a-     ) :: Int -> B)---prop_iterateLC =-  forAll arbitrarySizedIntegral $-  eq3-    ((\n f a -> LC.take (fromIntegral n) $-        LC.iterate  f a) :: Int -> (Char -> Char) -> Char -> B)-    ((\n f a -> fst $-        C.unfoldrN n (\a -> Just (f a, f a)) a) :: Int -> (Char -> Char) -> Char -> P)--prop_iterateLC_2   =-  forAll arbitrarySizedIntegral $-  eq3-    ((\n f a -> LC.take (fromIntegral n) $-        LC.iterate  f a) :: Int -> (Char -> Char) -> Char -> B)-    ((\n f a -> LC.take (fromIntegral n) $-        LC.unfoldr (\a -> Just (f a, f a)) a) :: Int -> (Char -> Char) -> Char -> B)--prop_iterateL   =-  forAll arbitrarySizedIntegral $-  eq3-    ((\n f a -> L.take (fromIntegral n) $-        L.iterate  f a) :: Int -> (W -> W) -> W -> B)-    ((\n f a -> fst $-        P.unfoldrN n (\a -> Just (f a, f a)) a) :: Int -> (W -> W) -> W -> P)--prop_repeatLC   =-  forAll arbitrarySizedIntegral $-  eq2-    ((\n a -> LC.take (fromIntegral n) $-        LC.repeat a) :: Int -> Char -> B)-    ((\n a -> fst $-        C.unfoldrN n (\a -> Just (a, a)) a) :: Int -> Char -> P)--prop_repeatL   =-  forAll arbitrarySizedIntegral $-  eq2-    ((\n a -> L.take (fromIntegral n) $-        L.repeat a) :: Int -> W -> B)-    ((\n a -> fst $-        P.unfoldrN n (\a -> Just (a, a)) a) :: Int -> W -> P)------- properties comparing ByteString.Lazy `eq1` List-----prop_concatBL       = adjustSize (`div` 2) $-                      L.concat      `eq1` (concat    :: [[W]] -> [W])-prop_lengthBL       = L.length      `eq1` (length    :: [W] -> Int)-prop_nullBL         = L.null        `eq1` (null      :: [W] -> Bool)-prop_reverseBL      = L.reverse     `eq1` (reverse   :: [W] -> [W])-prop_transposeBL    = L.transpose   `eq1` (transpose :: [[W]] -> [[W]])-prop_groupBL        = L.group       `eq1` (group     :: [W] -> [[W]])-prop_initsBL        = L.inits       `eq1` (inits     :: [W] -> [[W]])-prop_tailsBL        = L.tails       `eq1` (tails     :: [W] -> [[W]])-prop_allBL          = L.all         `eq2` (all       :: (W -> Bool) -> [W] -> Bool)-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) $-                      L.concatMap   `eq2` (concatMap :: (W -> [W]) -> [W] -> [W])-prop_consBL         = L.cons        `eq2` ((:)       :: W -> [W] -> [W])-prop_dropBL         = L.drop        `eq2` (drop      :: Int -> [W] -> [W])-prop_dropWhileBL    = L.dropWhile   `eq2` (dropWhile :: (W -> Bool) -> [W] -> [W])-prop_filterBL       = L.filter      `eq2` (filter    :: (W -> Bool ) -> [W] -> [W])-prop_findBL         = L.find        `eq2` (find      :: (W -> Bool) -> [W] -> Maybe W)-prop_findIndicesBL  = L.findIndices `eq2` (findIndices:: (W -> Bool) -> [W] -> [Int])-prop_findIndexBL    = L.findIndex   `eq2` (findIndex :: (W -> Bool) -> [W] -> Maybe Int)-prop_isPrefixOfBL   = L.isPrefixOf  `eq2` (isPrefixOf:: [W] -> [W] -> Bool)-prop_mapBL          = L.map         `eq2` (map       :: (W -> W) -> [W] -> [W])-prop_replicateBL    = forAll arbitrarySizedIntegral $-                      L.replicate   `eq2` (replicate :: Int -> W -> [W])-prop_snocBL         = L.snoc        `eq2` ((\xs x -> xs ++ [x]) :: [W] -> W -> [W])-prop_spanBL         = L.span        `eq2` (span      :: (W -> Bool) -> [W] -> ([W],[W]))-prop_splitAtBL      = L.splitAt     `eq2` (splitAt   :: Int -> [W] -> ([W],[W]))-prop_takeBL         = L.take        `eq2` (take      :: Int -> [W] -> [W])-prop_takeWhileBL    = L.takeWhile   `eq2` (takeWhile :: (W -> Bool) -> [W] -> [W])-prop_elemBL         = L.elem        `eq2` (elem      :: W -> [W] -> Bool)-prop_notElemBL      = L.notElem     `eq2` (notElem   :: W -> [W] -> Bool)-prop_elemIndexBL    = L.elemIndex   `eq2` (elemIndex :: W -> [W] -> Maybe Int)-prop_elemIndicesBL  = L.elemIndices `eq2` (elemIndices:: W -> [W] -> [Int])-prop_linesBL        = D.lines       `eq1` (lines     :: String -> [String])--prop_foldl1BL       = L.foldl1  `eqnotnull2` (foldl1    :: (W -> W -> W) -> [W] -> W)-prop_foldl1BL'      = L.foldl1' `eqnotnull2` (foldl1'   :: (W -> W -> W) -> [W] -> W)-prop_foldr1BL       = L.foldr1  `eqnotnull2` (foldr1    :: (W -> W -> W) -> [W] -> W)-prop_headBL         = L.head    `eqnotnull1` (head      :: [W] -> W)-prop_initBL         = L.init    `eqnotnull1` (init      :: [W] -> [W])-prop_lastBL         = L.last    `eqnotnull1` (last      :: [W] -> W)-prop_maximumBL      = L.maximum `eqnotnull1` (maximum   :: [W] -> W)-prop_minimumBL      = L.minimum `eqnotnull1` (minimum   :: [W] -> W)-prop_tailBL         = L.tail    `eqnotnull1` (tail      :: [W] -> [W])--prop_eqBL         = eq2-    ((==) :: B   -> B   -> Bool)-    ((==) :: [W] -> [W] -> Bool)-prop_compareBL    = eq2-    ((compare) :: B   -> B   -> Ordering)-    ((compare) :: [W] -> [W] -> Ordering)-prop_foldlBL      = eq3-    (L.foldl  :: (X -> W -> X) -> X -> B   -> X)-    (  foldl  :: (X -> W -> X) -> X -> [W] -> X)-prop_foldlBL'     = eq3-    (L.foldl' :: (X -> W -> X) -> X -> B   -> X)-    (  foldl' :: (X -> W -> X) -> X -> [W] -> X)-prop_foldrBL      = eq3-    (L.foldr  :: (W -> X -> X) -> X -> B   -> X)-    (  foldr  :: (W -> X -> X) -> X -> [W] -> X)-prop_mapAccumLBL  = eq3-    (L.mapAccumL :: (X -> W -> (X,W)) -> X -> B   -> (X, B))-    (  mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))--prop_mapAccumRBL  = eq3-    (L.mapAccumR :: (X -> W -> (X,W)) -> X -> B   -> (X, B))-    (  mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))--prop_mapAccumRDL  = eq3-    (D.mapAccumR :: (X -> Char -> (X,Char)) -> X -> B   -> (X, B))-    (  mapAccumR :: (X -> Char -> (X,Char)) -> X -> [Char] -> (X, [Char]))--prop_mapAccumRCC  = eq3-    (C.mapAccumR :: (X -> Char -> (X,Char)) -> X -> P   -> (X, P))-    (  mapAccumR :: (X -> Char -> (X,Char)) -> X -> [Char] -> (X, [Char]))--prop_unfoldrBL =-  forAll arbitrarySizedIntegral $-  eq3-    ((\n f a -> L.take (fromIntegral n) $-        L.unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> B)-    ((\n f a ->                  take n $-          unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> [W])------- And finally, check correspondance between Data.ByteString and List-----prop_lengthPL     = (fromIntegral.P.length :: P -> Int) `eq1` (length :: [W] -> Int)-prop_nullPL       = P.null      `eq1` (null      :: [W] -> Bool)-prop_reversePL    = P.reverse   `eq1` (reverse   :: [W] -> [W])-prop_transposePL  = P.transpose `eq1` (transpose :: [[W]] -> [[W]])-prop_groupPL      = P.group     `eq1` (group     :: [W] -> [[W]])-prop_initsPL      = P.inits     `eq1` (inits     :: [W] -> [[W]])-prop_tailsPL      = P.tails     `eq1` (tails     :: [W] -> [[W]])-prop_concatPL     = adjustSize (`div` 2) $-                    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) $-                    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])-prop_dropWhilePL  = P.dropWhile `eq2`    (dropWhile :: (W -> Bool) -> [W] -> [W])-prop_filterPL     = P.filter    `eq2`    (filter    :: (W -> Bool ) -> [W] -> [W])-prop_filterPL_rule= (\x -> P.filter ((==) x))  `eq2` -- test rules-                    ((\x -> filter ((==) x)) :: W -> [W] -> [W])---- under lambda doesn't fire?-prop_filterLC_rule= (f)  `eq2` -- test rules-                    ((\x -> filter ((==) x)) :: Char -> [Char] -> [Char])-    where-         f x s = LC.filter ((==) x) s--prop_partitionPL  = P.partition `eq2`    (partition :: (W -> Bool ) -> [W] -> ([W],[W]))-prop_partitionLL  = L.partition `eq2`    (partition :: (W -> Bool ) -> [W] -> ([W],[W]))-prop_findPL       = P.find      `eq2`    (find      :: (W -> Bool) -> [W] -> Maybe W)-prop_findIndexPL  = P.findIndex `eq2`    (findIndex :: (W -> Bool) -> [W] -> Maybe Int)-prop_isPrefixOfPL = P.isPrefixOf`eq2`    (isPrefixOf:: [W] -> [W] -> Bool)-prop_isInfixOfPL  = P.isInfixOf `eq2`    (isInfixOf:: [W] -> [W] -> Bool)-prop_mapPL        = P.map       `eq2`    (map       :: (W -> W) -> [W] -> [W])-prop_replicatePL  = forAll arbitrarySizedIntegral $-                    P.replicate `eq2`    (replicate :: Int -> W -> [W])-prop_snocPL       = P.snoc      `eq2`    ((\xs x -> xs ++ [x]) :: [W] -> W -> [W])-prop_spanPL       = P.span      `eq2`    (span      :: (W -> Bool) -> [W] -> ([W],[W]))-prop_splitAtPL    = P.splitAt   `eq2`    (splitAt   :: Int -> [W] -> ([W],[W]))-prop_takePL       = P.take      `eq2`    (take      :: Int -> [W] -> [W])-prop_takeWhilePL  = P.takeWhile `eq2`    (takeWhile :: (W -> Bool) -> [W] -> [W])-prop_elemPL       = P.elem      `eq2`    (elem      :: W -> [W] -> Bool)-prop_notElemPL    = P.notElem   `eq2`    (notElem   :: W -> [W] -> Bool)-prop_elemIndexPL  = P.elemIndex `eq2`    (elemIndex :: W -> [W] -> Maybe Int)-prop_linesPL      = C.lines     `eq1`    (lines     :: String -> [String])-prop_findIndicesPL= P.findIndices`eq2`   (findIndices:: (W -> Bool) -> [W] -> [Int])-prop_elemIndicesPL= P.elemIndices`eq2`   (elemIndices:: W -> [W] -> [Int])-prop_zipPL        = P.zip        `eq2`   (zip :: [W] -> [W] -> [(W,W)])-prop_zipCL        = C.zip        `eq2`   (zip :: [Char] -> [Char] -> [(Char,Char)])-prop_zipLL        = L.zip        `eq2`   (zip :: [W] -> [W] -> [(W,W)])-prop_unzipPL      = P.unzip      `eq1`   (unzip :: [(W,W)] -> ([W],[W]))-prop_unzipLL      = L.unzip      `eq1`   (unzip :: [(W,W)] -> ([W],[W]))-prop_unzipCL      = C.unzip      `eq1`   (unzip :: [(Char,Char)] -> ([Char],[Char]))--prop_foldl1PL     = P.foldl1    `eqnotnull2` (foldl1   :: (W -> W -> W) -> [W] -> W)-prop_foldl1PL'    = P.foldl1'   `eqnotnull2` (foldl1' :: (W -> W -> W) -> [W] -> W)-prop_foldr1PL     = P.foldr1    `eqnotnull2` (foldr1 :: (W -> W -> W) -> [W] -> W)-prop_scanlPL      = P.scanl     `eqnotnull3` (scanl  :: (W -> W -> W) -> W -> [W] -> [W])-prop_scanl1PL     = P.scanl1    `eqnotnull2` (scanl1 :: (W -> W -> W) -> [W] -> [W])-prop_scanrPL      = P.scanr     `eqnotnull3` (scanr  :: (W -> W -> W) -> W -> [W] -> [W])-prop_scanr1PL     = P.scanr1    `eqnotnull2` (scanr1 :: (W -> W -> W) -> [W] -> [W])-prop_headPL       = P.head      `eqnotnull1` (head      :: [W] -> W)-prop_initPL       = P.init      `eqnotnull1` (init      :: [W] -> [W])-prop_lastPL       = P.last      `eqnotnull1` (last      :: [W] -> W)-prop_maximumPL    = P.maximum   `eqnotnull1` (maximum   :: [W] -> W)-prop_minimumPL    = P.minimum   `eqnotnull1` (minimum   :: [W] -> W)-prop_tailPL       = P.tail      `eqnotnull1` (tail      :: [W] -> [W])--prop_scanl1CL     = C.scanl1    `eqnotnull2` (scanl1 :: (Char -> Char -> Char) -> [Char] -> [Char])-prop_scanrCL      = C.scanr     `eqnotnull3` (scanr  :: (Char -> Char -> Char) -> Char -> [Char] -> [Char])-prop_scanr1CL     = C.scanr1    `eqnotnull2` (scanr1 :: (Char -> Char -> Char) -> [Char] -> [Char])---- prop_zipWithPL'   = P.zipWith'  `eq3` (zipWith :: (W -> W -> W) -> [W] -> [W] -> [W])--prop_zipWithPL    = (P.zipWith  :: (W -> W -> X) -> P   -> P   -> [X]) `eq3`-                      (zipWith  :: (W -> W -> X) -> [W] -> [W] -> [X])--prop_zipWithPL_rules   = (P.zipWith  :: (W -> W -> W) -> P -> P -> [W]) `eq3`-                         (zipWith    :: (W -> W -> W) -> [W] -> [W] -> [W])--prop_eqPL      = eq2-    ((==) :: P   -> P   -> Bool)-    ((==) :: [W] -> [W] -> Bool)-prop_comparePL = eq2-    ((compare) :: P   -> P   -> Ordering)-    ((compare) :: [W] -> [W] -> Ordering)-prop_foldlPL   = eq3-    (P.foldl  :: (X -> W -> X) -> X -> P        -> X)-    (  foldl  :: (X -> W -> X) -> X -> [W]      -> X)-prop_foldlPL'  = eq3-    (P.foldl' :: (X -> W -> X) -> X -> P        -> X)-    (  foldl' :: (X -> W -> X) -> X -> [W]      -> X)-prop_foldrPL   = eq3-    (P.foldr  :: (W -> X -> X) -> X -> P        -> X)-    (  foldr  :: (W -> X -> X) -> X -> [W]      -> X)-prop_mapAccumLPL= eq3-    (P.mapAccumL :: (X -> W -> (X,W)) -> X -> P -> (X, P))-    (  mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))-prop_mapAccumRPL= eq3-    (P.mapAccumR :: (X -> W -> (X,W)) -> X -> P -> (X, P))-    (  mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))-prop_unfoldrPL =-  forAll arbitrarySizedIntegral $-  eq3-    ((\n f a ->      fst $-        P.unfoldrN n f a) :: Int -> (X -> Maybe (W,X)) -> X -> P)-    ((\n f a ->   take n $-          unfoldr    f a) :: Int -> (X -> Maybe (W,X)) -> X -> [W])-------------------------------------------------------------------------------- These are miscellaneous tests left over. Or else they test some--- property internal to a type (i.e. head . sort == minimum), without--- reference to a model type.-----invariant :: L.ByteString -> Bool-invariant Empty       = True-invariant (Chunk c cs) = not (P.null c) && invariant cs--prop_invariant = invariant--prop_eq_refl  x     = x        == (x :: ByteString)-prop_eq_symm  x y   = (x == y) == (y == (x :: ByteString))--prop_eq1 xs      = xs == (unpack . pack $ xs)-prop_eq2 xs      = xs == (xs :: ByteString)-prop_eq3 xs ys   = (xs == ys) == (unpack xs == unpack ys)--prop_compare1 xs   = (pack xs        `compare` pack xs) == EQ-prop_compare2 xs c = (pack (xs++[c]) `compare` pack xs) == GT-prop_compare3 xs c = (pack xs `compare` pack (xs++[c])) == LT--prop_compare4 xs    = (not (null xs)) ==> (pack xs  `compare` L.empty) == GT-prop_compare5 xs    = (not (null xs)) ==> (L.empty `compare` pack xs) == LT-prop_compare6 xs ys = (not (null ys)) ==> (pack (xs++ys)  `compare` pack xs) == GT--prop_compare7 x  y  = x  `compare` y  == (L.singleton x `compare` L.singleton y)-prop_compare8 xs ys = xs `compare` ys == (L.pack xs `compare` L.pack ys)--prop_compare7LL x  y  = x  `compare` y  == (LC.singleton x `compare` LC.singleton y)--prop_empty1 = L.length L.empty == 0-prop_empty2 = L.unpack L.empty == []--prop_packunpack s = (L.unpack . L.pack) s == id s-prop_unpackpack s = (L.pack . L.unpack) s == id s--prop_null xs = null (L.unpack xs) == L.null xs--prop_length1 xs = fromIntegral (length xs) == L.length (L.pack xs)--prop_length2 xs = L.length xs == length1 xs-  where length1 ys-            | L.null ys = 0-            | otherwise = 1 + length1 (L.tail ys)--prop_cons1 c xs = unpack (L.cons c (pack xs)) == (c:xs)-prop_cons2 c    = L.singleton c == (c `L.cons` L.empty)-prop_cons3 c    = unpack (L.singleton c) == (c:[])-prop_cons4 c    = (c `L.cons` L.empty)  == pack (c:[])--prop_snoc1 xs c = xs ++ [c] == unpack ((pack xs) `L.snoc` c)--prop_head  xs = (not (null xs)) ==> head xs == (L.head . pack) xs-prop_head1 xs = not (L.null xs) ==> L.head xs == head (L.unpack xs)--prop_tail xs  = not (L.null xs) ==> L.tail xs == pack (tail (unpack xs))-prop_tail1 xs = (not (null xs)) ==> tail xs   == (unpack . L.tail . pack) xs--prop_last xs  = (not (null xs)) ==> last xs    == (L.last . pack) xs--prop_init xs  =-    (not (null xs)) ==>-    init xs   == (unpack . L.init . pack) xs--prop_append1 xs    = (xs ++ xs) == (unpack $ pack xs `L.append` pack xs)-prop_append2 xs ys = (xs ++ ys) == (unpack $ pack xs `L.append` pack ys)-prop_append3 xs ys = L.append xs ys == pack (unpack xs ++ unpack ys)--prop_map1 f xs   = L.map f (pack xs)    == pack (map f xs)-prop_map2 f g xs = L.map f (L.map g xs) == L.map (f . g) xs-prop_map3 f xs   = map f xs == (unpack . L.map f .  pack) xs--prop_filter1 c xs = (filter (/=c) xs) == (unpack $ L.filter (/=c) (pack xs))-prop_filter2 p xs = (filter p xs) == (unpack $ L.filter p (pack xs))--prop_reverse  xs = reverse xs          == (unpack . L.reverse . pack) xs-prop_reverse1 xs = L.reverse (pack xs) == pack (reverse xs)-prop_reverse2 xs = reverse (unpack xs) == (unpack . L.reverse) xs--prop_transpose xs = (transpose xs) == ((map unpack) . L.transpose . (map pack)) xs--prop_foldl f c xs = L.foldl f c (pack xs) == foldl f c xs-    where _ = c :: Char--prop_foldr f c xs = L.foldl f c (pack xs) == foldl f c xs-    where _ = c :: Char--prop_foldl_1 xs = L.foldl (\xs c -> c `L.cons` xs) L.empty xs == L.reverse xs-prop_foldr_1 xs = L.foldr (\c xs -> c `L.cons` xs) L.empty xs == id xs--prop_foldl1_1 xs =-    (not . L.null) xs ==>-    L.foldl1 (\x c -> if c > x then c else x)   xs ==-    L.foldl  (\x c -> if c > x then c else x) 0 xs--prop_foldl1_2 xs =-    (not . L.null) xs ==>-    L.foldl1 const xs == L.head xs--prop_foldl1_3 xs =-    (not . L.null) xs ==>-    L.foldl1 (flip const) xs == L.last xs--prop_foldr1_1 xs =-    (not . L.null) xs ==>-    L.foldr1 (\c x -> if c > x then c else x)   xs ==-    L.foldr  (\c x -> if c > x then c else x) 0 xs--prop_foldr1_2 xs =-    (not . L.null) xs ==>-    L.foldr1 (flip const) xs == L.last xs--prop_foldr1_3 xs =-    (not . L.null) xs ==>-    L.foldr1 const xs == L.head xs--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_concatMap xs = L.concatMap L.singleton xs == (pack . concatMap (:[]) . unpack) xs--prop_any xs a = (any (== a) xs) == (L.any (== a) (pack xs))-prop_all xs a = (all (== a) xs) == (L.all (== a) (pack xs))--prop_maximum xs = (not (null xs)) ==> (maximum xs) == (L.maximum ( pack xs ))-prop_minimum xs = (not (null xs)) ==> (minimum xs) == (L.minimum ( pack xs ))--prop_replicate1 c =-    forAll arbitrarySizedIntegral $ \(Positive n) ->-    unpack (L.replicate (fromIntegral n) c) == replicate n c--prop_replicate2 c = unpack (L.replicate 0 c) == replicate 0 c--prop_take1 i xs = L.take (fromIntegral i) (pack xs) == pack (take i xs)-prop_drop1 i xs = L.drop (fromIntegral i) (pack xs) == pack (drop i xs)--prop_splitAt i xs = --collect (i >= 0 && i < length xs) $-    L.splitAt (fromIntegral i) (pack xs) == let (a,b) = splitAt i xs in (pack a, pack b)--prop_takeWhile f xs = L.takeWhile f (pack xs) == pack (takeWhile f xs)-prop_dropWhile f xs = L.dropWhile f (pack xs) == pack (dropWhile f xs)--prop_break f xs = L.break f (pack xs) ==-    let (a,b) = break f xs in (pack a, pack b)--prop_breakspan xs c = L.break (==c) xs == L.span (/=c) xs--prop_span xs a = (span (/=a) xs) == (let (x,y) = L.span (/=a) (pack xs) in (unpack x, unpack y))---- prop_breakByte xs c = L.break (== c) xs == L.breakByte c xs---- prop_spanByte c xs = (L.span (==c) xs) == L.spanByte c xs--prop_split c xs = (map L.unpack . map checkInvariant . L.split c $ xs)-               == (map P.unpack . P.split c . P.pack . L.unpack $ xs)--prop_splitWith f xs = (l1 == l2 || l1 == l2+1) &&-        sum (map L.length splits) == L.length xs - l2-  where splits = L.splitWith f xs-        l1 = fromIntegral (length splits)-        l2 = L.length (L.filter f xs)--prop_splitWith_D f xs = (l1 == l2 || l1 == l2+1) &&-        sum (map D.length splits) == D.length xs - l2-  where splits = D.splitWith f xs-        l1 = fromIntegral (length splits)-        l2 = D.length (D.filter f xs)--prop_splitWith_C f xs = (l1 == l2 || l1 == l2+1) &&-        sum (map C.length splits) == C.length xs - l2-  where splits = C.splitWith f xs-        l1 = fromIntegral (length splits)-        l2 = C.length (C.filter f xs)--prop_joinsplit c xs = L.intercalate (pack [c]) (L.split c xs) == id xs--prop_group xs       = group xs == (map unpack . L.group . pack) xs-prop_groupBy  f xs  = groupBy f xs == (map unpack . L.groupBy f . pack) xs-prop_groupBy_LC  f xs  = groupBy f xs == (map LC.unpack . LC.groupBy f .  LC.pack) xs---- prop_joinjoinByte xs ys c = L.joinWithByte c xs ys == L.join (L.singleton c) [xs,ys]--prop_index xs =-  not (null xs) ==>-    forAll indices $ \i -> (xs !! i) == L.pack xs `L.index` (fromIntegral i)-  where indices = choose (0, length xs -1)--prop_index_D xs =-  not (null xs) ==>-    forAll indices $ \i -> (xs !! i) == D.pack xs `D.index` (fromIntegral i)-  where indices = choose (0, length xs -1)--prop_index_C xs =-  not (null xs) ==>-    forAll indices $ \i -> (xs !! i) == C.pack xs `C.index` (fromIntegral i)-  where indices = choose (0, length xs -1)--prop_elemIndex xs c = (elemIndex c xs) == fmap fromIntegral (L.elemIndex c (pack xs))-prop_elemIndexCL xs c = (elemIndex c xs) == (C.elemIndex c (C.pack xs))--prop_elemIndices xs c = elemIndices c xs == map fromIntegral (L.elemIndices c (pack xs))--prop_count c xs = length (L.elemIndices c xs) == fromIntegral (L.count c xs)--prop_findIndex xs f = (findIndex f xs) == fmap fromIntegral (L.findIndex f (pack xs))-prop_findIndicies xs f = (findIndices f xs) == map fromIntegral (L.findIndices f (pack xs))--prop_elem    xs c = (c `elem` xs)    == (c `L.elem` (pack xs))-prop_notElem xs c = (c `notElem` xs) == (L.notElem c (pack xs))-prop_elem_notelem xs c = c `L.elem` xs == not (c `L.notElem` xs)---- prop_filterByte  xs c = L.filterByte c xs == L.filter (==c) xs--- prop_filterByte2 xs c = unpack (L.filterByte c xs) == filter (==c) (unpack xs)---- prop_filterNotByte  xs c = L.filterNotByte c xs == L.filter (/=c) xs--- prop_filterNotByte2 xs c = unpack (L.filterNotByte c xs) == filter (/=c) (unpack xs)--prop_find p xs = find p xs == L.find p (pack xs)--prop_find_findIndex p xs =-    L.find p xs == case L.findIndex p xs of-                                Just n -> Just (xs `L.index` n)-                                _      -> Nothing--prop_isPrefixOf xs ys = isPrefixOf xs ys == (pack xs `L.isPrefixOf` pack ys)--{--prop_sort1 xs = sort xs == (unpack . L.sort . pack) xs-prop_sort2 xs = (not (null xs)) ==> (L.head . L.sort . pack $ xs) == minimum xs-prop_sort3 xs = (not (null xs)) ==> (L.last . L.sort . pack $ xs) == maximum xs-prop_sort4 xs ys =-        (not (null xs)) ==>-        (not (null ys)) ==>-        (L.head . L.sort) (L.append (pack xs) (pack ys)) == min (minimum xs) (minimum ys)--prop_sort5 xs ys =-        (not (null xs)) ==>-        (not (null ys)) ==>-        (L.last . L.sort) (L.append (pack xs) (pack ys)) == max (maximum xs) (maximum ys)---}----------------------------------------------------------------------------- Misc ByteString properties--prop_nil1BB = P.length P.empty == 0-prop_nil2BB = P.unpack P.empty == []-prop_nil1BB_monoid = P.length mempty == 0-prop_nil2BB_monoid = P.unpack mempty == []--prop_nil1LL_monoid = L.length mempty == 0-prop_nil2LL_monoid = L.unpack mempty == []--prop_tailSBB xs = not (P.null xs) ==> P.tail xs == P.pack (tail (P.unpack xs))--prop_nullBB xs = null (P.unpack xs) == P.null xs--prop_lengthBB xs = P.length xs == length1 xs-    where-        length1 ys-            | P.null ys = 0-            | otherwise = 1 + length1 (P.tail ys)--prop_lengthSBB xs = length xs == P.length (P.pack xs)--prop_indexBB xs =-  not (null xs) ==>-    forAll indices $ \i -> (xs !! i) == P.pack xs `P.index` i-  where indices = choose (0, length xs -1)--prop_unsafeIndexBB xs =-  not (null xs) ==>-    forAll indices $ \i -> (xs !! i) == P.pack xs `P.unsafeIndex` i-  where indices = choose (0, length xs -1)--prop_mapfusionBB f g xs = P.map f (P.map g xs) == P.map (f . g) xs--prop_filterBB f xs = P.filter f (P.pack xs) == P.pack (filter f xs)--prop_filterfusionBB f g xs = P.filter f (P.filter g xs) == P.filter (\c -> f c && g c) xs--prop_elemSBB x xs = P.elem x (P.pack xs) == elem x xs--prop_takeSBB i xs = P.take i (P.pack xs) == P.pack (take i xs)-prop_dropSBB i xs = P.drop i (P.pack xs) == P.pack (drop i xs)--prop_splitAtSBB i xs = -- collect (i >= 0 && i < length xs) $-    P.splitAt i (P.pack xs) ==-    let (a,b) = splitAt i xs in (P.pack a, P.pack b)--prop_foldlBB f c xs = P.foldl f c (P.pack xs) == foldl f c xs-  where types = c :: Char--prop_scanlfoldlBB f z xs = not (P.null xs) ==> P.last (P.scanl f z xs) == P.foldl f z xs--prop_foldrBB f c xs = P.foldl f c (P.pack xs) == foldl f c xs-  where types = c :: Char--prop_takeWhileSBB f xs = P.takeWhile f (P.pack xs) == P.pack (takeWhile f xs)-prop_dropWhileSBB f xs = P.dropWhile f (P.pack xs) == P.pack (dropWhile f xs)--prop_spanSBB f xs = P.span f (P.pack xs) ==-    let (a,b) = span f xs in (P.pack a, P.pack b)--prop_breakSBB f xs = P.break f (P.pack xs) ==-    let (a,b) = break f xs in (P.pack a, P.pack b)--prop_breakspan_1BB xs c = P.break (== c) xs == P.span (/= c) xs--prop_linesSBB xs = C.lines (C.pack xs) == map C.pack (lines xs)--prop_unlinesSBB xss = C.unlines (map C.pack xss) == C.pack (unlines xss)--prop_wordsSBB xs =-    C.words (C.pack xs) == map C.pack (words xs)--prop_wordsLC xs =-    LC.words (LC.pack xs) == map LC.pack (words xs)--prop_unwordsSBB xss = C.unwords (map C.pack xss) == C.pack (unwords xss)-prop_unwordsSLC xss = LC.unwords (map LC.pack xss) == LC.pack (unwords xss)--prop_splitWithBB f xs = (l1 == l2 || l1 == l2+1) &&-        sum (map P.length splits) == P.length xs - l2-  where splits = P.splitWith f xs-        l1 = length splits-        l2 = P.length (P.filter f xs)--prop_joinsplitBB c xs = P.intercalate (P.pack [c]) (P.split c xs) == xs--prop_intercalatePL c x y =--    P.intercalate (P.singleton c) (x : y : []) ==- --     intercalate (singleton c) (s1 : s2 : [])--    P.pack (intercalate [c] [P.unpack x,P.unpack y])---- prop_linessplitBB xs =---     (not . C.null) xs ==>---     C.lines' xs == C.split '\n' xs---- false:-{--prop_linessplit2BB xs =-   (not . C.null) xs ==>-    C.lines xs == C.split '\n' xs ++ (if C.last xs == '\n' then [C.empty] else [])--}--prop_splitsplitWithBB c xs = P.split c xs == P.splitWith (== c) xs--prop_bijectionBB  c = (P.w2c . P.c2w) c == id c-prop_bijectionBB' w = (P.c2w . P.w2c) w == id w--prop_packunpackBB  s = (P.unpack . P.pack) s == id s-prop_packunpackBB' s = (P.pack . P.unpack) s == id s--prop_eq1BB xs      = xs            == (P.unpack . P.pack $ xs)-prop_eq2BB xs      = xs == (xs :: P.ByteString)-prop_eq3BB xs ys   = (xs == ys) == (P.unpack xs == P.unpack ys)--prop_compare1BB xs  = (P.pack xs         `compare` P.pack xs) == EQ-prop_compare2BB xs c = (P.pack (xs++[c]) `compare` P.pack xs) == GT-prop_compare3BB xs c = (P.pack xs `compare` P.pack (xs++[c])) == LT--prop_compare4BB xs  = (not (null xs)) ==> (P.pack xs  `compare` P.empty) == GT-prop_compare5BB xs  = (not (null xs)) ==> (P.empty `compare` P.pack xs) == LT-prop_compare6BB xs ys= (not (null ys)) ==> (P.pack (xs++ys)  `compare` P.pack xs) == GT--prop_compare7BB x  y = x `compare` y == (C.singleton x `compare` C.singleton y)-prop_compare8BB xs ys = xs `compare` ys == (P.pack xs `compare` P.pack ys)--prop_consBB  c xs = P.unpack (P.cons c (P.pack xs)) == (c:xs)-prop_cons1BB xs   = 'X' : xs == C.unpack ('X' `C.cons` (C.pack xs))-prop_cons2BB xs c = c : xs == P.unpack (c `P.cons` (P.pack xs))-prop_cons3BB c    = C.unpack (C.singleton c) == (c:[])-prop_cons4BB c    = (c `P.cons` P.empty)  == P.pack (c:[])--prop_snoc1BB xs c = xs ++ [c] == P.unpack ((P.pack xs) `P.snoc` c)--prop_head1BB xs     = (not (null xs)) ==> head  xs  == (P.head . P.pack) xs-prop_head2BB xs    = (not (null xs)) ==> head xs   == (P.unsafeHead . P.pack) xs-prop_head3BB xs    = not (P.null xs) ==> P.head xs == head (P.unpack xs)--prop_tailBB xs     = (not (null xs)) ==> tail xs    == (P.unpack . P.tail . P.pack) xs-prop_tail1BB xs    = (not (null xs)) ==> tail xs    == (P.unpack . P.unsafeTail. P.pack) xs--prop_lastBB xs     = (not (null xs)) ==> last xs    == (P.last . P.pack) xs--prop_initBB xs     =-    (not (null xs)) ==>-    init xs    == (P.unpack . P.init . P.pack) xs---- prop_null xs = (null xs) ==> null xs == (nullPS (pack xs))--prop_append1BB xs    = (xs ++ xs) == (P.unpack $ P.pack xs `P.append` P.pack xs)-prop_append2BB xs ys = (xs ++ ys) == (P.unpack $ P.pack xs `P.append` P.pack ys)-prop_append3BB xs ys = P.append xs ys == P.pack (P.unpack xs ++ P.unpack ys)--prop_append1BB_monoid xs    = (xs ++ xs) == (P.unpack $ P.pack xs `mappend` P.pack xs)-prop_append2BB_monoid xs ys = (xs ++ ys) == (P.unpack $ P.pack xs `mappend` P.pack ys)-prop_append3BB_monoid xs ys = mappend xs ys == P.pack (P.unpack xs ++ P.unpack ys)--prop_append1LL_monoid xs    = (xs ++ xs) == (L.unpack $ L.pack xs `mappend` L.pack xs)-prop_append2LL_monoid xs ys = (xs ++ ys) == (L.unpack $ L.pack xs `mappend` L.pack ys)-prop_append3LL_monoid xs ys = mappend xs ys == L.pack (L.unpack xs ++ L.unpack ys)--prop_map1BB f xs   = P.map f (P.pack xs)    == P.pack (map f xs)-prop_map2BB f g xs = P.map f (P.map g xs) == P.map (f . g) xs-prop_map3BB f xs   = map f xs == (P.unpack . P.map f .  P.pack) xs--- prop_mapBB' f xs   = P.map' f (P.pack xs) == P.pack (map f xs)--prop_filter1BB xs   = (filter (=='X') xs) == (C.unpack $ C.filter (=='X') (C.pack xs))-prop_filter2BB p xs = (filter p xs) == (P.unpack $ P.filter p (P.pack xs))--prop_findBB p xs = find p xs == P.find p (P.pack xs)--prop_find_findIndexBB p xs =-    P.find p xs == case P.findIndex p xs of-                                Just n -> Just (xs `P.unsafeIndex` n)-                                _      -> Nothing--prop_foldl1BB xs a = ((foldl (\x c -> if c == a then x else c:x) [] xs)) ==-                   (P.unpack $ P.foldl (\x c -> if c == a then x else c `P.cons` x) P.empty (P.pack xs)) -prop_foldl2BB xs = P.foldl (\xs c -> c `P.cons` xs) P.empty (P.pack xs) == P.reverse (P.pack xs)--prop_foldr1BB xs a = ((foldr (\c x -> if c == a then x else c:x) [] xs)) ==-                (P.unpack $ P.foldr (\c x -> if c == a then x else c `P.cons` x)-                    P.empty (P.pack xs))--prop_foldr2BB xs = P.foldr (\c xs -> c `P.cons` xs) P.empty (P.pack xs) == (P.pack xs)--prop_foldl1_1BB xs =-    (not . P.null) xs ==>-    P.foldl1 (\x c -> if c > x then c else x)   xs ==-    P.foldl  (\x c -> if c > x then c else x) 0 xs--prop_foldl1_2BB xs =-    (not . P.null) xs ==>-    P.foldl1 const xs == P.head xs--prop_foldl1_3BB xs =-    (not . P.null) xs ==>-    P.foldl1 (flip const) xs == P.last xs--prop_foldr1_1BB xs =-    (not . P.null) xs ==>-    P.foldr1 (\c x -> if c > x then c else x)   xs ==-    P.foldr  (\c x -> if c > x then c else x) 0 xs--prop_foldr1_2BB xs =-    (not . P.null) xs ==>-    P.foldr1 (flip const) xs == P.last xs--prop_foldr1_3BB xs =-    (not . P.null) xs ==>-    P.foldr1 const xs == P.head xs--prop_takeWhileBB xs a = (takeWhile (/= a) xs) == (P.unpack . (P.takeWhile (/= a)) . P.pack) xs--prop_dropWhileBB xs a = (dropWhile (/= a) xs) == (P.unpack . (P.dropWhile (/= a)) . P.pack) xs--prop_dropWhileCC_isSpace xs =-        (dropWhile isSpace xs) ==-       (C.unpack .  (C.dropWhile isSpace) . C.pack) xs--prop_takeBB xs = (take 10 xs) == (P.unpack . (P.take 10) . P.pack) xs--prop_dropBB xs = (drop 10 xs) == (P.unpack . (P.drop 10) . P.pack) xs--prop_splitAtBB i xs = -- collect (i >= 0 && i < length xs) $-    splitAt i xs ==-    let (x,y) = P.splitAt i (P.pack xs) in (P.unpack x, P.unpack y)--prop_spanBB xs a = (span (/=a) xs) == (let (x,y) = P.span (/=a) (P.pack xs)-                                     in (P.unpack x, P.unpack y))--prop_breakBB xs a = (break (/=a) xs) == (let (x,y) = P.break (/=a) (P.pack xs)-                                       in (P.unpack x, P.unpack y))--prop_reverse1BB xs = (reverse xs) == (P.unpack . P.reverse . P.pack) xs-prop_reverse2BB xs = P.reverse (P.pack xs) == P.pack (reverse xs)-prop_reverse3BB xs = reverse (P.unpack xs) == (P.unpack . P.reverse) xs--prop_elemBB xs a = (a `elem` xs) == (a `P.elem` (P.pack xs))--prop_notElemBB c xs = P.notElem c (P.pack xs) == notElem c xs---- should try to stress it-prop_concat1BB xs = (concat [xs,xs]) == (P.unpack $ P.concat [P.pack xs, P.pack xs])-prop_concat2BB xs = (concat [xs,[]]) == (P.unpack $ P.concat [P.pack xs, P.pack []])-prop_concatBB xss = P.concat (map P.pack xss) == P.pack (concat xss)--prop_concat1BB_monoid xs = (concat [xs,xs]) == (P.unpack $ mconcat [P.pack xs, P.pack xs])-prop_concat2BB_monoid xs = (concat [xs,[]]) == (P.unpack $ mconcat [P.pack xs, P.pack []])-prop_concatBB_monoid xss = mconcat (map P.pack xss) == P.pack (concat xss)--prop_concat1LL_monoid xs = (concat [xs,xs]) == (L.unpack $ mconcat [L.pack xs, L.pack xs])-prop_concat2LL_monoid xs = (concat [xs,[]]) == (L.unpack $ mconcat [L.pack xs, L.pack []])-prop_concatLL_monoid xss = mconcat (map L.pack xss) == L.pack (concat xss)--prop_concatMapBB xs = C.concatMap C.singleton xs == (C.pack . concatMap (:[]) . C.unpack) xs--prop_anyBB xs a = (any (== a) xs) == (P.any (== a) (P.pack xs))-prop_allBB xs a = (all (== a) xs) == (P.all (== a) (P.pack xs))--prop_linesBB xs = (lines xs) == ((map C.unpack) . C.lines . C.pack) xs--prop_unlinesBB xs = (unlines.lines) xs == (C.unpack. C.unlines . C.lines .C.pack) xs-prop_unlinesLC xs = (unlines.lines) xs == (LC.unpack. LC.unlines .  LC.lines .LC.pack) xs--prop_wordsBB xs =-    (words xs) == ((map C.unpack) . C.words . C.pack) xs--- prop_wordstokensBB xs = C.words xs == C.tokens isSpace xs--prop_unwordsBB xs =-    (C.pack.unwords.words) xs == (C.unwords . C.words .C.pack) xs--prop_groupBB xs   = group xs == (map P.unpack . P.group . P.pack) xs--prop_groupByBB  xs = groupBy (==) xs == (map P.unpack . P.groupBy (==) . P.pack) xs-prop_groupByCC  xs = groupBy (==) xs == (map C.unpack . C.groupBy (==) . C.pack) xs-prop_groupBy1BB xs = groupBy (/=) xs == (map P.unpack . P.groupBy (/=) . P.pack) xs-prop_groupBy1CC xs = groupBy (/=) xs == (map C.unpack . C.groupBy (/=) . C.pack) xs--prop_joinBB xs ys = (concat . (intersperse ys) . lines) xs ==-               (C.unpack $ C.intercalate (C.pack ys) (C.lines (C.pack xs)))--prop_elemIndex1BB xs   = (elemIndex 'X' xs) == (C.elemIndex 'X' (C.pack xs))-prop_elemIndex2BB xs c = (elemIndex c xs) == (C.elemIndex c (C.pack xs))---- prop_lineIndices1BB xs = C.elemIndices '\n' xs == C.lineIndices xs--prop_countBB c xs = length (P.elemIndices c xs) == P.count c xs--prop_elemIndexEnd1BB c xs = (P.elemIndexEnd c (P.pack xs)) ==-                           (case P.elemIndex c (P.pack (reverse xs)) of-                                Nothing -> Nothing-                                Just i  -> Just (length xs -1 -i))--prop_elemIndexEnd1CC c xs = (C.elemIndexEnd c (C.pack xs)) ==-                           (case C.elemIndex c (C.pack (reverse xs)) of-                                Nothing -> Nothing-                                Just i  -> Just (length xs -1 -i))--prop_elemIndexEnd2BB c xs = (P.elemIndexEnd c (P.pack xs)) ==-                           ((-) (length xs - 1) `fmap` P.elemIndex c (P.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))--prop_findIndiciesBB xs c = (findIndices (==c) xs) == (P.findIndices (==c) (P.pack xs))---- example properties from QuickCheck.Batch-prop_sort1BB xs = sort xs == (P.unpack . P.sort . P.pack) xs-prop_sort2BB xs = (not (null xs)) ==> (P.head . P.sort . P.pack $ xs) == minimum xs-prop_sort3BB xs = (not (null xs)) ==> (P.last . P.sort . P.pack $ xs) == maximum xs-prop_sort4BB xs ys =-        (not (null xs)) ==>-        (not (null ys)) ==>-        (P.head . P.sort) (P.append (P.pack xs) (P.pack ys)) == min (minimum xs) (minimum ys)-prop_sort5BB xs ys =-        (not (null xs)) ==>-        (not (null ys)) ==>-        (P.last . P.sort) (P.append (P.pack xs) (P.pack ys)) == max (maximum xs) (maximum ys)--prop_intersperseBB c xs = (intersperse c xs) == (P.unpack $ P.intersperse c (P.pack xs))---- prop_transposeBB xs = (transpose xs) == ((map P.unpack) . P.transpose .  (map P.pack)) xs--prop_maximumBB xs = (not (null xs)) ==> (maximum xs) == (P.maximum ( P.pack xs ))-prop_minimumBB xs = (not (null xs)) ==> (minimum xs) == (P.minimum ( P.pack xs ))---- prop_dropSpaceBB xs    = dropWhile isSpace xs == C.unpack (C.dropSpace (C.pack xs))--- prop_dropSpaceEndBB xs = (C.reverse . (C.dropWhile isSpace) . C.reverse) (C.pack xs) ==---                        (C.dropSpaceEnd (C.pack xs))---- prop_breakSpaceBB xs =---     (let (x,y) = C.breakSpace (C.pack xs)---      in (C.unpack x, C.unpack y)) == (break isSpace xs)--prop_spanEndBB xs =-        (C.spanEnd (not . isSpace) (C.pack xs)) ==-        (let (x,y) = C.span (not.isSpace) (C.reverse (C.pack xs)) in (C.reverse y,C.reverse x))--prop_breakEndBB p xs = P.breakEnd (not.p) xs == P.spanEnd p xs-prop_breakEndCC p xs = C.breakEnd (not.p) xs == C.spanEnd p xs--{--prop_breakCharBB c xs =-        (break (==c) xs) ==-        (let (x,y) = C.breakChar c (C.pack xs) in (C.unpack x, C.unpack y))--prop_spanCharBB c xs =-        (break (/=c) xs) ==-        (let (x,y) = C.spanChar c (C.pack xs) in (C.unpack x, C.unpack y))--prop_spanChar_1BB c xs =-        (C.span (==c) xs) == C.spanChar c xs--prop_wordsBB' xs =-    (C.unpack . C.unwords  . C.words' . C.pack) xs ==-    (map (\c -> if isSpace c then ' ' else c) xs)---- prop_linesBB' xs = (C.unpack . C.unlines' . C.lines' . C.pack) xs == (xs)--}--prop_unfoldrBB c =-    forAll arbitrarySizedIntegral $ \n ->-      (fst $ C.unfoldrN n fn c) == (C.pack $ take n $ unfoldr fn c)-  where-    fn x = Just (x, chr (ord x + 1))--prop_prefixBB xs ys = isPrefixOf xs ys == (P.pack xs `P.isPrefixOf` P.pack ys)-prop_suffixBB xs ys = isSuffixOf xs ys == (P.pack xs `P.isSuffixOf` P.pack ys)-prop_suffixLL xs ys = isSuffixOf xs ys == (L.pack xs `L.isSuffixOf` L.pack ys)--prop_copyBB xs = let p = P.pack xs in P.copy p == p-prop_copyLL xs = let p = L.pack xs in L.copy p == p--prop_initsBB xs = inits xs == map P.unpack (P.inits (P.pack xs))--prop_tailsBB xs = tails xs == map P.unpack (P.tails (P.pack xs))--prop_findSubstringsBB s x l-    = C.findSubstrings (C.pack p) (C.pack s) == naive_findSubstrings p s-  where-    _ = l :: Int-    _ = x :: Int--    -- we look for some random substring of the test string-    p = take (model l) $ drop (model x) s--    -- naive reference implementation-    naive_findSubstrings :: String -> String -> [Int]-    naive_findSubstrings p s = [x | x <- [0..length s], p `isPrefixOf` drop x s]--prop_findSubstringBB s x l-    = C.findSubstring (C.pack p) (C.pack s) == naive_findSubstring p s-  where-    _ = l :: Int-    _ = x :: Int--    -- we look for some random substring of the test string-    p = take (model l) $ drop (model x) s--    -- naive reference implementation-    naive_findSubstring :: String -> String -> Maybe Int-    naive_findSubstring p s = listToMaybe [x | x <- [0..length s], p `isPrefixOf` drop x s]---- correspondance between break and breakSubstring-prop_breakSubstringBB c l-    = P.break (== c) l == P.breakSubstring (P.singleton c) l--prop_breakSubstring_isInfixOf s l-    = P.isInfixOf s l == if P.null s then True-                                     else case P.breakSubstring s l of-                                            (x,y) | P.null y  -> False-                                                  | otherwise -> True--prop_breakSubstring_findSubstring s l-    = P.findSubstring s l == if P.null s then Just 0-                                       else case P.breakSubstring s l of-                                            (x,y) | P.null y  -> Nothing-                                                  | otherwise -> Just (P.length x)--prop_replicate1BB c = forAll arbitrarySizedIntegral $ \n ->-                      P.unpack (P.replicate n c) == replicate n c-prop_replicate2BB c = forAll arbitrarySizedIntegral $ \n ->-                      P.replicate n c == fst (P.unfoldrN n (\u -> Just (u,u)) c)--prop_replicate3BB c = P.unpack (P.replicate 0 c) == replicate 0 c--prop_readintBB n = (fst . fromJust . C.readInt . C.pack . show) n == (n :: Int)-prop_readintLL n = (fst . fromJust . D.readInt . D.pack . show) n == (n :: Int)--prop_readBB x = (read . show) x == (x :: P.ByteString)-prop_readLL x = (read . show) x == (x :: L.ByteString)--prop_readint2BB s =-    let s' = filter (\c -> c `notElem` ['0'..'9']) s-    in C.readInt (C.pack s') == Nothing--prop_readintegerBB n = (fst . fromJust . C.readInteger . C.pack . show) n == (n :: Integer)-prop_readintegerLL n = (fst . fromJust . D.readInteger . D.pack . show) n == (n :: Integer)--prop_readinteger2BB s =-    let s' = filter (\c -> c `notElem` ['0'..'9']) s-    in C.readInteger (C.pack s') == Nothing---- prop_filterChar1BB c xs = (filter (==c) xs) == ((C.unpack . C.filterChar c . C.pack) xs)--- prop_filterChar2BB c xs = (C.filter (==c) (C.pack xs)) == (C.filterChar c (C.pack xs))--- prop_filterChar3BB c xs = C.filterChar c xs == C.replicate (C.count c xs) c---- prop_filterNotChar1BB c xs = (filter (/=c) xs) == ((C.unpack . C.filterNotChar c . C.pack) xs)--- prop_filterNotChar2BB c xs = (C.filter (/=c) (C.pack xs)) == (C.filterNotChar c (C.pack xs))---- prop_joinjoinpathBB xs ys c = C.joinWithChar c xs ys == C.join (C.singleton c) [xs,ys]--prop_zipBB  xs ys = zip xs ys == P.zip (P.pack xs) (P.pack ys)-prop_zipLC  xs ys = zip xs ys == LC.zip (LC.pack xs) (LC.pack ys)-prop_zip1BB xs ys = P.zip xs ys == zip (P.unpack xs) (P.unpack ys)--prop_zipWithBB xs ys = P.zipWith (,) xs ys == P.zip xs ys-prop_zipWithCC xs ys = C.zipWith (,) xs ys == C.zip xs ys-prop_zipWithLC xs ys = LC.zipWith (,) xs ys == LC.zip xs ys--- prop_zipWith'BB xs ys = P.pack (P.zipWith (+) xs ys) == P.zipWith' (+) xs ys--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---- prop_join_spec c s1 s2 =---  P.join (P.singleton c) (s1 : s2 : []) == P.joinWithByte c s1 s2---- prop_break_spec x s =---     P.break ((==) x) s == P.breakByte x s---- prop_span_spec x s =---     P.span ((==) x) s == P.spanByte x s------------------------------------------------------------------------------ Test IsString-prop_isstring x = C.unpack (fromString x :: C.ByteString) == x-prop_isstring_lc x = LC.unpack (fromString x :: LC.ByteString) == x----------------------------------------------------------------------------- Unsafe functions---- Test unsafePackAddress-prop_unsafePackAddress (CByteString x) = unsafePerformIO $ do-        let (p,_,_) = P.toForeignPtr (x `P.snoc` 0)-        y <- withForeignPtr p $ \(Ptr addr) ->-            P.unsafePackAddress addr-        return (y == x)---- Test unsafePackAddressLen-prop_unsafePackAddressLen x = unsafePerformIO $ do-        let i = P.length x-            (p,_,_) = P.toForeignPtr (x `P.snoc` 0)-        y <- withForeignPtr p $ \(Ptr addr) ->-            P.unsafePackAddressLen i addr-        return (y == x)--prop_unsafeUseAsCString x = unsafePerformIO $ do-        let n = P.length x-        y <- P.unsafeUseAsCString x $ \cstr ->-                    sequence [ do a <- peekElemOff cstr i-                                  let b = x `P.index` i-                                  return (a == fromIntegral b)-                             | i <- [0.. n-1]     ]-        return (and y)--prop_unsafeUseAsCStringLen x = unsafePerformIO $ do-        let n = P.length x-        y <- P.unsafeUseAsCStringLen x $ \(cstr,_) ->-                    sequence [ do a <- peekElemOff cstr i-                                  let b = x `P.index` i-                                  return (a == fromIntegral b)-                             | i <- [0.. n-1]     ]-        return (and y)--prop_internal_invariant x = LP.invariant x--prop_useAsCString x = unsafePerformIO $ do-        let n = P.length x-        y <- P.useAsCString x $ \cstr ->-                    sequence [ do a <- peekElemOff cstr i-                                  let b = x `P.index` i-                                  return (a == fromIntegral b)-                             | i <- [0.. n-1]     ]-        return (and y)--prop_packCString (CByteString x) = unsafePerformIO $ do-        y <- P.useAsCString x $ P.unsafePackCString-        return (y == x)--prop_packCString_safe (CByteString x) = unsafePerformIO $ do-        y <- P.useAsCString x $ P.packCString-        return (y == x)--prop_packCStringLen x = unsafePerformIO $ do-        y <- P.useAsCStringLen x $ P.unsafePackCStringLen-        return (y == x && P.length y == P.length x)--prop_packCStringLen_safe x = unsafePerformIO $ do-        y <- P.useAsCStringLen x $ P.packCStringLen-        return (y == x && P.length y == P.length x)--prop_packMallocCString (CByteString x) = unsafePerformIO $ do--         let (fp,_,_) = P.toForeignPtr x-         ptr <- mallocArray0 (P.length x) :: IO (Ptr Word8)-         forM_ [0 .. P.length x] $ \n -> pokeElemOff ptr n 0-         withForeignPtr fp $ \qtr -> copyArray ptr qtr (P.length x)-         y   <- P.unsafePackMallocCString (castPtr ptr)--         let !z = y == x-         free ptr `seq` return z--prop_unsafeFinalize    x = unsafePerformIO $ do-        x <- P.unsafeFinalize x-        return (x == ())--prop_packCStringFinaliser x = unsafePerformIO $ do-        y <- P.useAsCString x $ \cstr -> P.unsafePackCStringFinalizer (castPtr cstr) (P.length x) (return ())-        return (y == x)--prop_show x = show x == show (C.unpack x)--prop_fromForeignPtr x = (let (a,b,c) = (P.toForeignPtr x)-                                in P.fromForeignPtr a b c) == x----------------------------------------------------------------------------- IO--prop_read_write_file_P x = unsafePerformIO $ do-    tid <- myThreadId-    let f = "qc-test-"++show tid-    bracket-        (do P.writeFile f x)-        (const $ do removeFile f)-        (const $ do y <- P.readFile f-                    return (x==y))--prop_read_write_file_C x = unsafePerformIO $ do-    tid <- myThreadId-    let f = "qc-test-"++show tid-    bracket-        (do C.writeFile f x)-        (const $ do removeFile f)-        (const $ do y <- C.readFile f-                    return (x==y))--prop_read_write_file_L x = unsafePerformIO $ do-    tid <- myThreadId-    let f = "qc-test-"++show tid-    bracket-        (do L.writeFile f x)-        (const $ do removeFile f)-        (const $ do y <- L.readFile f-                    return (x==y))--prop_read_write_file_D x = unsafePerformIO $ do-    tid <- myThreadId-    let f = "qc-test-"++show tid-    bracket-        (do D.writeFile f x)-        (const $ do removeFile f)-        (const $ do y <- D.readFile f-                    return (x==y))----------------------------------------------------------------------------prop_append_file_P x y = unsafePerformIO $ do-    tid <- myThreadId-    let f = "qc-test-"++show tid-    bracket-        (do P.writeFile f x-            P.appendFile f y)-        (const $ do removeFile f)-        (const $ do z <- P.readFile f-                    return (z==(x `P.append` y)))--prop_append_file_C x y = unsafePerformIO $ do-    tid <- myThreadId-    let f = "qc-test-"++show tid-    bracket-        (do C.writeFile f x-            C.appendFile f y)-        (const $ do removeFile f)-        (const $ do z <- C.readFile f-                    return (z==(x `C.append` y)))--prop_append_file_L x y = unsafePerformIO $ do-    tid <- myThreadId-    let f = "qc-test-"++show tid-    bracket-        (do L.writeFile f x-            L.appendFile f y)-        (const $ do removeFile f)-        (const $ do z <- L.readFile f-                    return (z==(x `L.append` y)))--prop_append_file_D x y = unsafePerformIO $ do-    tid <- myThreadId-    let f = "qc-test-"++show tid-    bracket-        (do D.writeFile f x-            D.appendFile f y)-        (const $ do removeFile f)-        (const $ do z <- D.readFile f-                    return (z==(x `D.append` y)))--prop_packAddress = C.pack "this is a test" -            ==-                   C.pack "this is a test" --prop_isSpaceWord8 (w :: Word8) = isSpace c == P.isSpaceChar8 c-   where c = chr (fromIntegral w)- ----------------------------------------------------------------------------- The entry point--main :: IO ()-main = run tests--run :: [(String, Int -> IO (Bool,Int))] -> IO ()-run tests = do-    x <- getArgs-    let n = if null x then 100 else read . head $ x-    (results, passed) <- liftM unzip $ mapM (\(s,a) -> printf "%-40s: " s >> a n) tests-    printf "Passed %d tests!\n" (sum passed)-    when (not . and $ results) $ fail "Not all tests passed!"------- And now a list of all the properties to test.-----tests = misc_tests-     ++ bl_tests-     ++ cc_tests-     ++ bp_tests-     ++ pl_tests-     ++ bb_tests-     ++ ll_tests-     ++ io_tests-     ++ rules------- 'morally sound' IO----io_tests =-    [("readFile.writeFile", mytest prop_read_write_file_P)-    ,("readFile.writeFile", mytest prop_read_write_file_C)-    ,("readFile.writeFile", mytest prop_read_write_file_L)-    ,("readFile.writeFile", mytest prop_read_write_file_D)--    ,("appendFile        ", mytest prop_append_file_P)-    ,("appendFile        ", mytest prop_append_file_C)-    ,("appendFile        ", mytest prop_append_file_L)-    ,("appendFile        ", mytest prop_append_file_D)--    ,("packAddress       ", mytest prop_packAddress)--    ]--misc_tests =-    [("invariant",              mytest prop_invariant)-    ,("unsafe pack address",    mytest prop_unsafePackAddress)-    ,("unsafe pack address len",mytest prop_unsafePackAddressLen)-    ,("unsafeUseAsCString",     mytest prop_unsafeUseAsCString)-    ,("unsafeUseAsCStringLen",  mytest prop_unsafeUseAsCStringLen)-    ,("useAsCString",           mytest prop_useAsCString)-    ,("packCString",            mytest prop_packCString)-    ,("packCString safe",       mytest prop_packCString_safe)-    ,("packCStringLen",         mytest prop_packCStringLen)-    ,("packCStringLen safe",    mytest prop_packCStringLen_safe)-    ,("packCStringFinaliser",   mytest prop_packCStringFinaliser)-    ,("packMallocString",       mytest prop_packMallocCString)-    ,("unsafeFinalise",         mytest prop_unsafeFinalize)-    ,("invariant",              mytest prop_internal_invariant)-    ,("show",                   mytest prop_show)-    ,("fromForeignPtr",         mytest prop_fromForeignPtr)-    ]----------------------------------------------------------------------------- ByteString.Lazy <=> List--bl_tests =-    [("all",         mytest prop_allBL)-    ,("any",         mytest prop_anyBL)-    ,("append",      mytest prop_appendBL)-    ,("compare",     mytest prop_compareBL)-    ,("concat",      mytest prop_concatBL)-    ,("cons",        mytest prop_consBL)-    ,("eq",          mytest prop_eqBL)-    ,("filter",      mytest prop_filterBL)-    ,("find",        mytest prop_findBL)-    ,("findIndex",   mytest prop_findIndexBL)-    ,("findIndices", mytest prop_findIndicesBL)-    ,("foldl",       mytest prop_foldlBL)-    ,("foldl'",      mytest prop_foldlBL')-    ,("foldl1",      mytest prop_foldl1BL)-    ,("foldl1'",     mytest prop_foldl1BL')-    ,("foldr",       mytest prop_foldrBL)-    ,("foldr1",      mytest prop_foldr1BL)-    ,("mapAccumL",   mytest prop_mapAccumLBL)-    ,("mapAccumR",   mytest prop_mapAccumRBL)-    ,("mapAccumR",   mytest prop_mapAccumRDL)-    ,("mapAccumR",   mytest prop_mapAccumRCC)-    ,("unfoldr",     mytest prop_unfoldrBL)-    ,("unfoldr",     mytest prop_unfoldrLC)-    ,("unfoldr",     mytest prop_cycleLC)-    ,("iterate",     mytest prop_iterateLC)-    ,("iterate",     mytest prop_iterateLC_2)-    ,("iterate",     mytest prop_iterateL)-    ,("repeat",      mytest prop_repeatLC)-    ,("repeat",      mytest prop_repeatL)-    ,("head",        mytest prop_headBL)-    ,("init",        mytest prop_initBL)-    ,("isPrefixOf",  mytest prop_isPrefixOfBL)-    ,("last",        mytest prop_lastBL)-    ,("length",      mytest prop_lengthBL)-    ,("map",         mytest prop_mapBL)-    ,("maximum",     mytest prop_maximumBL)-    ,("minimum",     mytest prop_minimumBL)-    ,("null",        mytest prop_nullBL)-    ,("reverse",     mytest prop_reverseBL)-    ,("snoc",        mytest prop_snocBL)-    ,("tail",        mytest prop_tailBL)-    ,("transpose",   mytest prop_transposeBL)-    ,("replicate",   mytest prop_replicateBL)-    ,("take",        mytest prop_takeBL)-    ,("drop",        mytest prop_dropBL)-    ,("splitAt",     mytest prop_splitAtBL)-    ,("takeWhile",   mytest prop_takeWhileBL)-    ,("dropWhile",   mytest prop_dropWhileBL)-    ,("break",       mytest prop_breakBL)-    ,("span",        mytest prop_spanBL)-    ,("group",       mytest prop_groupBL)-    ,("inits",       mytest prop_initsBL)-    ,("tails",       mytest prop_tailsBL)-    ,("elem",        mytest prop_elemBL)-    ,("notElem",     mytest prop_notElemBL)-    ,("lines",       mytest prop_linesBL)-    ,("elemIndex",   mytest prop_elemIndexBL)-    ,("elemIndices", mytest prop_elemIndicesBL)-    ,("concatMap",   mytest prop_concatMapBL)-    ]----------------------------------------------------------------------------- ByteString.Lazy <=> ByteString--cc_tests =-    [("prop_concatCC", mytest prop_concatCC)-    ,("prop_nullCC", mytest prop_nullCC)-    ,("prop_reverseCC", mytest prop_reverseCC)-    ,("prop_transposeCC", mytest prop_transposeCC)-    ,("prop_groupCC", mytest prop_groupCC)-    ,("prop_initsCC", mytest prop_initsCC)-    ,("prop_tailsCC", mytest prop_tailsCC)-    ,("prop_allCC", mytest prop_allCC)-    ,("prop_anyCC", mytest prop_anyCC)-    ,("prop_appendCC", mytest prop_appendCC)-    ,("prop_breakCC", mytest prop_breakCC)-    ,("prop_concatMapCC", mytest prop_concatMapCC)-    ,("prop_consCC", mytest prop_consCC)-    ,("prop_unconsCC", mytest prop_unconsCC)-    ,("prop_countCC", mytest prop_countCC)-    ,("prop_dropCC", mytest prop_dropCC)-    ,("prop_dropWhileCC", mytest prop_dropWhileCC)-    ,("prop_filterCC", mytest prop_filterCC)-    ,("prop_findCC", mytest prop_findCC)-    ,("prop_findIndexCC", mytest prop_findIndexCC)-    ,("prop_findIndicesCC", mytest prop_findIndicesCC)-    ,("prop_isPrefixOfCC", mytest prop_isPrefixOfCC)-    ,("prop_mapCC", mytest prop_mapCC)-    ,("prop_replicateCC", mytest prop_replicateCC)-    ,("prop_snocCC", mytest prop_snocCC)-    ,("prop_spanCC", mytest prop_spanCC)-    ,("prop_splitCC", mytest prop_splitCC)-    ,("prop_splitAtCC", mytest prop_splitAtCC)-    ,("prop_takeCC", mytest prop_takeCC)-    ,("prop_takeWhileCC", mytest prop_takeWhileCC)-    ,("prop_elemCC", mytest prop_elemCC)-    ,("prop_notElemCC", mytest prop_notElemCC)-    ,("prop_elemIndexCC", mytest prop_elemIndexCC)-    ,("prop_elemIndicesCC", mytest prop_elemIndicesCC)-    ,("prop_lengthCC", mytest prop_lengthCC)-    ,("prop_headCC", mytest prop_headCC)-    ,("prop_initCC", mytest prop_initCC)-    ,("prop_lastCC", mytest prop_lastCC)-    ,("prop_maximumCC", mytest prop_maximumCC)-    ,("prop_minimumCC", mytest prop_minimumCC)-    ,("prop_tailCC", mytest prop_tailCC)-    ,("prop_foldl1CC", mytest prop_foldl1CC)-    ,("prop_foldl1CC'", mytest prop_foldl1CC')-    ,("prop_foldr1CC", mytest prop_foldr1CC)-    ,("prop_foldr1CC'", mytest prop_foldr1CC')-    ,("prop_scanlCC", mytest prop_scanlCC)-    ,("prop_intersperseCC", mytest prop_intersperseCC)--    ,("prop_foldlCC", mytest prop_foldlCC)-    ,("prop_foldlCC'", mytest prop_foldlCC')-    ,("prop_foldrCC", mytest prop_foldrCC)-    ,("prop_foldrCC'", mytest prop_foldrCC')-    ,("prop_mapAccumLCC", mytest prop_mapAccumLCC)---    ,("prop_mapIndexedCC", mytest prop_mapIndexedCC)---    ,("prop_mapIndexedPL", mytest prop_mapIndexedPL)--    ]--bp_tests =-    [("all",         mytest prop_allBP)-    ,("any",         mytest prop_anyBP)-    ,("append",      mytest prop_appendBP)-    ,("compare",     mytest prop_compareBP)-    ,("concat",      mytest prop_concatBP)-    ,("cons",        mytest prop_consBP)-    ,("cons'",       mytest prop_consBP')-    ,("cons'",       mytest prop_consLP')-    ,("uncons",      mytest prop_unconsBP)-    ,("eq",          mytest prop_eqBP)-    ,("filter",      mytest prop_filterBP)-    ,("find",        mytest prop_findBP)-    ,("findIndex",   mytest prop_findIndexBP)-    ,("findIndices", mytest prop_findIndicesBP)-    ,("foldl",       mytest prop_foldlBP)-    ,("foldl'",      mytest prop_foldlBP')-    ,("foldl1",      mytest prop_foldl1BP)-    ,("foldl1'",     mytest prop_foldl1BP')-    ,("foldr",       mytest prop_foldrBP)-    ,("foldr'",       mytest prop_foldrBP')-    ,("foldr1",      mytest prop_foldr1BP)-    ,("foldr1'",      mytest prop_foldr1BP')-    ,("mapAccumL",   mytest prop_mapAccumLBP)---  ,("mapAccumL",   mytest prop_mapAccumL_mapIndexedBP)-    ,("unfoldr",     mytest prop_unfoldrBP)-    ,("unfoldr 2",   mytest prop_unfoldr2BP)-    ,("unfoldr 2",   mytest prop_unfoldr2CP)-    ,("head",        mytest prop_headBP)-    ,("init",        mytest prop_initBP)-    ,("isPrefixOf",  mytest prop_isPrefixOfBP)-    ,("last",        mytest prop_lastBP)-    ,("length",      mytest prop_lengthBP)-    ,("readInt",     mytest prop_readIntBP)-    ,("lines",       mytest prop_linesBP)-    ,("lines \\n",   mytest prop_linesNLBP)-    ,("map",         mytest prop_mapBP)-    ,("maximum   ",  mytest prop_maximumBP)-    ,("minimum"   ,  mytest prop_minimumBP)-    ,("null",        mytest prop_nullBP)-    ,("reverse",     mytest prop_reverseBP)-    ,("snoc",        mytest prop_snocBP)-    ,("tail",        mytest prop_tailBP)-    ,("scanl",       mytest prop_scanlBP)-    ,("transpose",   mytest prop_transposeBP)-    ,("replicate",   mytest prop_replicateBP)-    ,("take",        mytest prop_takeBP)-    ,("drop",        mytest prop_dropBP)-    ,("splitAt",     mytest prop_splitAtBP)-    ,("takeWhile",   mytest prop_takeWhileBP)-    ,("dropWhile",   mytest prop_dropWhileBP)-    ,("break",       mytest prop_breakBP)-    ,("span",        mytest prop_spanBP)-    ,("split",       mytest prop_splitBP)-    ,("count",       mytest prop_countBP)-    ,("group",       mytest prop_groupBP)-    ,("inits",       mytest prop_initsBP)-    ,("tails",       mytest prop_tailsBP)-    ,("elem",        mytest prop_elemBP)-    ,("notElem",     mytest prop_notElemBP)-    ,("elemIndex",   mytest prop_elemIndexBP)-    ,("elemIndices", mytest prop_elemIndicesBP)-    ,("intersperse", mytest prop_intersperseBP)-    ,("concatMap",   mytest prop_concatMapBP)-    ]----------------------------------------------------------------------------- ByteString <=> List--pl_tests =-    [("all",         mytest prop_allPL)-    ,("any",         mytest prop_anyPL)-    ,("append",      mytest prop_appendPL)-    ,("compare",     mytest prop_comparePL)-    ,("concat",      mytest prop_concatPL)-    ,("cons",        mytest prop_consPL)-    ,("eq",          mytest prop_eqPL)-    ,("filter",      mytest prop_filterPL)-    ,("filter rules",mytest prop_filterPL_rule)-    ,("filter rules",mytest prop_filterLC_rule)-    ,("partition",   mytest prop_partitionPL)-    ,("partition",   mytest prop_partitionLL)-    ,("find",        mytest prop_findPL)-    ,("findIndex",   mytest prop_findIndexPL)-    ,("findIndices", mytest prop_findIndicesPL)-    ,("foldl",       mytest prop_foldlPL)-    ,("foldl'",      mytest prop_foldlPL')-    ,("foldl1",      mytest prop_foldl1PL)-    ,("foldl1'",     mytest prop_foldl1PL')-    ,("foldr1",      mytest prop_foldr1PL)-    ,("foldr",       mytest prop_foldrPL)-    ,("mapAccumL",   mytest prop_mapAccumLPL)-    ,("mapAccumR",   mytest prop_mapAccumRPL)-    ,("unfoldr",     mytest prop_unfoldrPL)-    ,("scanl",       mytest prop_scanlPL)-    ,("scanl1",      mytest prop_scanl1PL)-    ,("scanl1",      mytest prop_scanl1CL)-    ,("scanr",      mytest prop_scanrCL)-    ,("scanr",       mytest prop_scanrPL)-    ,("scanr1",      mytest prop_scanr1PL)-    ,("scanr1",      mytest prop_scanr1CL)-    ,("head",        mytest prop_headPL)-    ,("init",        mytest prop_initPL)-    ,("last",        mytest prop_lastPL)-    ,("maximum",     mytest prop_maximumPL)-    ,("minimum",     mytest prop_minimumPL)-    ,("tail",        mytest prop_tailPL)-    ,("zip",         mytest prop_zipPL)-    ,("zip",         mytest prop_zipLL)-    ,("zip",         mytest prop_zipCL)-    ,("unzip",       mytest prop_unzipPL)-    ,("unzip",       mytest prop_unzipLL)-    ,("unzip",       mytest prop_unzipCL)-    ,("zipWith",          mytest prop_zipWithPL)---  ,("zipWith",          mytest prop_zipWithCL)-    ,("zipWith rules",   mytest prop_zipWithPL_rules)---     ,("zipWith/zipWith'", mytest prop_zipWithPL')--    ,("isPrefixOf",  mytest prop_isPrefixOfPL)-    ,("isInfixOf",   mytest prop_isInfixOfPL)-    ,("length",      mytest prop_lengthPL)-    ,("map",         mytest prop_mapPL)-    ,("null",        mytest prop_nullPL)-    ,("reverse",     mytest prop_reversePL)-    ,("snoc",        mytest prop_snocPL)-    ,("transpose",   mytest prop_transposePL)-    ,("replicate",   mytest prop_replicatePL)-    ,("take",        mytest prop_takePL)-    ,("drop",        mytest prop_dropPL)-    ,("splitAt",     mytest prop_splitAtPL)-    ,("takeWhile",   mytest prop_takeWhilePL)-    ,("dropWhile",   mytest prop_dropWhilePL)-    ,("break",       mytest prop_breakPL)-    ,("span",        mytest prop_spanPL)-    ,("group",       mytest prop_groupPL)-    ,("inits",       mytest prop_initsPL)-    ,("tails",       mytest prop_tailsPL)-    ,("elem",        mytest prop_elemPL)-    ,("notElem",     mytest prop_notElemPL)-    ,("lines",       mytest prop_linesPL)-    ,("elemIndex",   mytest prop_elemIndexPL)-    ,("elemIndex",   mytest prop_elemIndexCL)-    ,("elemIndices", mytest prop_elemIndicesPL)-    ,("concatMap",   mytest prop_concatMapPL)-    ,("IsString",    mytest prop_isstring)-    ,("IsString LC",    mytest prop_isstring_lc)-    ]----------------------------------------------------------------------------- extra ByteString properties--bb_tests =-    [    ("bijection",      mytest prop_bijectionBB)-    ,    ("bijection'",     mytest prop_bijectionBB')-    ,    ("pack/unpack",    mytest prop_packunpackBB)-    ,    ("unpack/pack",    mytest prop_packunpackBB')-    ,    ("eq 1",           mytest prop_eq1BB)-    ,    ("eq 2",           mytest prop_eq2BB)-    ,    ("eq 3",           mytest prop_eq3BB)-    ,    ("compare 1",      mytest prop_compare1BB)-    ,    ("compare 2",      mytest prop_compare2BB)-    ,    ("compare 3",      mytest prop_compare3BB)-    ,    ("compare 4",      mytest prop_compare4BB)-    ,    ("compare 5",      mytest prop_compare5BB)-    ,    ("compare 6",      mytest prop_compare6BB)-    ,    ("compare 7",      mytest prop_compare7BB)-    ,    ("compare 7",      mytest prop_compare7LL)-    ,    ("compare 8",      mytest prop_compare8BB)-    ,    ("empty 1",        mytest prop_nil1BB)-    ,    ("empty 2",        mytest prop_nil2BB)-    ,    ("empty 1 monoid", mytest prop_nil1LL_monoid)-    ,    ("empty 2 monoid", mytest prop_nil2LL_monoid)-    ,    ("empty 1 monoid", mytest prop_nil1BB_monoid)-    ,    ("empty 2 monoid", mytest prop_nil2BB_monoid)--    ,    ("null",           mytest prop_nullBB)-    ,    ("length 1",       mytest prop_lengthBB)-    ,    ("length 2",       mytest prop_lengthSBB)-    ,    ("cons 1",         mytest prop_consBB)-    ,    ("cons 2",         mytest prop_cons1BB)-    ,    ("cons 3",         mytest prop_cons2BB)-    ,    ("cons 4",         mytest prop_cons3BB)-    ,    ("cons 5",         mytest prop_cons4BB)-    ,    ("snoc",           mytest prop_snoc1BB)-    ,    ("head 1",         mytest prop_head1BB)-    ,    ("head 2",         mytest prop_head2BB)-    ,    ("head 3",         mytest prop_head3BB)-    ,    ("tail",           mytest prop_tailBB)-    ,    ("tail 1",         mytest prop_tail1BB)-    ,    ("last",           mytest prop_lastBB)-    ,    ("init",           mytest prop_initBB)-    ,    ("append 1",       mytest prop_append1BB)-    ,    ("append 2",       mytest prop_append2BB)-    ,    ("append 3",       mytest prop_append3BB)-    ,    ("mappend 1",       mytest prop_append1BB_monoid)-    ,    ("mappend 2",       mytest prop_append2BB_monoid)-    ,    ("mappend 3",       mytest prop_append3BB_monoid)--    ,    ("map 1",          mytest prop_map1BB)-    ,    ("map 2",          mytest prop_map2BB)-    ,    ("map 3",          mytest prop_map3BB)-    ,    ("filter1",        mytest prop_filter1BB)-    ,    ("filter2",        mytest prop_filter2BB)---  ,    ("map fusion",     mytest prop_mapfusionBB)---  ,    ("filter fusion",  mytest prop_filterfusionBB)-    ,    ("reverse 1",      mytest prop_reverse1BB)-    ,    ("reverse 2",      mytest prop_reverse2BB)-    ,    ("reverse 3",      mytest prop_reverse3BB)-    ,    ("foldl 1",        mytest prop_foldl1BB)-    ,    ("foldl 2",        mytest prop_foldl2BB)-    ,    ("foldr 1",        mytest prop_foldr1BB)-    ,    ("foldr 2",        mytest prop_foldr2BB)-    ,    ("foldl1 1",       mytest prop_foldl1_1BB)-    ,    ("foldl1 2",       mytest prop_foldl1_2BB)-    ,    ("foldl1 3",       mytest prop_foldl1_3BB)-    ,    ("foldr1 1",       mytest prop_foldr1_1BB)-    ,    ("foldr1 2",       mytest prop_foldr1_2BB)-    ,    ("foldr1 3",       mytest prop_foldr1_3BB)-    ,    ("scanl/foldl",    mytest prop_scanlfoldlBB)-    ,    ("all",            mytest prop_allBB)-    ,    ("any",            mytest prop_anyBB)-    ,    ("take",           mytest prop_takeBB)-    ,    ("drop",           mytest prop_dropBB)-    ,    ("takeWhile",      mytest prop_takeWhileBB)-    ,    ("dropWhile",      mytest prop_dropWhileBB)-    ,    ("dropWhile",      mytest prop_dropWhileCC_isSpace)-    ,    ("splitAt",        mytest prop_splitAtBB)-    ,    ("span",           mytest prop_spanBB)-    ,    ("break",          mytest prop_breakBB)-    ,    ("elem",           mytest prop_elemBB)-    ,    ("notElem",        mytest prop_notElemBB)--    ,    ("concat 1",       mytest prop_concat1BB)-    ,    ("concat 2",       mytest prop_concat2BB)-    ,    ("concat 3",       mytest prop_concatBB)-    ,    ("mconcat 1",       mytest prop_concat1BB_monoid)-    ,    ("mconcat 2",       mytest prop_concat2BB_monoid)-    ,    ("mconcat 3",       mytest prop_concatBB_monoid)--    ,    ("mconcat 1",       mytest prop_concat1LL_monoid)-    ,    ("mconcat 2",       mytest prop_concat2LL_monoid)-    ,    ("mconcat 3",       mytest prop_concatLL_monoid)--    ,    ("lines",          mytest prop_linesBB)-    ,    ("unlines",        mytest prop_unlinesBB)-    ,    ("unlines",        mytest prop_unlinesLC)-    ,    ("words",          mytest prop_wordsBB)-    ,    ("words",          mytest prop_wordsLC)-    ,    ("unwords",        mytest prop_unwordsBB)-    ,    ("group",          mytest prop_groupBB)-    ,    ("groupBy",        mytest prop_groupByBB)-    ,    ("groupBy",        mytest prop_groupByCC)-    ,    ("groupBy 1",      mytest prop_groupBy1BB)-    ,    ("groupBy 1",      mytest prop_groupBy1CC)-    ,    ("join",           mytest prop_joinBB)-    ,    ("elemIndex 1",    mytest prop_elemIndex1BB)-    ,    ("elemIndex 2",    mytest prop_elemIndex2BB)-    ,    ("findIndex",      mytest prop_findIndexBB)-    ,    ("findIndicies",   mytest prop_findIndiciesBB)-    ,    ("elemIndices",    mytest prop_elemIndicesBB)-    ,    ("find",           mytest prop_findBB)-    ,    ("find/findIndex", mytest prop_find_findIndexBB)-    ,    ("sort 1",         mytest prop_sort1BB)-    ,    ("sort 2",         mytest prop_sort2BB)-    ,    ("sort 3",         mytest prop_sort3BB)-    ,    ("sort 4",         mytest prop_sort4BB)-    ,    ("sort 5",         mytest prop_sort5BB)-    ,    ("intersperse",    mytest prop_intersperseBB)-    ,    ("maximum",        mytest prop_maximumBB)-    ,    ("minimum",        mytest prop_minimumBB)---  ,    ("breakChar",      mytest prop_breakCharBB)---  ,    ("spanChar 1",     mytest prop_spanCharBB)---  ,    ("spanChar 2",     mytest prop_spanChar_1BB)---  ,    ("breakSpace",     mytest prop_breakSpaceBB)---  ,    ("dropSpace",      mytest prop_dropSpaceBB)-    ,    ("spanEnd",        mytest prop_spanEndBB)-    ,    ("breakEnd",       mytest prop_breakEndBB)-    ,    ("breakEnd",       mytest prop_breakEndCC)-    ,    ("elemIndexEnd 1",mytest prop_elemIndexEnd1BB)-    ,    ("elemIndexEnd 1",mytest prop_elemIndexEnd1CC)-    ,    ("elemIndexEnd 2",mytest prop_elemIndexEnd2BB)---  ,    ("words'",         mytest prop_wordsBB')---     ,    ("lines'",         mytest prop_linesBB')---  ,    ("dropSpaceEnd",   mytest prop_dropSpaceEndBB)-    ,    ("unfoldr",        mytest prop_unfoldrBB)-    ,    ("prefix",         mytest prop_prefixBB)-    ,    ("suffix",         mytest prop_suffixBB)-    ,    ("suffix",         mytest prop_suffixLL)-    ,    ("copy",           mytest prop_copyBB)-    ,    ("copy",           mytest prop_copyLL)-    ,    ("inits",          mytest prop_initsBB)-    ,    ("tails",          mytest prop_tailsBB)-    ,    ("findSubstrings ",mytest prop_findSubstringsBB)-    ,    ("findSubstring ",mytest prop_findSubstringBB)-    ,    ("breakSubstring 1",mytest prop_breakSubstringBB)-    ,    ("breakSubstring 2",mytest prop_breakSubstring_findSubstring)-    ,    ("breakSubstring 3",mytest prop_breakSubstring_isInfixOf)--    ,    ("replicate1",     mytest prop_replicate1BB)-    ,    ("replicate2",     mytest prop_replicate2BB)-    ,    ("replicate3",     mytest prop_replicate3BB)-    ,    ("readInt",        mytest prop_readintBB)-    ,    ("readInt 2",      mytest prop_readint2BB)-    ,    ("readInteger",    mytest prop_readintegerBB)-    ,    ("readInteger 2",  mytest prop_readinteger2BB)-    ,    ("read",  mytest prop_readLL)-    ,    ("read",  mytest prop_readBB)-    ,    ("Lazy.readInt",   mytest prop_readintLL)-    ,    ("Lazy.readInt",   mytest prop_readintLL)-    ,    ("Lazy.readInteger", mytest prop_readintegerLL)-    ,    ("mconcat 1",       mytest prop_append1LL_monoid)-    ,    ("mconcat 2",       mytest prop_append2LL_monoid)-    ,    ("mconcat 3",       mytest prop_append3LL_monoid)---  ,    ("filterChar1",    mytest prop_filterChar1BB)---  ,    ("filterChar2",    mytest prop_filterChar2BB)---  ,    ("filterChar3",    mytest prop_filterChar3BB)---  ,    ("filterNotChar1", mytest prop_filterNotChar1BB)---  ,    ("filterNotChar2", mytest prop_filterNotChar2BB)-    ,    ("tail",           mytest prop_tailSBB)-    ,    ("index",          mytest prop_indexBB)-    ,    ("unsafeIndex",    mytest prop_unsafeIndexBB)---  ,    ("map'",           mytest prop_mapBB')-    ,    ("filter",         mytest prop_filterBB)-    ,    ("elem",           mytest prop_elemSBB)-    ,    ("take",           mytest prop_takeSBB)-    ,    ("drop",           mytest prop_dropSBB)-    ,    ("splitAt",        mytest prop_splitAtSBB)-    ,    ("foldl",          mytest prop_foldlBB)-    ,    ("foldr",          mytest prop_foldrBB)-    ,    ("takeWhile ",     mytest prop_takeWhileSBB)-    ,    ("dropWhile ",     mytest prop_dropWhileSBB)-    ,    ("span ",          mytest prop_spanSBB)-    ,    ("break ",         mytest prop_breakSBB)-    ,    ("breakspan",      mytest prop_breakspan_1BB)-    ,    ("lines ",         mytest prop_linesSBB)-    ,    ("unlines ",       mytest prop_unlinesSBB)-    ,    ("words ",         mytest prop_wordsSBB)-    ,    ("unwords ",       mytest prop_unwordsSBB)-    ,    ("unwords ",       mytest prop_unwordsSLC)---     ,    ("wordstokens",    mytest prop_wordstokensBB)-    ,    ("splitWith",      mytest prop_splitWithBB)-    ,    ("joinsplit",      mytest prop_joinsplitBB)-    ,    ("intercalate",    mytest prop_intercalatePL)---     ,    ("lineIndices",    mytest prop_lineIndices1BB)-    ,    ("count",          mytest prop_countBB)---  ,    ("linessplit",     mytest prop_linessplit2BB)-    ,    ("splitsplitWith", mytest prop_splitsplitWithBB)---  ,    ("joinjoinpath",   mytest prop_joinjoinpathBB)-    ,    ("zip",            mytest prop_zipBB)-    ,    ("zip",            mytest prop_zipLC)-    ,    ("zip1",           mytest prop_zip1BB)-    ,    ("zipWith",        mytest prop_zipWithBB)-    ,    ("zipWith",        mytest prop_zipWithCC)-    ,    ("zipWith",        mytest prop_zipWithLC)---     ,    ("zipWith'",       mytest prop_zipWith'BB)-    ,    ("unzip",          mytest prop_unzipBB)-    ,    ("concatMap",      mytest prop_concatMapBB)---  ,    ("join/joinByte",  mytest prop_join_spec)---  ,    ("span/spanByte",  mytest prop_span_spec)---  ,    ("break/breakByte",mytest prop_break_spec)-    ]----------------------------------------------------------------------------- Fusion rules--{--fusion_tests =--- v1 fusion-    [    ("lazy loop/loop fusion", mytest prop_lazylooploop)-    ,    ("loop/loop fusion",      mytest prop_looploop)---- v2 fusion-    ,("loop/loop wrapper elim",       mytest prop_loop_loop_wrapper_elimination)-    ,("sequence association",         mytest prop_sequenceloops_assoc)--    ,("up/up         loop fusion",    mytest prop_up_up_loop_fusion)-    ,("down/down     loop fusion",    mytest prop_down_down_loop_fusion)-    ,("noAcc/noAcc   loop fusion",    mytest prop_noAcc_noAcc_loop_fusion)-    ,("noAcc/up      loop fusion",    mytest prop_noAcc_up_loop_fusion)-    ,("up/noAcc      loop fusion",    mytest prop_up_noAcc_loop_fusion)-    ,("noAcc/down    loop fusion",    mytest prop_noAcc_down_loop_fusion)-    ,("down/noAcc    loop fusion",    mytest prop_down_noAcc_loop_fusion)-    ,("map/map       loop fusion",    mytest prop_map_map_loop_fusion)-    ,("filter/filter loop fusion",    mytest prop_filter_filter_loop_fusion)-    ,("map/filter    loop fusion",    mytest prop_map_filter_loop_fusion)-    ,("filter/map    loop fusion",    mytest prop_filter_map_loop_fusion)-    ,("map/noAcc     loop fusion",    mytest prop_map_noAcc_loop_fusion)-    ,("noAcc/map     loop fusion",    mytest prop_noAcc_map_loop_fusion)-    ,("map/up        loop fusion",    mytest prop_map_up_loop_fusion)-    ,("up/map        loop fusion",    mytest prop_up_map_loop_fusion)-    ,("map/down      loop fusion",    mytest prop_map_down_fusion)-    ,("down/map      loop fusion",    mytest prop_down_map_loop_fusion)-    ,("filter/noAcc  loop fusion",    mytest prop_filter_noAcc_loop_fusion)-    ,("noAcc/filter  loop fusion",    mytest prop_noAcc_filter_loop_fusion)-    ,("filter/up     loop fusion",    mytest prop_filter_up_loop_fusion)-    ,("up/filter     loop fusion",    mytest prop_up_filter_loop_fusion)-    ,("filter/down   loop fusion",    mytest prop_filter_down_fusion)-    ,("down/filter   loop fusion",    mytest prop_down_filter_loop_fusion)--{--    ,("length/loop   fusion",          mytest prop_length_loop_fusion_1)-    ,("length/loop   fusion",          mytest prop_length_loop_fusion_2)-    ,("length/loop   fusion",          mytest prop_length_loop_fusion_3)-    ,("length/loop   fusion",          mytest prop_length_loop_fusion_4)--}----  ,("zipwith/spec",                  mytest prop_zipwith_spec)-    ]---}------------------------------------------------------------------------------ Extra lazy properties--ll_tests =-    [("eq 1",               mytest prop_eq1)-    ,("eq 2",               mytest prop_eq2)-    ,("eq 3",               mytest prop_eq3)-    ,("eq refl",            mytest prop_eq_refl)-    ,("eq symm",            mytest prop_eq_symm)-    ,("compare 1",          mytest prop_compare1)-    ,("compare 2",          mytest prop_compare2)-    ,("compare 3",          mytest prop_compare3)-    ,("compare 4",          mytest prop_compare4)-    ,("compare 5",          mytest prop_compare5)-    ,("compare 6",          mytest prop_compare6)-    ,("compare 7",          mytest prop_compare7)-    ,("compare 8",          mytest prop_compare8)-    ,("empty 1",            mytest prop_empty1)-    ,("empty 2",            mytest prop_empty2)-    ,("pack/unpack",        mytest prop_packunpack)-    ,("unpack/pack",        mytest prop_unpackpack)-    ,("null",               mytest prop_null)-    ,("length 1",           mytest prop_length1)-    ,("length 2",           mytest prop_length2)-    ,("cons 1"    ,         mytest prop_cons1)-    ,("cons 2"    ,         mytest prop_cons2)-    ,("cons 3"    ,         mytest prop_cons3)-    ,("cons 4"    ,         mytest prop_cons4)-    ,("snoc"    ,           mytest prop_snoc1)-    ,("head/pack",          mytest prop_head)-    ,("head/unpack",        mytest prop_head1)-    ,("tail/pack",          mytest prop_tail)-    ,("tail/unpack",        mytest prop_tail1)-    ,("last",               mytest prop_last)-    ,("init",               mytest prop_init)-    ,("append 1",           mytest prop_append1)-    ,("append 2",           mytest prop_append2)-    ,("append 3",           mytest prop_append3)-    ,("map 1",              mytest prop_map1)-    ,("map 2",              mytest prop_map2)-    ,("map 3",              mytest prop_map3)-    ,("filter 1",           mytest prop_filter1)-    ,("filter 2",           mytest prop_filter2)-    ,("reverse",            mytest prop_reverse)-    ,("reverse1",           mytest prop_reverse1)-    ,("reverse2",           mytest prop_reverse2)-    ,("transpose",          mytest prop_transpose)-    ,("foldl",              mytest prop_foldl)-    ,("foldl/reverse",      mytest prop_foldl_1)-    ,("foldr",              mytest prop_foldr)-    ,("foldr/id",           mytest prop_foldr_1)-    ,("foldl1/foldl",       mytest prop_foldl1_1)-    ,("foldl1/head",        mytest prop_foldl1_2)-    ,("foldl1/tail",        mytest prop_foldl1_3)-    ,("foldr1/foldr",       mytest prop_foldr1_1)-    ,("foldr1/last",        mytest prop_foldr1_2)-    ,("foldr1/head",        mytest prop_foldr1_3)-    ,("concat 1",           mytest prop_concat1)-    ,("concat 2",           mytest prop_concat2)-    ,("concat/pack",        mytest prop_concat3)-    ,("any",                mytest prop_any)-    ,("all",                mytest prop_all)-    ,("maximum",            mytest prop_maximum)-    ,("minimum",            mytest prop_minimum)-    ,("replicate 1",        mytest prop_replicate1)-    ,("replicate 2",        mytest prop_replicate2)-    ,("take",               mytest prop_take1)-    ,("drop",               mytest prop_drop1)-    ,("splitAt",            mytest prop_drop1)-    ,("takeWhile",          mytest prop_takeWhile)-    ,("dropWhile",          mytest prop_dropWhile)-    ,("break",              mytest prop_break)-    ,("span",               mytest prop_span)-    ,("splitAt",               mytest prop_splitAt)-    ,("break/span",         mytest prop_breakspan)---     ,("break/breakByte",    mytest prop_breakByte)---     ,("span/spanByte",      mytest prop_spanByte)-    ,("split",              mytest prop_split)-    ,("splitWith",          mytest prop_splitWith)-    ,("splitWith",          mytest prop_splitWith_D)-    ,("splitWith",          mytest prop_splitWith_C)-    ,("join.split/id",      mytest prop_joinsplit)---  ,("join/joinByte",      mytest prop_joinjoinByte)-    ,("group",              mytest prop_group)-    ,("groupBy",            mytest prop_groupBy)-    ,("groupBy",            mytest prop_groupBy_LC)-    ,("index",              mytest prop_index)-    ,("index",              mytest prop_index_D)-    ,("index",              mytest prop_index_C)-    ,("elemIndex",          mytest prop_elemIndex)-    ,("elemIndices",        mytest prop_elemIndices)-    ,("count/elemIndices",  mytest prop_count)-    ,("findIndex",          mytest prop_findIndex)-    ,("findIndices",        mytest prop_findIndicies)-    ,("find",               mytest prop_find)-    ,("find/findIndex",     mytest prop_find_findIndex)-    ,("elem",               mytest prop_elem)-    ,("notElem",            mytest prop_notElem)-    ,("elem/notElem",       mytest prop_elem_notelem)---  ,("filterByte 1",       mytest prop_filterByte)---  ,("filterByte 2",       mytest prop_filterByte2)---  ,("filterNotByte 1",    mytest prop_filterNotByte)---  ,("filterNotByte 2",    mytest prop_filterNotByte2)-    ,("isPrefixOf",         mytest prop_isPrefixOf)-    ,("concatMap",          mytest prop_concatMap)-    ,("isSpace",            mytest prop_isSpaceWord8)+{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}+--+-- Must have rules off, otherwise the fusion rules will replace the rhs+-- with the lhs, and we only end up testing lhs == lhs+--++--+-- -fhpc interferes with rewrite rules firing.+--++import Foreign.Storable+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import GHC.Ptr+import Test.QuickCheck+import Control.Monad+import Control.Concurrent+import Control.Exception+import System.Directory++import Data.List+import Data.Char+import Data.Word+import Data.Maybe+import Data.Int (Int64)+import Data.Monoid++import Text.Printf+import Data.String++import System.Environment+import System.IO+import System.IO.Unsafe++import Data.ByteString.Lazy (ByteString(..), pack , unpack)+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Lazy.Internal (ByteString(..))++import qualified Data.ByteString            as P+import qualified Data.ByteString.Internal   as P+import qualified Data.ByteString.Unsafe     as P+import qualified Data.ByteString.Char8      as C++import qualified Data.ByteString.Lazy.Char8 as LC+import qualified Data.ByteString.Lazy.Char8 as D++import qualified Data.ByteString.Lazy.Internal as L+import Prelude hiding (abs)++import Rules+import QuickCheckUtils+import TestFramework++toInt64 :: Int -> Int64+toInt64 = fromIntegral++--+-- ByteString.Lazy.Char8 <=> ByteString.Char8+--++prop_concatCC       = D.concat                `eq1`  C.concat+prop_nullCC         = D.null                  `eq1`  C.null+prop_reverseCC      = D.reverse               `eq1`  C.reverse+prop_transposeCC    = D.transpose             `eq1`  C.transpose+prop_groupCC        = D.group                 `eq1`  C.group+prop_groupByCC      = D.groupBy               `eq2`  C.groupBy+prop_initsCC        = D.inits                 `eq1`  C.inits+prop_tailsCC        = D.tails                 `eq1`  C.tails+prop_allCC          = D.all                   `eq2`  C.all+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) $+                      D.concatMap             `eq2`  C.concatMap+prop_consCC         = D.cons                  `eq2`  C.cons+prop_consCC'        = D.cons'                 `eq2`  C.cons+prop_unconsCC       = D.uncons                `eq1`  C.uncons+prop_countCC        = D.count                 `eq2`  ((toInt64 .) . C.count)+prop_dropCC         = (D.drop . toInt64)      `eq2`  C.drop+prop_dropWhileCC    = D.dropWhile             `eq2`  C.dropWhile+prop_filterCC       = D.filter                `eq2`  C.filter+prop_findCC         = D.find                  `eq2`  C.find+prop_findIndexCC    = D.findIndex             `eq2`  ((fmap toInt64 .) . C.findIndex)+prop_findIndicesCC  = D.findIndices           `eq2`  ((fmap toInt64 .) . C.findIndices)+prop_isPrefixOfCC   = D.isPrefixOf            `eq2`  C.isPrefixOf+prop_mapCC          = D.map                   `eq2`  C.map+prop_replicateCC    = forAll arbitrarySizedIntegral $+                      (D.replicate . toInt64) `eq2`  C.replicate+prop_snocCC         = D.snoc                  `eq2`  C.snoc+prop_spanCC         = D.span                  `eq2`  C.span+prop_splitCC        = D.split                 `eq2`  C.split+prop_splitAtCC      = (D.splitAt . toInt64)   `eq2`  C.splitAt+prop_takeCC         = (D.take    . toInt64)   `eq2`  C.take+prop_takeWhileCC    = D.takeWhile             `eq2`  C.takeWhile+prop_elemCC         = D.elem                  `eq2`  C.elem+prop_notElemCC      = D.notElem               `eq2`  C.notElem+prop_elemIndexCC    = D.elemIndex             `eq2`  ((fmap toInt64 .) . C.elemIndex)+prop_elemIndicesCC  = D.elemIndices           `eq2`  ((fmap toInt64 .) . C.elemIndices)+prop_lengthCC       = D.length                `eq1`  (toInt64 . C.length)++prop_headCC         = D.head        `eqnotnull1` C.head+prop_initCC         = D.init        `eqnotnull1` C.init+prop_lastCC         = D.last        `eqnotnull1` C.last+prop_maximumCC      = D.maximum     `eqnotnull1` C.maximum+prop_minimumCC      = D.minimum     `eqnotnull1` C.minimum+prop_tailCC         = D.tail        `eqnotnull1` C.tail+prop_foldl1CC       = D.foldl1      `eqnotnull2` C.foldl1+prop_foldl1CC'      = D.foldl1'     `eqnotnull2` C.foldl1'+prop_foldr1CC       = D.foldr1      `eqnotnull2` C.foldr1+prop_foldr1CC'      = D.foldr1      `eqnotnull2` C.foldr1'+prop_scanlCC        = D.scanl       `eqnotnull3` C.scanl++prop_intersperseCC = D.intersperse  `eq2` C.intersperse++prop_foldlCC     = eq3+    (D.foldl     :: (X -> Char -> X) -> X -> B -> X)+    (C.foldl     :: (X -> Char -> X) -> X -> P -> X)+prop_foldlCC'    = eq3+    (D.foldl'    :: (X -> Char -> X) -> X -> B -> X)+    (C.foldl'    :: (X -> Char -> X) -> X -> P -> X)+prop_foldrCC     = eq3+    (D.foldr     :: (Char -> X -> X) -> X -> B -> X)+    (C.foldr     :: (Char -> X -> X) -> X -> P -> X)+prop_foldrCC'    = eq3+    (D.foldr     :: (Char -> X -> X) -> X -> B -> X)+    (C.foldr'    :: (Char -> X -> X) -> X -> P -> X)+prop_mapAccumLCC = eq3+    (D.mapAccumL :: (X -> Char -> (X,Char)) -> X -> B -> (X, B))+    (C.mapAccumL :: (X -> Char -> (X,Char)) -> X -> P -> (X, P))++--prop_mapIndexedCC = D.mapIndexed `eq2` C.mapIndexed+--prop_mapIndexedPL = L.mapIndexed `eq2` P.mapIndexed++--prop_mapAccumL_mapIndexedBP =+--        P.mapIndexed `eq2`+--        (\k p -> snd $ P.mapAccumL (\i w -> (i+1, k i w)) (0::Int) p)++--+-- ByteString.Lazy <=> ByteString+--++prop_concatBP       = adjustSize (`div` 2) $+                      L.concat               `eq1`  P.concat+prop_nullBP         = L.null                 `eq1`  P.null+prop_reverseBP      = L.reverse              `eq1`  P.reverse++prop_transposeBP    = L.transpose            `eq1`  P.transpose+prop_groupBP        = L.group                `eq1`  P.group+prop_groupByBP      = L.groupBy              `eq2`  P.groupBy+prop_initsBP        = L.inits                `eq1`  P.inits+prop_tailsBP        = L.tails                `eq1`  P.tails+prop_allBP          = L.all                  `eq2`  P.all+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) $+                      L.concatMap            `eq2`  P.concatMap+prop_consBP         = L.cons                 `eq2`  P.cons+prop_consBP'        = L.cons'                `eq2`  P.cons+prop_unconsBP       = L.uncons               `eq1`  P.uncons+prop_countBP        = L.count                `eq2`  ((toInt64 .) . P.count)+prop_dropBP         = (L.drop. toInt64)      `eq2`  P.drop+prop_dropWhileBP    = L.dropWhile            `eq2`  P.dropWhile+prop_filterBP       = L.filter               `eq2`  P.filter+prop_findBP         = L.find                 `eq2`  P.find+prop_findIndexBP    = L.findIndex            `eq2`  ((fmap toInt64 .) . P.findIndex)+prop_findIndicesBP  = L.findIndices          `eq2`  ((fmap toInt64 .) . P.findIndices)+prop_isPrefixOfBP   = L.isPrefixOf           `eq2`  P.isPrefixOf+prop_mapBP          = L.map                  `eq2`  P.map+prop_replicateBP    = forAll arbitrarySizedIntegral $+                      (L.replicate. toInt64) `eq2`  P.replicate+prop_snocBP         = L.snoc                 `eq2`  P.snoc+prop_spanBP         = L.span                 `eq2`  P.span+prop_splitBP        = L.split                `eq2`  P.split+prop_splitAtBP      = (L.splitAt. toInt64)   `eq2`  P.splitAt+prop_takeBP         = (L.take   . toInt64)   `eq2`  P.take+prop_takeWhileBP    = L.takeWhile            `eq2`  P.takeWhile+prop_elemBP         = L.elem                 `eq2`  P.elem+prop_notElemBP      = L.notElem              `eq2`  P.notElem+prop_elemIndexBP    = L.elemIndex            `eq2`  ((fmap toInt64 .) . P.elemIndex)+prop_elemIndicesBP  = L.elemIndices          `eq2`  ((fmap toInt64 .) . P.elemIndices)+prop_intersperseBP  = L.intersperse          `eq2`  P.intersperse+prop_lengthBP       = L.length               `eq1`  (toInt64 . P.length)+prop_readIntBP      = D.readInt              `eq1`  C.readInt+prop_linesBP        = D.lines                `eq1`  C.lines++-- double check:+-- Currently there's a bug in the lazy bytestring version of lines, this+-- catches it:+prop_linesNLBP      = eq1 D.lines C.lines x+    where x = D.pack "one\ntwo\n\n\nfive\n\nseven\n"++prop_headBP         = L.head        `eqnotnull1` P.head+prop_initBP         = L.init        `eqnotnull1` P.init+prop_lastBP         = L.last        `eqnotnull1` P.last+prop_maximumBP      = L.maximum     `eqnotnull1` P.maximum+prop_minimumBP      = L.minimum     `eqnotnull1` P.minimum+prop_tailBP         = L.tail        `eqnotnull1` P.tail+prop_foldl1BP       = L.foldl1      `eqnotnull2` P.foldl1+prop_foldl1BP'      = L.foldl1'     `eqnotnull2` P.foldl1'+prop_foldr1BP       = L.foldr1      `eqnotnull2` P.foldr1+prop_foldr1BP'      = L.foldr1      `eqnotnull2` P.foldr1'+prop_scanlBP        = L.scanl       `eqnotnull3` P.scanl+++prop_eqBP        = eq2+    ((==) :: B -> B -> Bool)+    ((==) :: P -> P -> Bool)+prop_compareBP   = eq2+    ((compare) :: B -> B -> Ordering)+    ((compare) :: P -> P -> Ordering)+prop_foldlBP     = eq3+    (L.foldl     :: (X -> W -> X) -> X -> B -> X)+    (P.foldl     :: (X -> W -> X) -> X -> P -> X)+prop_foldlBP'    = eq3+    (L.foldl'    :: (X -> W -> X) -> X -> B -> X)+    (P.foldl'    :: (X -> W -> X) -> X -> P -> X)+prop_foldrBP     = eq3+    (L.foldr     :: (W -> X -> X) -> X -> B -> X)+    (P.foldr     :: (W -> X -> X) -> X -> P -> X)+prop_foldrBP'    = eq3+    (L.foldr     :: (W -> X -> X) -> X -> B -> X)+    (P.foldr'    :: (W -> X -> X) -> X -> P -> X)+prop_mapAccumLBP = eq3+    (L.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))+    (P.mapAccumL :: (X -> W -> (X,W)) -> X -> P -> (X, P))++prop_unfoldrBP   =+  forAll arbitrarySizedIntegral $+  eq3+    ((\n f a -> L.take (fromIntegral n) $+        L.unfoldr    f a) :: Int -> (X -> Maybe (W,X)) -> X -> B)+    ((\n f a ->                     fst $+        P.unfoldrN n f a) :: Int -> (X -> Maybe (W,X)) -> X -> P)++prop_unfoldr2BP   =+  forAll arbitrarySizedIntegral $ \n ->+  forAll arbitrarySizedIntegral $ \a ->+  eq2+    ((\n a -> P.take (n*100) $+        P.unfoldr    (\x -> if x <= (n*100) then Just (fromIntegral x, x + 1) else Nothing) a)+                :: Int -> Int -> P)+    ((\n a ->                     fst $+        P.unfoldrN (n*100) (\x -> if x <= (n*100) then Just (fromIntegral x, x + 1) else Nothing) a)+                :: Int -> Int -> P)+    n a++prop_unfoldr2CP   =+  forAll arbitrarySizedIntegral $ \n ->+  forAll arbitrarySizedIntegral $ \a ->+  eq2+    ((\n a -> C.take (n*100) $+        C.unfoldr    (\x -> if x <= (n*100) then Just (chr (x `mod` 256), x + 1) else Nothing) a)+                :: Int -> Int -> P)+    ((\n a ->                     fst $+        C.unfoldrN (n*100) (\x -> if x <= (n*100) then Just (chr (x `mod` 256), x + 1) else Nothing) a)+                :: Int -> Int -> P)+    n a+++prop_unfoldrLC   =+  forAll arbitrarySizedIntegral $+  eq3+    ((\n f a -> LC.take (fromIntegral n) $+        LC.unfoldr    f a) :: Int -> (X -> Maybe (Char,X)) -> X -> B)+    ((\n f a ->                     fst $+        C.unfoldrN n f a) :: Int -> (X -> Maybe (Char,X)) -> X -> P)++prop_cycleLC  a   =+  not (LC.null a) ==>+  forAll arbitrarySizedIntegral $+  eq1+    ((\n   -> LC.take (fromIntegral n) $+              LC.cycle a+     ) :: Int -> B)++    ((\n   -> LC.take (fromIntegral (n::Int)) . LC.concat $+              unfoldr (\x ->  Just (x,x) ) a+     ) :: Int -> B)+++prop_iterateLC =+  forAll arbitrarySizedIntegral $+  eq3+    ((\n f a -> LC.take (fromIntegral n) $+        LC.iterate  f a) :: Int -> (Char -> Char) -> Char -> B)+    ((\n f a -> fst $+        C.unfoldrN n (\a -> Just (f a, f a)) a) :: Int -> (Char -> Char) -> Char -> P)++prop_iterateLC_2   =+  forAll arbitrarySizedIntegral $+  eq3+    ((\n f a -> LC.take (fromIntegral n) $+        LC.iterate  f a) :: Int -> (Char -> Char) -> Char -> B)+    ((\n f a -> LC.take (fromIntegral n) $+        LC.unfoldr (\a -> Just (f a, f a)) a) :: Int -> (Char -> Char) -> Char -> B)++prop_iterateL   =+  forAll arbitrarySizedIntegral $+  eq3+    ((\n f a -> L.take (fromIntegral n) $+        L.iterate  f a) :: Int -> (W -> W) -> W -> B)+    ((\n f a -> fst $+        P.unfoldrN n (\a -> Just (f a, f a)) a) :: Int -> (W -> W) -> W -> P)++prop_repeatLC   =+  forAll arbitrarySizedIntegral $+  eq2+    ((\n a -> LC.take (fromIntegral n) $+        LC.repeat a) :: Int -> Char -> B)+    ((\n a -> fst $+        C.unfoldrN n (\a -> Just (a, a)) a) :: Int -> Char -> P)++prop_repeatL   =+  forAll arbitrarySizedIntegral $+  eq2+    ((\n a -> L.take (fromIntegral n) $+        L.repeat a) :: Int -> W -> B)+    ((\n a -> fst $+        P.unfoldrN n (\a -> Just (a, a)) a) :: Int -> W -> P)++--+-- properties comparing ByteString.Lazy `eq1` List+--++prop_concatBL       = adjustSize (`div` 2) $+                      L.concat                `eq1` (concat    :: [[W]] -> [W])+prop_lengthBL       = L.length                `eq1` (toInt64 . length    :: [W] -> Int64)+prop_nullBL         = L.null                  `eq1` (null      :: [W] -> Bool)+prop_reverseBL      = L.reverse               `eq1` (reverse   :: [W] -> [W])+prop_transposeBL    = L.transpose             `eq1` (transpose :: [[W]] -> [[W]])+prop_groupBL        = L.group                 `eq1` (group     :: [W] -> [[W]])+prop_groupByBL      = L.groupBy               `eq2` (groupBy   :: (W -> W -> Bool) -> [W] -> [[W]])+prop_initsBL        = L.inits                 `eq1` (inits     :: [W] -> [[W]])+prop_tailsBL        = L.tails                 `eq1` (tails     :: [W] -> [[W]])+prop_allBL          = L.all                   `eq2` (all       :: (W -> Bool) -> [W] -> Bool)+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) $+                      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])+prop_dropWhileBL    = L.dropWhile             `eq2` (dropWhile :: (W -> Bool) -> [W] -> [W])+prop_filterBL       = L.filter                `eq2` (filter    :: (W -> Bool ) -> [W] -> [W])+prop_findBL         = L.find                  `eq2` (find      :: (W -> Bool) -> [W] -> Maybe W)+prop_findIndicesBL  = L.findIndices           `eq2` ((fmap toInt64 .) . findIndices:: (W -> Bool) -> [W] -> [Int64])+prop_findIndexBL    = L.findIndex             `eq2` ((fmap toInt64 .) . findIndex :: (W -> Bool) -> [W] -> Maybe Int64)+prop_isPrefixOfBL   = L.isPrefixOf            `eq2` (isPrefixOf:: [W] -> [W] -> Bool)+prop_mapBL          = L.map                   `eq2` (map       :: (W -> W) -> [W] -> [W])+prop_replicateBL    = forAll arbitrarySizedIntegral $+                      (L.replicate . toInt64) `eq2` (replicate :: Int -> W -> [W])+prop_snocBL         = L.snoc                  `eq2` ((\xs x -> xs ++ [x]) :: [W] -> W -> [W])+prop_spanBL         = L.span                  `eq2` (span      :: (W -> Bool) -> [W] -> ([W],[W]))+prop_splitAtBL      = (L.splitAt . toInt64)   `eq2` (splitAt :: Int -> [W] -> ([W],[W]))+prop_takeBL         = (L.take    . toInt64)   `eq2` (take    :: Int -> [W] -> [W])+prop_takeWhileBL    = L.takeWhile             `eq2` (takeWhile :: (W -> Bool) -> [W] -> [W])+prop_elemBL         = L.elem                  `eq2` (elem      :: W -> [W] -> Bool)+prop_notElemBL      = L.notElem               `eq2` (notElem   :: W -> [W] -> Bool)+prop_elemIndexBL    = L.elemIndex             `eq2` ((fmap toInt64 .) . elemIndex   :: W -> [W] -> Maybe Int64)+prop_elemIndicesBL  = L.elemIndices           `eq2` ((fmap toInt64 .) . elemIndices :: W -> [W] -> [Int64])+prop_linesBL        = D.lines                 `eq1` (lines     :: String -> [String])++prop_foldl1BL       = L.foldl1  `eqnotnull2` (foldl1    :: (W -> W -> W) -> [W] -> W)+prop_foldl1BL'      = L.foldl1' `eqnotnull2` (foldl1'   :: (W -> W -> W) -> [W] -> W)+prop_foldr1BL       = L.foldr1  `eqnotnull2` (foldr1    :: (W -> W -> W) -> [W] -> W)+prop_headBL         = L.head    `eqnotnull1` (head      :: [W] -> W)+prop_initBL         = L.init    `eqnotnull1` (init      :: [W] -> [W])+prop_lastBL         = L.last    `eqnotnull1` (last      :: [W] -> W)+prop_maximumBL      = L.maximum `eqnotnull1` (maximum   :: [W] -> W)+prop_minimumBL      = L.minimum `eqnotnull1` (minimum   :: [W] -> W)+prop_tailBL         = L.tail    `eqnotnull1` (tail      :: [W] -> [W])++prop_eqBL         = eq2+    ((==) :: B   -> B   -> Bool)+    ((==) :: [W] -> [W] -> Bool)+prop_compareBL    = eq2+    ((compare) :: B   -> B   -> Ordering)+    ((compare) :: [W] -> [W] -> Ordering)+prop_foldlBL      = eq3+    (L.foldl  :: (X -> W -> X) -> X -> B   -> X)+    (  foldl  :: (X -> W -> X) -> X -> [W] -> X)+prop_foldlBL'     = eq3+    (L.foldl' :: (X -> W -> X) -> X -> B   -> X)+    (  foldl' :: (X -> W -> X) -> X -> [W] -> X)+prop_foldrBL      = eq3+    (L.foldr  :: (W -> X -> X) -> X -> B   -> X)+    (  foldr  :: (W -> X -> X) -> X -> [W] -> X)+prop_mapAccumLBL  = eq3+    (L.mapAccumL :: (X -> W -> (X,W)) -> X -> B   -> (X, B))+    (  mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))++prop_mapAccumRBL  = eq3+    (L.mapAccumR :: (X -> W -> (X,W)) -> X -> B   -> (X, B))+    (  mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))++prop_mapAccumRDL  = eq3+    (D.mapAccumR :: (X -> Char -> (X,Char)) -> X -> B   -> (X, B))+    (  mapAccumR :: (X -> Char -> (X,Char)) -> X -> [Char] -> (X, [Char]))++prop_mapAccumRCC  = eq3+    (C.mapAccumR :: (X -> Char -> (X,Char)) -> X -> P   -> (X, P))+    (  mapAccumR :: (X -> Char -> (X,Char)) -> X -> [Char] -> (X, [Char]))++prop_unfoldrBL =+  forAll arbitrarySizedIntegral $+  eq3+    ((\n f a -> L.take (fromIntegral n) $+        L.unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> B)+    ((\n f a ->                  take n $+          unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> [W])++--+-- And finally, check correspondance between Data.ByteString and List+--++prop_lengthPL     = (fromIntegral.P.length :: P -> Int) `eq1` (length :: [W] -> Int)+prop_nullPL       = P.null      `eq1` (null      :: [W] -> Bool)+prop_reversePL    = P.reverse   `eq1` (reverse   :: [W] -> [W])+prop_transposePL  = P.transpose `eq1` (transpose :: [[W]] -> [[W]])+prop_groupPL      = P.group     `eq1` (group     :: [W] -> [[W]])+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) $+                    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) $+                    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])+prop_dropWhilePL  = P.dropWhile `eq2`    (dropWhile :: (W -> Bool) -> [W] -> [W])+prop_filterPL     = P.filter    `eq2`    (filter    :: (W -> Bool ) -> [W] -> [W])+prop_filterPL_rule= (\x -> P.filter ((==) x))  `eq2` -- test rules+                    ((\x -> filter ((==) x)) :: W -> [W] -> [W])++-- under lambda doesn't fire?+prop_filterLC_rule= (f)  `eq2` -- test rules+                    ((\x -> filter ((==) x)) :: Char -> [Char] -> [Char])+    where+         f x s = LC.filter ((==) x) s++prop_partitionPL  = P.partition `eq2`    (partition :: (W -> Bool ) -> [W] -> ([W],[W]))+prop_partitionLL  = L.partition `eq2`    (partition :: (W -> Bool ) -> [W] -> ([W],[W]))+prop_findPL       = P.find      `eq2`    (find      :: (W -> Bool) -> [W] -> Maybe W)+prop_findIndexPL  = P.findIndex `eq2`    (findIndex :: (W -> Bool) -> [W] -> Maybe Int)+prop_isPrefixOfPL = P.isPrefixOf`eq2`    (isPrefixOf:: [W] -> [W] -> Bool)+prop_isInfixOfPL  = P.isInfixOf `eq2`    (isInfixOf:: [W] -> [W] -> Bool)+prop_mapPL        = P.map       `eq2`    (map       :: (W -> W) -> [W] -> [W])+prop_replicatePL  = forAll arbitrarySizedIntegral $+                    P.replicate `eq2`    (replicate :: Int -> W -> [W])+prop_snocPL       = P.snoc      `eq2`    ((\xs x -> xs ++ [x]) :: [W] -> W -> [W])+prop_spanPL       = P.span      `eq2`    (span      :: (W -> Bool) -> [W] -> ([W],[W]))+prop_splitAtPL    = P.splitAt   `eq2`    (splitAt   :: Int -> [W] -> ([W],[W]))+prop_takePL       = P.take      `eq2`    (take      :: Int -> [W] -> [W])+prop_takeWhilePL  = P.takeWhile `eq2`    (takeWhile :: (W -> Bool) -> [W] -> [W])+prop_elemPL       = P.elem      `eq2`    (elem      :: W -> [W] -> Bool)+prop_notElemPL    = P.notElem   `eq2`    (notElem   :: W -> [W] -> Bool)+prop_elemIndexPL  = P.elemIndex `eq2`    (elemIndex :: W -> [W] -> Maybe Int)+prop_linesPL      = C.lines     `eq1`    (lines     :: String -> [String])+prop_findIndicesPL= P.findIndices`eq2`   (findIndices:: (W -> Bool) -> [W] -> [Int])+prop_elemIndicesPL= P.elemIndices`eq2`   (elemIndices:: W -> [W] -> [Int])+prop_zipPL        = P.zip        `eq2`   (zip :: [W] -> [W] -> [(W,W)])+prop_zipCL        = C.zip        `eq2`   (zip :: [Char] -> [Char] -> [(Char,Char)])+prop_zipLL        = L.zip        `eq2`   (zip :: [W] -> [W] -> [(W,W)])+prop_unzipPL      = P.unzip      `eq1`   (unzip :: [(W,W)] -> ([W],[W]))+prop_unzipLL      = L.unzip      `eq1`   (unzip :: [(W,W)] -> ([W],[W]))+prop_unzipCL      = C.unzip      `eq1`   (unzip :: [(Char,Char)] -> ([Char],[Char]))++prop_foldl1PL     = P.foldl1    `eqnotnull2` (foldl1   :: (W -> W -> W) -> [W] -> W)+prop_foldl1PL'    = P.foldl1'   `eqnotnull2` (foldl1' :: (W -> W -> W) -> [W] -> W)+prop_foldr1PL     = P.foldr1    `eqnotnull2` (foldr1 :: (W -> W -> W) -> [W] -> W)+prop_scanlPL      = P.scanl     `eqnotnull3` (scanl  :: (W -> W -> W) -> W -> [W] -> [W])+prop_scanl1PL     = P.scanl1    `eqnotnull2` (scanl1 :: (W -> W -> W) -> [W] -> [W])+prop_scanrPL      = P.scanr     `eqnotnull3` (scanr  :: (W -> W -> W) -> W -> [W] -> [W])+prop_scanr1PL     = P.scanr1    `eqnotnull2` (scanr1 :: (W -> W -> W) -> [W] -> [W])+prop_headPL       = P.head      `eqnotnull1` (head      :: [W] -> W)+prop_initPL       = P.init      `eqnotnull1` (init      :: [W] -> [W])+prop_lastPL       = P.last      `eqnotnull1` (last      :: [W] -> W)+prop_maximumPL    = P.maximum   `eqnotnull1` (maximum   :: [W] -> W)+prop_minimumPL    = P.minimum   `eqnotnull1` (minimum   :: [W] -> W)+prop_tailPL       = P.tail      `eqnotnull1` (tail      :: [W] -> [W])++prop_scanl1CL     = C.scanl1    `eqnotnull2` (scanl1 :: (Char -> Char -> Char) -> [Char] -> [Char])+prop_scanrCL      = C.scanr     `eqnotnull3` (scanr  :: (Char -> Char -> Char) -> Char -> [Char] -> [Char])+prop_scanr1CL     = C.scanr1    `eqnotnull2` (scanr1 :: (Char -> Char -> Char) -> [Char] -> [Char])++-- prop_zipWithPL'   = P.zipWith'  `eq3` (zipWith :: (W -> W -> W) -> [W] -> [W] -> [W])++prop_zipWithPL    = (P.zipWith  :: (W -> W -> X) -> P   -> P   -> [X]) `eq3`+                      (zipWith  :: (W -> W -> X) -> [W] -> [W] -> [X])++prop_zipWithPL_rules   = (P.zipWith  :: (W -> W -> W) -> P -> P -> [W]) `eq3`+                         (zipWith    :: (W -> W -> W) -> [W] -> [W] -> [W])++prop_eqPL      = eq2+    ((==) :: P   -> P   -> Bool)+    ((==) :: [W] -> [W] -> Bool)+prop_comparePL = eq2+    ((compare) :: P   -> P   -> Ordering)+    ((compare) :: [W] -> [W] -> Ordering)+prop_foldlPL   = eq3+    (P.foldl  :: (X -> W -> X) -> X -> P        -> X)+    (  foldl  :: (X -> W -> X) -> X -> [W]      -> X)+prop_foldlPL'  = eq3+    (P.foldl' :: (X -> W -> X) -> X -> P        -> X)+    (  foldl' :: (X -> W -> X) -> X -> [W]      -> X)+prop_foldrPL   = eq3+    (P.foldr  :: (W -> X -> X) -> X -> P        -> X)+    (  foldr  :: (W -> X -> X) -> X -> [W]      -> X)+prop_mapAccumLPL= eq3+    (P.mapAccumL :: (X -> W -> (X,W)) -> X -> P -> (X, P))+    (  mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))+prop_mapAccumRPL= eq3+    (P.mapAccumR :: (X -> W -> (X,W)) -> X -> P -> (X, P))+    (  mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))+prop_unfoldrPL =+  forAll arbitrarySizedIntegral $+  eq3+    ((\n f a ->      fst $+        P.unfoldrN n f a) :: Int -> (X -> Maybe (W,X)) -> X -> P)+    ((\n f a ->   take n $+          unfoldr    f a) :: Int -> (X -> Maybe (W,X)) -> X -> [W])++------------------------------------------------------------------------+--+-- These are miscellaneous tests left over. Or else they test some+-- property internal to a type (i.e. head . sort == minimum), without+-- reference to a model type.+--++invariant :: L.ByteString -> Bool+invariant Empty       = True+invariant (Chunk c cs) = not (P.null c) && invariant cs++prop_invariant = invariant++prop_eq_refl  x     = x        == (x :: ByteString)+prop_eq_symm  x y   = (x == y) == (y == (x :: ByteString))++prop_eq1 xs      = xs == (unpack . pack $ xs)+prop_eq2 xs      = xs == (xs :: ByteString)+prop_eq3 xs ys   = (xs == ys) == (unpack xs == unpack ys)++prop_compare1 xs   = (pack xs        `compare` pack xs) == EQ+prop_compare2 xs c = (pack (xs++[c]) `compare` pack xs) == GT+prop_compare3 xs c = (pack xs `compare` pack (xs++[c])) == LT++prop_compare4 xs    = (not (null xs)) ==> (pack xs  `compare` L.empty) == GT+prop_compare5 xs    = (not (null xs)) ==> (L.empty `compare` pack xs) == LT+prop_compare6 xs ys = (not (null ys)) ==> (pack (xs++ys)  `compare` pack xs) == GT++prop_compare7 x  y  = x  `compare` y  == (L.singleton x `compare` L.singleton y)+prop_compare8 xs ys = xs `compare` ys == (L.pack xs `compare` L.pack ys)++prop_compare7LL x  y  = x  `compare` y  == (LC.singleton x `compare` LC.singleton y)++prop_empty1 = L.length L.empty == 0+prop_empty2 = L.unpack L.empty == []++prop_packunpack s = (L.unpack . L.pack) s == id s+prop_unpackpack s = (L.pack . L.unpack) s == id s++prop_null xs = null (L.unpack xs) == L.null xs++prop_length1 xs = fromIntegral (length xs) == L.length (L.pack xs)++prop_length2 xs = L.length xs == length1 xs+  where length1 ys+            | L.null ys = 0+            | otherwise = 1 + length1 (L.tail ys)++prop_cons1 c xs = unpack (L.cons c (pack xs)) == (c:xs)+prop_cons2 c    = L.singleton c == (c `L.cons` L.empty)+prop_cons3 c    = unpack (L.singleton c) == (c:[])+prop_cons4 c    = (c `L.cons` L.empty)  == pack (c:[])++prop_snoc1 xs c = xs ++ [c] == unpack ((pack xs) `L.snoc` c)++prop_head  xs = (not (null xs)) ==> head xs == (L.head . pack) xs+prop_head1 xs = not (L.null xs) ==> L.head xs == head (L.unpack xs)++prop_tail xs  = not (L.null xs) ==> L.tail xs == pack (tail (unpack xs))+prop_tail1 xs = (not (null xs)) ==> tail xs   == (unpack . L.tail . pack) xs++prop_last xs  = (not (null xs)) ==> last xs    == (L.last . pack) xs++prop_init xs  =+    (not (null xs)) ==>+    init xs   == (unpack . L.init . pack) xs++prop_append1 xs    = (xs ++ xs) == (unpack $ pack xs `L.append` pack xs)+prop_append2 xs ys = (xs ++ ys) == (unpack $ pack xs `L.append` pack ys)+prop_append3 xs ys = L.append xs ys == pack (unpack xs ++ unpack ys)++prop_map1 f xs   = L.map f (pack xs)    == pack (map f xs)+prop_map2 f g xs = L.map f (L.map g xs) == L.map (f . g) xs+prop_map3 f xs   = map f xs == (unpack . L.map f .  pack) xs++prop_filter1 c xs = (filter (/=c) xs) == (unpack $ L.filter (/=c) (pack xs))+prop_filter2 p xs = (filter p xs) == (unpack $ L.filter p (pack xs))++prop_reverse  xs = reverse xs          == (unpack . L.reverse . pack) xs+prop_reverse1 xs = L.reverse (pack xs) == pack (reverse xs)+prop_reverse2 xs = reverse (unpack xs) == (unpack . L.reverse) xs++prop_transpose xs = (transpose xs) == ((map unpack) . L.transpose . (map pack)) xs++prop_foldl f c xs = L.foldl f c (pack xs) == foldl f c xs+    where _ = c :: Char++prop_foldr f c xs = L.foldl f c (pack xs) == foldl f c xs+    where _ = c :: Char++prop_foldl_1 xs = L.foldl (\xs c -> c `L.cons` xs) L.empty xs == L.reverse xs+prop_foldr_1 xs = L.foldr (\c xs -> c `L.cons` xs) L.empty xs == id xs++prop_foldl1_1 xs =+    (not . L.null) xs ==>+    L.foldl1 (\x c -> if c > x then c else x)   xs ==+    L.foldl  (\x c -> if c > x then c else x) 0 xs++prop_foldl1_2 xs =+    (not . L.null) xs ==>+    L.foldl1 const xs == L.head xs++prop_foldl1_3 xs =+    (not . L.null) xs ==>+    L.foldl1 (flip const) xs == L.last xs++prop_foldr1_1 xs =+    (not . L.null) xs ==>+    L.foldr1 (\c x -> if c > x then c else x)   xs ==+    L.foldr  (\c x -> if c > x then c else x) 0 xs++prop_foldr1_2 xs =+    (not . L.null) xs ==>+    L.foldr1 (flip const) xs == L.last xs++prop_foldr1_3 xs =+    (not . L.null) xs ==>+    L.foldr1 const xs == L.head xs++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_concatMap xs = L.concatMap L.singleton xs == (pack . concatMap (:[]) . unpack) xs++prop_any xs a = (any (== a) xs) == (L.any (== a) (pack xs))+prop_all xs a = (all (== a) xs) == (L.all (== a) (pack xs))++prop_maximum xs = (not (null xs)) ==> (maximum xs) == (L.maximum ( pack xs ))+prop_minimum xs = (not (null xs)) ==> (minimum xs) == (L.minimum ( pack xs ))++prop_replicate1 c =+    forAll arbitrarySizedIntegral $ \(Positive n) ->+    unpack (L.replicate (fromIntegral n) c) == replicate n c++prop_replicate2 c = unpack (L.replicate 0 c) == replicate 0 c++prop_take1 i xs = L.take (fromIntegral i) (pack xs) == pack (take i xs)+prop_drop1 i xs = L.drop (fromIntegral i) (pack xs) == pack (drop i xs)++prop_splitAt i xs = --collect (i >= 0 && i < length xs) $+    L.splitAt (fromIntegral i) (pack xs) == let (a,b) = splitAt i xs in (pack a, pack b)++prop_takeWhile f xs = L.takeWhile f (pack xs) == pack (takeWhile f xs)+prop_dropWhile f xs = L.dropWhile f (pack xs) == pack (dropWhile f xs)++prop_break f xs = L.break f (pack xs) ==+    let (a,b) = break f xs in (pack a, pack b)++prop_breakspan xs c = L.break (==c) xs == L.span (/=c) xs++prop_span xs a = (span (/=a) xs) == (let (x,y) = L.span (/=a) (pack xs) in (unpack x, unpack y))++-- prop_breakByte xs c = L.break (== c) xs == L.breakByte c xs++-- prop_spanByte c xs = (L.span (==c) xs) == L.spanByte c xs++prop_split c xs = (map L.unpack . map checkInvariant . L.split c $ xs)+               == (map P.unpack . P.split c . P.pack . L.unpack $ xs)++prop_splitWith f xs = (l1 == l2 || l1 == l2+1) &&+        sum (map L.length splits) == L.length xs - l2+  where splits = L.splitWith f xs+        l1 = fromIntegral (length splits)+        l2 = L.length (L.filter f xs)++prop_splitWith_D f xs = (l1 == l2 || l1 == l2+1) &&+        sum (map D.length splits) == D.length xs - l2+  where splits = D.splitWith f xs+        l1 = fromIntegral (length splits)+        l2 = D.length (D.filter f xs)++prop_splitWith_C f xs = (l1 == l2 || l1 == l2+1) &&+        sum (map C.length splits) == C.length xs - l2+  where splits = C.splitWith f xs+        l1 = fromIntegral (length splits)+        l2 = C.length (C.filter f xs)++prop_joinsplit c xs = L.intercalate (pack [c]) (L.split c xs) == id xs++prop_group xs       = group xs == (map unpack . L.group . pack) xs+prop_groupBy  f xs  = groupBy f xs == (map unpack . L.groupBy f . pack) xs+prop_groupBy_LC  f xs  = groupBy f xs == (map LC.unpack . LC.groupBy f .  LC.pack) xs++-- prop_joinjoinByte xs ys c = L.joinWithByte c xs ys == L.join (L.singleton c) [xs,ys]++prop_index xs =+  not (null xs) ==>+    forAll indices $ \i -> (xs !! i) == L.pack xs `L.index` (fromIntegral i)+  where indices = choose (0, length xs -1)++prop_index_D xs =+  not (null xs) ==>+    forAll indices $ \i -> (xs !! i) == D.pack xs `D.index` (fromIntegral i)+  where indices = choose (0, length xs -1)++prop_index_C xs =+  not (null xs) ==>+    forAll indices $ \i -> (xs !! i) == C.pack xs `C.index` (fromIntegral i)+  where indices = choose (0, length xs -1)++prop_elemIndex xs c = (elemIndex c xs) == fmap fromIntegral (L.elemIndex c (pack xs))+prop_elemIndexCL xs c = (elemIndex c xs) == (C.elemIndex c (C.pack xs))++prop_elemIndices xs c = elemIndices c xs == map fromIntegral (L.elemIndices c (pack xs))++prop_count c xs = length (L.elemIndices c xs) == fromIntegral (L.count c xs)++prop_findIndex xs f = (findIndex f xs) == fmap fromIntegral (L.findIndex f (pack xs))+prop_findIndicies xs f = (findIndices f xs) == map fromIntegral (L.findIndices f (pack xs))++prop_elem    xs c = (c `elem` xs)    == (c `L.elem` (pack xs))+prop_notElem xs c = (c `notElem` xs) == (L.notElem c (pack xs))+prop_elem_notelem xs c = c `L.elem` xs == not (c `L.notElem` xs)++-- prop_filterByte  xs c = L.filterByte c xs == L.filter (==c) xs+-- prop_filterByte2 xs c = unpack (L.filterByte c xs) == filter (==c) (unpack xs)++-- prop_filterNotByte  xs c = L.filterNotByte c xs == L.filter (/=c) xs+-- prop_filterNotByte2 xs c = unpack (L.filterNotByte c xs) == filter (/=c) (unpack xs)++prop_find p xs = find p xs == L.find p (pack xs)++prop_find_findIndex p xs =+    L.find p xs == case L.findIndex p xs of+                                Just n -> Just (xs `L.index` n)+                                _      -> Nothing++prop_isPrefixOf xs ys = isPrefixOf xs ys == (pack xs `L.isPrefixOf` pack ys)++{-+prop_sort1 xs = sort xs == (unpack . L.sort . pack) xs+prop_sort2 xs = (not (null xs)) ==> (L.head . L.sort . pack $ xs) == minimum xs+prop_sort3 xs = (not (null xs)) ==> (L.last . L.sort . pack $ xs) == maximum xs+prop_sort4 xs ys =+        (not (null xs)) ==>+        (not (null ys)) ==>+        (L.head . L.sort) (L.append (pack xs) (pack ys)) == min (minimum xs) (minimum ys)++prop_sort5 xs ys =+        (not (null xs)) ==>+        (not (null ys)) ==>+        (L.last . L.sort) (L.append (pack xs) (pack ys)) == max (maximum xs) (maximum ys)++-}++------------------------------------------------------------------------+-- Misc ByteString properties++prop_nil1BB = P.length P.empty == 0+prop_nil2BB = P.unpack P.empty == []+prop_nil1BB_monoid = P.length mempty == 0+prop_nil2BB_monoid = P.unpack mempty == []++prop_nil1LL_monoid = L.length mempty == 0+prop_nil2LL_monoid = L.unpack mempty == []++prop_tailSBB xs = not (P.null xs) ==> P.tail xs == P.pack (tail (P.unpack xs))++prop_nullBB xs = null (P.unpack xs) == P.null xs++prop_lengthBB xs = P.length xs == length1 xs+    where+        length1 ys+            | P.null ys = 0+            | otherwise = 1 + length1 (P.tail ys)++prop_lengthSBB xs = length xs == P.length (P.pack xs)++prop_indexBB xs =+  not (null xs) ==>+    forAll indices $ \i -> (xs !! i) == P.pack xs `P.index` i+  where indices = choose (0, length xs -1)++prop_unsafeIndexBB xs =+  not (null xs) ==>+    forAll indices $ \i -> (xs !! i) == P.pack xs `P.unsafeIndex` i+  where indices = choose (0, length xs -1)++prop_mapfusionBB f g xs = P.map f (P.map g xs) == P.map (f . g) xs++prop_filterBB f xs = P.filter f (P.pack xs) == P.pack (filter f xs)++prop_filterfusionBB f g xs = P.filter f (P.filter g xs) == P.filter (\c -> f c && g c) xs++prop_elemSBB x xs = P.elem x (P.pack xs) == elem x xs++prop_takeSBB i xs = P.take i (P.pack xs) == P.pack (take i xs)+prop_dropSBB i xs = P.drop i (P.pack xs) == P.pack (drop i xs)++prop_splitAtSBB i xs = -- collect (i >= 0 && i < length xs) $+    P.splitAt i (P.pack xs) ==+    let (a,b) = splitAt i xs in (P.pack a, P.pack b)++prop_foldlBB f c xs = P.foldl f c (P.pack xs) == foldl f c xs+  where _ = c :: Char++prop_scanlfoldlBB f z xs = not (P.null xs) ==> P.last (P.scanl f z xs) == P.foldl f z xs++prop_foldrBB f c xs = P.foldl f c (P.pack xs) == foldl f c xs+  where _ = c :: Char++prop_takeWhileSBB f xs = P.takeWhile f (P.pack xs) == P.pack (takeWhile f xs)+prop_dropWhileSBB f xs = P.dropWhile f (P.pack xs) == P.pack (dropWhile f xs)++prop_spanSBB f xs = P.span f (P.pack xs) ==+    let (a,b) = span f xs in (P.pack a, P.pack b)++prop_breakSBB f xs = P.break f (P.pack xs) ==+    let (a,b) = break f xs in (P.pack a, P.pack b)++prop_breakspan_1BB xs c = P.break (== c) xs == P.span (/= c) xs++prop_linesSBB xs = C.lines (C.pack xs) == map C.pack (lines xs)++prop_unlinesSBB xss = C.unlines (map C.pack xss) == C.pack (unlines xss)++prop_wordsSBB xs =+    C.words (C.pack xs) == map C.pack (words xs)++prop_wordsLC xs =+    LC.words (LC.pack xs) == map LC.pack (words xs)++prop_unwordsSBB xss = C.unwords (map C.pack xss) == C.pack (unwords xss)+prop_unwordsSLC xss = LC.unwords (map LC.pack xss) == LC.pack (unwords xss)++prop_splitWithBB f xs = (l1 == l2 || l1 == l2+1) &&+        sum (map P.length splits) == P.length xs - l2+  where splits = P.splitWith f xs+        l1 = length splits+        l2 = P.length (P.filter f xs)++prop_joinsplitBB c xs = P.intercalate (P.pack [c]) (P.split c xs) == xs++prop_intercalatePL c x y =++    P.intercalate (P.singleton c) (x : y : []) ==+ --     intercalate (singleton c) (s1 : s2 : [])++    P.pack (intercalate [c] [P.unpack x,P.unpack y])++-- prop_linessplitBB xs =+--     (not . C.null) xs ==>+--     C.lines' xs == C.split '\n' xs++-- false:+{-+prop_linessplit2BB xs =+   (not . C.null) xs ==>+    C.lines xs == C.split '\n' xs ++ (if C.last xs == '\n' then [C.empty] else [])+-}++prop_splitsplitWithBB c xs = P.split c xs == P.splitWith (== c) xs++prop_bijectionBB  c = (P.w2c . P.c2w) c == id c+prop_bijectionBB' w = (P.c2w . P.w2c) w == id w++prop_packunpackBB  s = (P.unpack . P.pack) s == id s+prop_packunpackBB' s = (P.pack . P.unpack) s == id s++prop_eq1BB xs      = xs            == (P.unpack . P.pack $ xs)+prop_eq2BB xs      = xs == (xs :: P.ByteString)+prop_eq3BB xs ys   = (xs == ys) == (P.unpack xs == P.unpack ys)++prop_compare1BB xs  = (P.pack xs         `compare` P.pack xs) == EQ+prop_compare2BB xs c = (P.pack (xs++[c]) `compare` P.pack xs) == GT+prop_compare3BB xs c = (P.pack xs `compare` P.pack (xs++[c])) == LT++prop_compare4BB xs  = (not (null xs)) ==> (P.pack xs  `compare` P.empty) == GT+prop_compare5BB xs  = (not (null xs)) ==> (P.empty `compare` P.pack xs) == LT+prop_compare6BB xs ys= (not (null ys)) ==> (P.pack (xs++ys)  `compare` P.pack xs) == GT++prop_compare7BB x  y = x `compare` y == (C.singleton x `compare` C.singleton y)+prop_compare8BB xs ys = xs `compare` ys == (P.pack xs `compare` P.pack ys)++prop_consBB  c xs = P.unpack (P.cons c (P.pack xs)) == (c:xs)+prop_cons1BB xs   = 'X' : xs == C.unpack ('X' `C.cons` (C.pack xs))+prop_cons2BB xs c = c : xs == P.unpack (c `P.cons` (P.pack xs))+prop_cons3BB c    = C.unpack (C.singleton c) == (c:[])+prop_cons4BB c    = (c `P.cons` P.empty)  == P.pack (c:[])++prop_snoc1BB xs c = xs ++ [c] == P.unpack ((P.pack xs) `P.snoc` c)++prop_head1BB xs     = (not (null xs)) ==> head  xs  == (P.head . P.pack) xs+prop_head2BB xs    = (not (null xs)) ==> head xs   == (P.unsafeHead . P.pack) xs+prop_head3BB xs    = not (P.null xs) ==> P.head xs == head (P.unpack xs)++prop_tailBB xs     = (not (null xs)) ==> tail xs    == (P.unpack . P.tail . P.pack) xs+prop_tail1BB xs    = (not (null xs)) ==> tail xs    == (P.unpack . P.unsafeTail. P.pack) xs++prop_lastBB xs     = (not (null xs)) ==> last xs    == (P.last . P.pack) xs++prop_initBB xs     =+    (not (null xs)) ==>+    init xs    == (P.unpack . P.init . P.pack) xs++-- prop_null xs = (null xs) ==> null xs == (nullPS (pack xs))++prop_append1BB xs    = (xs ++ xs) == (P.unpack $ P.pack xs `P.append` P.pack xs)+prop_append2BB xs ys = (xs ++ ys) == (P.unpack $ P.pack xs `P.append` P.pack ys)+prop_append3BB xs ys = P.append xs ys == P.pack (P.unpack xs ++ P.unpack ys)++prop_append1BB_monoid xs    = (xs ++ xs) == (P.unpack $ P.pack xs `mappend` P.pack xs)+prop_append2BB_monoid xs ys = (xs ++ ys) == (P.unpack $ P.pack xs `mappend` P.pack ys)+prop_append3BB_monoid xs ys = mappend xs ys == P.pack (P.unpack xs ++ P.unpack ys)++prop_append1LL_monoid xs    = (xs ++ xs) == (L.unpack $ L.pack xs `mappend` L.pack xs)+prop_append2LL_monoid xs ys = (xs ++ ys) == (L.unpack $ L.pack xs `mappend` L.pack ys)+prop_append3LL_monoid xs ys = mappend xs ys == L.pack (L.unpack xs ++ L.unpack ys)++prop_map1BB f xs   = P.map f (P.pack xs)    == P.pack (map f xs)+prop_map2BB f g xs = P.map f (P.map g xs) == P.map (f . g) xs+prop_map3BB f xs   = map f xs == (P.unpack . P.map f .  P.pack) xs+-- prop_mapBB' f xs   = P.map' f (P.pack xs) == P.pack (map f xs)++prop_filter1BB xs   = (filter (=='X') xs) == (C.unpack $ C.filter (=='X') (C.pack xs))+prop_filter2BB p xs = (filter p xs) == (P.unpack $ P.filter p (P.pack xs))++prop_findBB p xs = find p xs == P.find p (P.pack xs)++prop_find_findIndexBB p xs =+    P.find p xs == case P.findIndex p xs of+                                Just n -> Just (xs `P.unsafeIndex` n)+                                _      -> Nothing++prop_foldl1BB xs a = ((foldl (\x c -> if c == a then x else c:x) [] xs)) ==+                   (P.unpack $ P.foldl (\x c -> if c == a then x else c `P.cons` x) P.empty (P.pack xs)) +prop_foldl2BB xs = P.foldl (\xs c -> c `P.cons` xs) P.empty (P.pack xs) == P.reverse (P.pack xs)++prop_foldr1BB xs a = ((foldr (\c x -> if c == a then x else c:x) [] xs)) ==+                (P.unpack $ P.foldr (\c x -> if c == a then x else c `P.cons` x)+                    P.empty (P.pack xs))++prop_foldr2BB xs = P.foldr (\c xs -> c `P.cons` xs) P.empty (P.pack xs) == (P.pack xs)++prop_foldl1_1BB xs =+    (not . P.null) xs ==>+    P.foldl1 (\x c -> if c > x then c else x)   xs ==+    P.foldl  (\x c -> if c > x then c else x) 0 xs++prop_foldl1_2BB xs =+    (not . P.null) xs ==>+    P.foldl1 const xs == P.head xs++prop_foldl1_3BB xs =+    (not . P.null) xs ==>+    P.foldl1 (flip const) xs == P.last xs++prop_foldr1_1BB xs =+    (not . P.null) xs ==>+    P.foldr1 (\c x -> if c > x then c else x)   xs ==+    P.foldr  (\c x -> if c > x then c else x) 0 xs++prop_foldr1_2BB xs =+    (not . P.null) xs ==>+    P.foldr1 (flip const) xs == P.last xs++prop_foldr1_3BB xs =+    (not . P.null) xs ==>+    P.foldr1 const xs == P.head xs++prop_takeWhileBB xs a = (takeWhile (/= a) xs) == (P.unpack . (P.takeWhile (/= a)) . P.pack) xs++prop_dropWhileBB xs a = (dropWhile (/= a) xs) == (P.unpack . (P.dropWhile (/= a)) . P.pack) xs++prop_dropWhileCC_isSpace xs =+        (dropWhile isSpace xs) ==+       (C.unpack .  (C.dropWhile isSpace) . C.pack) xs++prop_takeBB xs = (take 10 xs) == (P.unpack . (P.take 10) . P.pack) xs++prop_dropBB xs = (drop 10 xs) == (P.unpack . (P.drop 10) . P.pack) xs++prop_splitAtBB i xs = -- collect (i >= 0 && i < length xs) $+    splitAt i xs ==+    let (x,y) = P.splitAt i (P.pack xs) in (P.unpack x, P.unpack y)++prop_spanBB xs a = (span (/=a) xs) == (let (x,y) = P.span (/=a) (P.pack xs)+                                     in (P.unpack x, P.unpack y))++prop_breakBB xs a = (break (/=a) xs) == (let (x,y) = P.break (/=a) (P.pack xs)+                                       in (P.unpack x, P.unpack y))++prop_reverse1BB xs = (reverse xs) == (P.unpack . P.reverse . P.pack) xs+prop_reverse2BB xs = P.reverse (P.pack xs) == P.pack (reverse xs)+prop_reverse3BB xs = reverse (P.unpack xs) == (P.unpack . P.reverse) xs++prop_elemBB xs a = (a `elem` xs) == (a `P.elem` (P.pack xs))++prop_notElemBB c xs = P.notElem c (P.pack xs) == notElem c xs++-- should try to stress it+prop_concat1BB xs = (concat [xs,xs]) == (P.unpack $ P.concat [P.pack xs, P.pack xs])+prop_concat2BB xs = (concat [xs,[]]) == (P.unpack $ P.concat [P.pack xs, P.pack []])+prop_concatBB xss = P.concat (map P.pack xss) == P.pack (concat xss)++prop_concat1BB_monoid xs = (concat [xs,xs]) == (P.unpack $ mconcat [P.pack xs, P.pack xs])+prop_concat2BB_monoid xs = (concat [xs,[]]) == (P.unpack $ mconcat [P.pack xs, P.pack []])+prop_concatBB_monoid xss = mconcat (map P.pack xss) == P.pack (concat xss)++prop_concat1LL_monoid xs = (concat [xs,xs]) == (L.unpack $ mconcat [L.pack xs, L.pack xs])+prop_concat2LL_monoid xs = (concat [xs,[]]) == (L.unpack $ mconcat [L.pack xs, L.pack []])+prop_concatLL_monoid xss = mconcat (map L.pack xss) == L.pack (concat xss)++prop_concatMapBB xs = C.concatMap C.singleton xs == (C.pack . concatMap (:[]) . C.unpack) xs++prop_anyBB xs a = (any (== a) xs) == (P.any (== a) (P.pack xs))+prop_allBB xs a = (all (== a) xs) == (P.all (== a) (P.pack xs))++prop_linesBB xs = (lines xs) == ((map C.unpack) . C.lines . C.pack) xs++prop_unlinesBB xs = (unlines.lines) xs == (C.unpack. C.unlines . C.lines .C.pack) xs+prop_unlinesLC xs = (unlines.lines) xs == (LC.unpack. LC.unlines .  LC.lines .LC.pack) xs++prop_wordsBB xs =+    (words xs) == ((map C.unpack) . C.words . C.pack) xs+-- prop_wordstokensBB xs = C.words xs == C.tokens isSpace xs++prop_unwordsBB xs =+    (C.pack.unwords.words) xs == (C.unwords . C.words .C.pack) xs++prop_groupBB xs   = group xs == (map P.unpack . P.group . P.pack) xs++prop_groupByBB  xs = groupBy (==) xs == (map P.unpack . P.groupBy (==) . P.pack) xs+prop_groupBy1CC xs = groupBy (==) xs == (map C.unpack . C.groupBy (==) . C.pack) xs+prop_groupBy1BB xs = groupBy (/=) xs == (map P.unpack . P.groupBy (/=) . P.pack) xs+prop_groupBy2CC xs = groupBy (/=) xs == (map C.unpack . C.groupBy (/=) . C.pack) xs++prop_joinBB xs ys = (concat . (intersperse ys) . lines) xs ==+               (C.unpack $ C.intercalate (C.pack ys) (C.lines (C.pack xs)))++prop_elemIndex1BB xs   = (elemIndex 'X' xs) == (C.elemIndex 'X' (C.pack xs))+prop_elemIndex2BB xs c = (elemIndex c xs) == (C.elemIndex c (C.pack xs))++-- prop_lineIndices1BB xs = C.elemIndices '\n' xs == C.lineIndices xs++prop_countBB c xs = length (P.elemIndices c xs) == P.count c xs++prop_elemIndexEnd1BB c xs = (P.elemIndexEnd c (P.pack xs)) ==+                           (case P.elemIndex c (P.pack (reverse xs)) of+                                Nothing -> Nothing+                                Just i  -> Just (length xs -1 -i))++prop_elemIndexEnd1CC c xs = (C.elemIndexEnd c (C.pack xs)) ==+                           (case C.elemIndex c (C.pack (reverse xs)) of+                                Nothing -> Nothing+                                Just i  -> Just (length xs -1 -i))++prop_elemIndexEnd2BB c xs = (P.elemIndexEnd c (P.pack xs)) ==+                           ((-) (length xs - 1) `fmap` P.elemIndex c (P.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))++prop_findIndiciesBB xs c = (findIndices (==c) xs) == (P.findIndices (==c) (P.pack xs))++-- example properties from QuickCheck.Batch+prop_sort1BB xs = sort xs == (P.unpack . P.sort . P.pack) xs+prop_sort2BB xs = (not (null xs)) ==> (P.head . P.sort . P.pack $ xs) == minimum xs+prop_sort3BB xs = (not (null xs)) ==> (P.last . P.sort . P.pack $ xs) == maximum xs+prop_sort4BB xs ys =+        (not (null xs)) ==>+        (not (null ys)) ==>+        (P.head . P.sort) (P.append (P.pack xs) (P.pack ys)) == min (minimum xs) (minimum ys)+prop_sort5BB xs ys =+        (not (null xs)) ==>+        (not (null ys)) ==>+        (P.last . P.sort) (P.append (P.pack xs) (P.pack ys)) == max (maximum xs) (maximum ys)++prop_intersperseBB c xs = (intersperse c xs) == (P.unpack $ P.intersperse c (P.pack xs))++-- prop_transposeBB xs = (transpose xs) == ((map P.unpack) . P.transpose .  (map P.pack)) xs++prop_maximumBB xs = (not (null xs)) ==> (maximum xs) == (P.maximum ( P.pack xs ))+prop_minimumBB xs = (not (null xs)) ==> (minimum xs) == (P.minimum ( P.pack xs ))++-- prop_dropSpaceBB xs    = dropWhile isSpace xs == C.unpack (C.dropSpace (C.pack xs))+-- prop_dropSpaceEndBB xs = (C.reverse . (C.dropWhile isSpace) . C.reverse) (C.pack xs) ==+--                        (C.dropSpaceEnd (C.pack xs))++-- prop_breakSpaceBB xs =+--     (let (x,y) = C.breakSpace (C.pack xs)+--      in (C.unpack x, C.unpack y)) == (break isSpace xs)++prop_spanEndBB xs =+        (C.spanEnd (not . isSpace) (C.pack xs)) ==+        (let (x,y) = C.span (not.isSpace) (C.reverse (C.pack xs)) in (C.reverse y,C.reverse x))++prop_breakEndBB p xs = P.breakEnd (not.p) xs == P.spanEnd p xs+prop_breakEndCC p xs = C.breakEnd (not.p) xs == C.spanEnd p xs++{-+prop_breakCharBB c xs =+        (break (==c) xs) ==+        (let (x,y) = C.breakChar c (C.pack xs) in (C.unpack x, C.unpack y))++prop_spanCharBB c xs =+        (break (/=c) xs) ==+        (let (x,y) = C.spanChar c (C.pack xs) in (C.unpack x, C.unpack y))++prop_spanChar_1BB c xs =+        (C.span (==c) xs) == C.spanChar c xs++prop_wordsBB' xs =+    (C.unpack . C.unwords  . C.words' . C.pack) xs ==+    (map (\c -> if isSpace c then ' ' else c) xs)++-- prop_linesBB' xs = (C.unpack . C.unlines' . C.lines' . C.pack) xs == (xs)+-}++prop_unfoldrBB c =+    forAll arbitrarySizedIntegral $ \n ->+      (fst $ C.unfoldrN n fn c) == (C.pack $ take n $ unfoldr fn c)+  where+    fn x = Just (x, chr (ord x + 1))++prop_prefixBB xs ys = isPrefixOf xs ys == (P.pack xs `P.isPrefixOf` P.pack ys)+prop_suffixBB xs ys = isSuffixOf xs ys == (P.pack xs `P.isSuffixOf` P.pack ys)+prop_suffixLL xs ys = isSuffixOf xs ys == (L.pack xs `L.isSuffixOf` L.pack ys)++prop_copyBB xs = let p = P.pack xs in P.copy p == p+prop_copyLL xs = let p = L.pack xs in L.copy p == p++prop_initsBB xs = inits xs == map P.unpack (P.inits (P.pack xs))++prop_tailsBB xs = tails xs == map P.unpack (P.tails (P.pack xs))++prop_findSubstringsBB s x l+    = C.findSubstrings (C.pack p) (C.pack s) == naive_findSubstrings p s+  where+    _ = l :: Int+    _ = x :: Int++    -- we look for some random substring of the test string+    p = take (model l) $ drop (model x) s++    -- naive reference implementation+    naive_findSubstrings :: String -> String -> [Int]+    naive_findSubstrings p s = [x | x <- [0..length s], p `isPrefixOf` drop x s]++prop_findSubstringBB s x l+    = C.findSubstring (C.pack p) (C.pack s) == naive_findSubstring p s+  where+    _ = l :: Int+    _ = x :: Int++    -- we look for some random substring of the test string+    p = take (model l) $ drop (model x) s++    -- naive reference implementation+    naive_findSubstring :: String -> String -> Maybe Int+    naive_findSubstring p s = listToMaybe [x | x <- [0..length s], p `isPrefixOf` drop x s]++-- correspondance between break and breakSubstring+prop_breakSubstringBB c l+    = P.break (== c) l == P.breakSubstring (P.singleton c) l++prop_breakSubstring_isInfixOf s l+    = P.isInfixOf s l == if P.null s then True+                                     else case P.breakSubstring s l of+                                            (x,y) | P.null y  -> False+                                                  | otherwise -> True++prop_breakSubstring_findSubstring s l+    = P.findSubstring s l == if P.null s then Just 0+                                       else case P.breakSubstring s l of+                                            (x,y) | P.null y  -> Nothing+                                                  | otherwise -> Just (P.length x)++prop_replicate1BB c = forAll arbitrarySizedIntegral $ \n ->+                      P.unpack (P.replicate n c) == replicate n c+prop_replicate2BB c = forAll arbitrarySizedIntegral $ \n ->+                      P.replicate n c == fst (P.unfoldrN n (\u -> Just (u,u)) c)++prop_replicate3BB c = P.unpack (P.replicate 0 c) == replicate 0 c++prop_readintBB n = (fst . fromJust . C.readInt . C.pack . show) n == (n :: Int)+prop_readintLL n = (fst . fromJust . D.readInt . D.pack . show) n == (n :: Int)++prop_readBB x = (read . show) x == (x :: P.ByteString)+prop_readLL x = (read . show) x == (x :: L.ByteString)++prop_readint2BB s =+    let s' = filter (\c -> c `notElem` ['0'..'9']) s+    in C.readInt (C.pack s') == Nothing++prop_readintegerBB n = (fst . fromJust . C.readInteger . C.pack . show) n == (n :: Integer)+prop_readintegerLL n = (fst . fromJust . D.readInteger . D.pack . show) n == (n :: Integer)++prop_readinteger2BB s =+    let s' = filter (\c -> c `notElem` ['0'..'9']) s+    in C.readInteger (C.pack s') == Nothing++-- prop_filterChar1BB c xs = (filter (==c) xs) == ((C.unpack . C.filterChar c . C.pack) xs)+-- prop_filterChar2BB c xs = (C.filter (==c) (C.pack xs)) == (C.filterChar c (C.pack xs))+-- prop_filterChar3BB c xs = C.filterChar c xs == C.replicate (C.count c xs) c++-- prop_filterNotChar1BB c xs = (filter (/=c) xs) == ((C.unpack . C.filterNotChar c . C.pack) xs)+-- prop_filterNotChar2BB c xs = (C.filter (/=c) (C.pack xs)) == (C.filterNotChar c (C.pack xs))++-- prop_joinjoinpathBB xs ys c = C.joinWithChar c xs ys == C.join (C.singleton c) [xs,ys]++prop_zipBB  xs ys = zip xs ys == P.zip (P.pack xs) (P.pack ys)+prop_zipLC  xs ys = zip xs ys == LC.zip (LC.pack xs) (LC.pack ys)+prop_zip1BB xs ys = P.zip xs ys == zip (P.unpack xs) (P.unpack ys)++prop_zipWithBB xs ys = P.zipWith (,) xs ys == P.zip xs ys+prop_zipWithCC xs ys = C.zipWith (,) xs ys == C.zip xs ys+prop_zipWithLC xs ys = LC.zipWith (,) xs ys == LC.zip xs ys+-- prop_zipWith'BB xs ys = P.pack (P.zipWith (+) xs ys) == P.zipWith' (+) xs ys++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++-- prop_join_spec c s1 s2 =+--  P.join (P.singleton c) (s1 : s2 : []) == P.joinWithByte c s1 s2++-- prop_break_spec x s =+--     P.break ((==) x) s == P.breakByte x s++-- prop_span_spec x s =+--     P.span ((==) x) s == P.spanByte x s++------------------------------------------------------------------------++-- Test IsString, Show, Read, pack, unpack+prop_isstring x = C.unpack (fromString x :: C.ByteString) == x+prop_isstring_lc x = LC.unpack (fromString x :: LC.ByteString) == x++prop_showP1 x = show x == show (C.unpack x)+prop_showL1 x = show x == show (LC.unpack x)++prop_readP1 x = read (show x) == (x :: P.ByteString)+prop_readP2 x = read (show x) == C.pack (x :: String)++prop_readL1 x = read (show x) == (x :: L.ByteString)+prop_readL2 x = read (show x) == LC.pack (x :: String)++prop_packunpack_s x = (P.unpack . P.pack) x == x+prop_unpackpack_s x = (P.pack . P.unpack) x == x++prop_packunpack_c x = (C.unpack . C.pack) x == x+prop_unpackpack_c x = (C.pack . C.unpack) x == x++prop_packunpack_l x = (L.unpack . L.pack) x == x+prop_unpackpack_l x = (L.pack . L.unpack) x == x++prop_packunpack_lc x = (LC.unpack . LC.pack) x == x+prop_unpackpack_lc x = (LC.pack . LC.unpack) x == x++prop_toFromChunks x = (L.fromChunks . L.toChunks) x == x+prop_fromToChunks x = (L.toChunks . L.fromChunks) x == filter (not . P.null) x++prop_toFromStrict x = (L.fromStrict . L.toStrict) x == x+prop_fromToStrict x = (L.toStrict . L.fromStrict) x == x++prop_packUptoLenBytes cs =+    forAll (choose (0, length cs + 1)) $ \n ->+      let (bs, cs') = P.packUptoLenBytes n cs+       in P.length bs == min n (length cs)+       && take n cs == P.unpack bs+       && P.pack (take n cs) == bs+       && drop n cs == cs'++prop_packUptoLenChars cs =+    forAll (choose (0, length cs + 1)) $ \n ->+      let (bs, cs') = P.packUptoLenChars n cs+       in P.length bs == min n (length cs)+       && take n cs == C.unpack bs+       && C.pack (take n cs) == bs+       && drop n cs == cs'++prop_unpack_s cs =+    forAll (choose (0, length cs)) $ \n ->+      P.unpack (P.drop n $ P.pack cs) == drop n cs+prop_unpack_c cs =+    forAll (choose (0, length cs)) $ \n ->+      C.unpack (C.drop n $ C.pack cs) == drop n cs++prop_unpack_l  cs =+    forAll (choose (0, length cs)) $ \n ->+      L.unpack (L.drop (fromIntegral n) $ L.pack cs) == drop n cs+prop_unpack_lc cs =+    forAll (choose (0, length cs)) $ \n ->+      LC.unpack (L.drop (fromIntegral n) $ LC.pack cs) == drop n cs++prop_unpackBytes cs =+    forAll (choose (0, length cs)) $ \n ->+      P.unpackBytes (P.drop n $ P.pack cs) == drop n cs+prop_unpackChars cs =+    forAll (choose (0, length cs)) $ \n ->+      P.unpackChars (P.drop n $ C.pack cs) == drop n cs++prop_unpackBytes_l =+    forAll (sized $ \n -> resize (n * 10) arbitrary) $ \cs ->+    forAll (choose (0, length cs)) $ \n ->+      L.unpackBytes (L.drop (fromIntegral n) $ L.pack cs) == drop n cs+prop_unpackChars_l =+    forAll (sized $ \n -> resize (n * 10) arbitrary) $ \cs ->+    forAll (choose (0, length cs)) $ \n ->+      L.unpackChars (L.drop (fromIntegral n) $ LC.pack cs) == drop n cs++prop_unpackAppendBytesLazy cs' =+    forAll (sized $ \n -> resize (n * 10) arbitrary) $ \cs ->+    forAll (choose (0, 2)) $ \n ->+      P.unpackAppendBytesLazy (P.drop n $ P.pack cs) cs' == drop n cs ++ cs'+prop_unpackAppendCharsLazy cs' =+    forAll (sized $ \n -> resize (n * 10) arbitrary) $ \cs ->+    forAll (choose (0, 2)) $ \n ->+      P.unpackAppendCharsLazy (P.drop n $ C.pack cs) cs' == drop n cs ++ cs'++prop_unpackAppendBytesStrict cs cs' =+    forAll (choose (0, length cs)) $ \n ->+      P.unpackAppendBytesStrict (P.drop n $ P.pack cs) cs' == drop n cs ++ cs'++prop_unpackAppendCharsStrict cs cs' =+    forAll (choose (0, length cs)) $ \n ->+      P.unpackAppendCharsStrict (P.drop n $ C.pack cs) cs' == drop n cs ++ cs'++------------------------------------------------------------------------+-- Unsafe functions++-- Test unsafePackAddress+prop_unsafePackAddress (CByteString x) = unsafePerformIO $ do+        let (p,_,_) = P.toForeignPtr (x `P.snoc` 0)+        y <- withForeignPtr p $ \(Ptr addr) ->+            P.unsafePackAddress addr+        return (y == x)++-- Test unsafePackAddressLen+prop_unsafePackAddressLen x = unsafePerformIO $ do+        let i = P.length x+            (p,_,_) = P.toForeignPtr (x `P.snoc` 0)+        y <- withForeignPtr p $ \(Ptr addr) ->+            P.unsafePackAddressLen i addr+        return (y == x)++prop_unsafeUseAsCString x = unsafePerformIO $ do+        let n = P.length x+        y <- P.unsafeUseAsCString x $ \cstr ->+                    sequence [ do a <- peekElemOff cstr i+                                  let b = x `P.index` i+                                  return (a == fromIntegral b)+                             | i <- [0.. n-1]     ]+        return (and y)++prop_unsafeUseAsCStringLen x = unsafePerformIO $ do+        let n = P.length x+        y <- P.unsafeUseAsCStringLen x $ \(cstr,_) ->+                    sequence [ do a <- peekElemOff cstr i+                                  let b = x `P.index` i+                                  return (a == fromIntegral b)+                             | i <- [0.. n-1]     ]+        return (and y)++prop_internal_invariant x = L.invariant x++prop_useAsCString x = unsafePerformIO $ do+        let n = P.length x+        y <- P.useAsCString x $ \cstr ->+                    sequence [ do a <- peekElemOff cstr i+                                  let b = x `P.index` i+                                  return (a == fromIntegral b)+                             | i <- [0.. n-1]     ]+        return (and y)++prop_packCString (CByteString x) = unsafePerformIO $ do+        y <- P.useAsCString x $ P.unsafePackCString+        return (y == x)++prop_packCString_safe (CByteString x) = unsafePerformIO $ do+        y <- P.useAsCString x $ P.packCString+        return (y == x)++prop_packCStringLen x = unsafePerformIO $ do+        y <- P.useAsCStringLen x $ P.unsafePackCStringLen+        return (y == x && P.length y == P.length x)++prop_packCStringLen_safe x = unsafePerformIO $ do+        y <- P.useAsCStringLen x $ P.packCStringLen+        return (y == x && P.length y == P.length x)++prop_packMallocCString (CByteString x) = unsafePerformIO $ do++         let (fp,_,_) = P.toForeignPtr x+         ptr <- mallocArray0 (P.length x) :: IO (Ptr Word8)+         forM_ [0 .. P.length x] $ \n -> pokeElemOff ptr n 0+         withForeignPtr fp $ \qtr -> copyArray ptr qtr (P.length x)+         y   <- P.unsafePackMallocCString (castPtr ptr)++         let !z = y == x+         free ptr `seq` return z++prop_unsafeFinalize    x =+    P.length x > 0 ==>+      unsafePerformIO $ do+        x <- P.unsafeFinalize x+        return (x == ())++prop_packCStringFinaliser x = unsafePerformIO $ do+        y <- P.useAsCString x $ \cstr -> P.unsafePackCStringFinalizer (castPtr cstr) (P.length x) (return ())+        return (y == x)++prop_fromForeignPtr x = (let (a,b,c) = (P.toForeignPtr x)+                                in P.fromForeignPtr a b c) == x++------------------------------------------------------------------------+-- IO++prop_read_write_file_P x = unsafePerformIO $ do+    tid <- myThreadId+    let f = "qc-test-"++show tid+    bracket+        (do P.writeFile f x)+        (const $ do removeFile f)+        (const $ do y <- P.readFile f+                    return (x==y))++prop_read_write_file_C x = unsafePerformIO $ do+    tid <- myThreadId+    let f = "qc-test-"++show tid+    bracket+        (do C.writeFile f x)+        (const $ do removeFile f)+        (const $ do y <- C.readFile f+                    return (x==y))++prop_read_write_file_L x = unsafePerformIO $ do+    tid <- myThreadId+    let f = "qc-test-"++show tid+    bracket+        (do L.writeFile f x)+        (const $ do removeFile f)+        (const $ do y <- L.readFile f+                    return (x==y))++prop_read_write_file_D x = unsafePerformIO $ do+    tid <- myThreadId+    let f = "qc-test-"++show tid+    bracket+        (do D.writeFile f x)+        (const $ do removeFile f)+        (const $ do y <- D.readFile f+                    return (x==y))++------------------------------------------------------------------------++prop_append_file_P x y = unsafePerformIO $ do+    tid <- myThreadId+    let f = "qc-test-"++show tid+    bracket+        (do P.writeFile f x+            P.appendFile f y)+        (const $ do removeFile f)+        (const $ do z <- P.readFile f+                    return (z==(x `P.append` y)))++prop_append_file_C x y = unsafePerformIO $ do+    tid <- myThreadId+    let f = "qc-test-"++show tid+    bracket+        (do C.writeFile f x+            C.appendFile f y)+        (const $ do removeFile f)+        (const $ do z <- C.readFile f+                    return (z==(x `C.append` y)))++prop_append_file_L x y = unsafePerformIO $ do+    tid <- myThreadId+    let f = "qc-test-"++show tid+    bracket+        (do L.writeFile f x+            L.appendFile f y)+        (const $ do removeFile f)+        (const $ do z <- L.readFile f+                    return (z==(x `L.append` y)))++prop_append_file_D x y = unsafePerformIO $ do+    tid <- myThreadId+    let f = "qc-test-"++show tid+    bracket+        (do D.writeFile f x+            D.appendFile f y)+        (const $ do removeFile f)+        (const $ do z <- D.readFile f+                    return (z==(x `D.append` y)))++prop_packAddress = C.pack "this is a test" +            ==+                   C.pack "this is a test" ++prop_isSpaceWord8 (w :: Word8) = isSpace c == P.isSpaceChar8 c+   where c = chr (fromIntegral w)+ ++------------------------------------------------------------------------+-- The entry point++main :: IO ()+main = defaultMain tests++--+-- And now a list of all the properties to test.+--++tests = misc_tests+     ++ bl_tests+     ++ cc_tests+     ++ bp_tests+     ++ pl_tests+     ++ bb_tests+     ++ ll_tests+     ++ io_tests+     ++ rules++--+-- 'morally sound' IO+--+io_tests =+    [ testProperty "readFile.writeFile" prop_read_write_file_P+    , testProperty "readFile.writeFile" prop_read_write_file_C+    , testProperty "readFile.writeFile" prop_read_write_file_L+    , testProperty "readFile.writeFile" prop_read_write_file_D++    , testProperty "appendFile        " prop_append_file_P+    , testProperty "appendFile        " prop_append_file_C+    , testProperty "appendFile        " prop_append_file_L+    , testProperty "appendFile        " prop_append_file_D++    , testProperty "packAddress       " prop_packAddress++    ]++misc_tests =+    [ testProperty "packunpack"             prop_packunpack_s+    , testProperty "unpackpack"             prop_unpackpack_s+    , testProperty "packunpack"             prop_packunpack_c+    , testProperty "unpackpack"             prop_unpackpack_c+    , testProperty "packunpack"             prop_packunpack_l+    , testProperty "unpackpack"             prop_unpackpack_l+    , testProperty "packunpack"             prop_packunpack_lc+    , testProperty "unpackpack"             prop_unpackpack_lc+    , testProperty "unpack"                 prop_unpack_s+    , testProperty "unpack"                 prop_unpack_c+    , testProperty "unpack"                 prop_unpack_l+    , testProperty "unpack"                 prop_unpack_lc+    , testProperty "packUptoLenBytes"       prop_packUptoLenBytes+    , testProperty "packUptoLenChars"       prop_packUptoLenChars+    , testProperty "unpackBytes"            prop_unpackBytes+    , testProperty "unpackChars"            prop_unpackChars+    , testProperty "unpackBytes"            prop_unpackBytes_l+    , testProperty "unpackChars"            prop_unpackChars_l+    , testProperty "unpackAppendBytesLazy"  prop_unpackAppendBytesLazy+    , testProperty "unpackAppendCharsLazy"  prop_unpackAppendCharsLazy+    , testProperty "unpackAppendBytesStrict"prop_unpackAppendBytesStrict+    , testProperty "unpackAppendCharsStrict"prop_unpackAppendCharsStrict+    , testProperty "toFromChunks"           prop_toFromChunks+    , testProperty "fromToChunks"           prop_fromToChunks+    , testProperty "toFromStrict"           prop_toFromStrict+    , testProperty "fromToStrict"           prop_fromToStrict++    , testProperty "invariant"              prop_invariant+    , testProperty "unsafe pack address"    prop_unsafePackAddress+    , testProperty "unsafe pack address len"prop_unsafePackAddressLen+    , testProperty "unsafeUseAsCString"     prop_unsafeUseAsCString+    , testProperty "unsafeUseAsCStringLen"  prop_unsafeUseAsCStringLen+    , testProperty "useAsCString"           prop_useAsCString+    , testProperty "packCString"            prop_packCString+    , testProperty "packCString safe"       prop_packCString_safe+    , testProperty "packCStringLen"         prop_packCStringLen+    , testProperty "packCStringLen safe"    prop_packCStringLen_safe+    , testProperty "packCStringFinaliser"   prop_packCStringFinaliser+    , testProperty "packMallocString"       prop_packMallocCString+    , testProperty "unsafeFinalise"         prop_unsafeFinalize+    , testProperty "invariant"              prop_internal_invariant+    , testProperty "show 1"                 prop_showP1+    , testProperty "show 2"                 prop_showL1+    , testProperty "read 1"                 prop_readP1+    , testProperty "read 2"                 prop_readP2+    , testProperty "read 3"                 prop_readL1+    , testProperty "read 4"                 prop_readL2+    , testProperty "fromForeignPtr"         prop_fromForeignPtr+    ]++------------------------------------------------------------------------+-- ByteString.Lazy <=> List++bl_tests =+    [ testProperty "all"         prop_allBL+    , testProperty "any"         prop_anyBL+    , testProperty "append"      prop_appendBL+    , testProperty "compare"     prop_compareBL+    , testProperty "concat"      prop_concatBL+    , testProperty "cons"        prop_consBL+    , testProperty "eq"          prop_eqBL+    , testProperty "filter"      prop_filterBL+    , testProperty "find"        prop_findBL+    , testProperty "findIndex"   prop_findIndexBL+    , testProperty "findIndices" prop_findIndicesBL+    , testProperty "foldl"       prop_foldlBL+    , testProperty "foldl'"      prop_foldlBL'+    , testProperty "foldl1"      prop_foldl1BL+    , testProperty "foldl1'"     prop_foldl1BL'+    , testProperty "foldr"       prop_foldrBL+    , testProperty "foldr1"      prop_foldr1BL+    , testProperty "mapAccumL"   prop_mapAccumLBL+    , testProperty "mapAccumR"   prop_mapAccumRBL+    , testProperty "mapAccumR"   prop_mapAccumRDL+    , testProperty "mapAccumR"   prop_mapAccumRCC+    , testProperty "unfoldr"     prop_unfoldrBL+    , testProperty "unfoldr"     prop_unfoldrLC+    , testProperty "unfoldr"     prop_cycleLC+    , testProperty "iterate"     prop_iterateLC+    , testProperty "iterate"     prop_iterateLC_2+    , testProperty "iterate"     prop_iterateL+    , testProperty "repeat"      prop_repeatLC+    , testProperty "repeat"      prop_repeatL+    , testProperty "head"        prop_headBL+    , testProperty "init"        prop_initBL+    , testProperty "isPrefixOf"  prop_isPrefixOfBL+    , testProperty "last"        prop_lastBL+    , testProperty "length"      prop_lengthBL+    , testProperty "map"         prop_mapBL+    , testProperty "maximum"     prop_maximumBL+    , testProperty "minimum"     prop_minimumBL+    , testProperty "null"        prop_nullBL+    , testProperty "reverse"     prop_reverseBL+    , testProperty "snoc"        prop_snocBL+    , testProperty "tail"        prop_tailBL+    , testProperty "transpose"   prop_transposeBL+    , testProperty "replicate"   prop_replicateBL+    , testProperty "take"        prop_takeBL+    , testProperty "drop"        prop_dropBL+    , testProperty "splitAt"     prop_splitAtBL+    , testProperty "takeWhile"   prop_takeWhileBL+    , testProperty "dropWhile"   prop_dropWhileBL+    , testProperty "break"       prop_breakBL+    , testProperty "span"        prop_spanBL+    , testProperty "group"       prop_groupBL+    , testProperty "groupBy"     prop_groupByBL+    , testProperty "inits"       prop_initsBL+    , testProperty "tails"       prop_tailsBL+    , testProperty "elem"        prop_elemBL+    , testProperty "notElem"     prop_notElemBL+    , testProperty "lines"       prop_linesBL+    , testProperty "elemIndex"   prop_elemIndexBL+    , testProperty "elemIndices" prop_elemIndicesBL+    , testProperty "concatMap"   prop_concatMapBL+    ]++------------------------------------------------------------------------+-- ByteString.Lazy <=> ByteString++cc_tests =+    [ testProperty "prop_concatCC"      prop_concatCC+    , testProperty "prop_nullCC"        prop_nullCC+    , testProperty "prop_reverseCC"     prop_reverseCC+    , testProperty "prop_transposeCC"   prop_transposeCC+    , testProperty "prop_groupCC"       prop_groupCC+    , testProperty "prop_groupByCC"     prop_groupByCC+    , testProperty "prop_initsCC"       prop_initsCC+    , testProperty "prop_tailsCC"       prop_tailsCC+    , testProperty "prop_allCC"         prop_allCC+    , testProperty "prop_anyCC"         prop_anyCC+    , testProperty "prop_appendCC"      prop_appendCC+    , testProperty "prop_breakCC"       prop_breakCC+    , testProperty "prop_concatMapCC"   prop_concatMapCC+    , testProperty "prop_consCC"        prop_consCC+    , testProperty "prop_consCC'"       prop_consCC'+    , testProperty "prop_unconsCC"      prop_unconsCC+    , testProperty "prop_countCC"       prop_countCC+    , testProperty "prop_dropCC"        prop_dropCC+    , testProperty "prop_dropWhileCC"   prop_dropWhileCC+    , testProperty "prop_filterCC"      prop_filterCC+    , testProperty "prop_findCC"        prop_findCC+    , testProperty "prop_findIndexCC"   prop_findIndexCC+    , testProperty "prop_findIndicesCC" prop_findIndicesCC+    , testProperty "prop_isPrefixOfCC"  prop_isPrefixOfCC+    , testProperty "prop_mapCC"         prop_mapCC+    , testProperty "prop_replicateCC"   prop_replicateCC+    , testProperty "prop_snocCC"        prop_snocCC+    , testProperty "prop_spanCC"        prop_spanCC+    , testProperty "prop_splitCC"       prop_splitCC+    , testProperty "prop_splitAtCC"     prop_splitAtCC+    , testProperty "prop_takeCC"        prop_takeCC+    , testProperty "prop_takeWhileCC"   prop_takeWhileCC+    , testProperty "prop_elemCC"        prop_elemCC+    , testProperty "prop_notElemCC"     prop_notElemCC+    , testProperty "prop_elemIndexCC"   prop_elemIndexCC+    , testProperty "prop_elemIndicesCC" prop_elemIndicesCC+    , testProperty "prop_lengthCC"      prop_lengthCC+    , testProperty "prop_headCC"        prop_headCC+    , testProperty "prop_initCC"        prop_initCC+    , testProperty "prop_lastCC"        prop_lastCC+    , testProperty "prop_maximumCC"     prop_maximumCC+    , testProperty "prop_minimumCC"     prop_minimumCC+    , testProperty "prop_tailCC"        prop_tailCC+    , testProperty "prop_foldl1CC"      prop_foldl1CC+    , testProperty "prop_foldl1CC'"     prop_foldl1CC'+    , testProperty "prop_foldr1CC"      prop_foldr1CC+    , testProperty "prop_foldr1CC'"     prop_foldr1CC'+    , testProperty "prop_scanlCC"       prop_scanlCC+    , testProperty "prop_intersperseCC" prop_intersperseCC++    , testProperty "prop_foldlCC"       prop_foldlCC+    , testProperty "prop_foldlCC'"      prop_foldlCC'+    , testProperty "prop_foldrCC"       prop_foldrCC+    , testProperty "prop_foldrCC'"      prop_foldrCC'+    , testProperty "prop_mapAccumLCC"   prop_mapAccumLCC+--    , testProperty "prop_mapIndexedCC" prop_mapIndexedCC+--    , testProperty "prop_mapIndexedPL" prop_mapIndexedPL+    ]++bp_tests =+    [ testProperty "all"         prop_allBP+    , testProperty "any"         prop_anyBP+    , testProperty "append"      prop_appendBP+    , testProperty "compare"     prop_compareBP+    , testProperty "concat"      prop_concatBP+    , testProperty "cons"        prop_consBP+    , testProperty "cons'"       prop_consBP'+    , testProperty "uncons"      prop_unconsBP+    , testProperty "eq"          prop_eqBP+    , testProperty "filter"      prop_filterBP+    , testProperty "find"        prop_findBP+    , testProperty "findIndex"   prop_findIndexBP+    , testProperty "findIndices" prop_findIndicesBP+    , testProperty "foldl"       prop_foldlBP+    , testProperty "foldl'"      prop_foldlBP'+    , testProperty "foldl1"      prop_foldl1BP+    , testProperty "foldl1'"     prop_foldl1BP'+    , testProperty "foldr"       prop_foldrBP+    , testProperty "foldr'"      prop_foldrBP'+    , testProperty "foldr1"      prop_foldr1BP+    , testProperty "foldr1'"     prop_foldr1BP'+    , testProperty "mapAccumL"   prop_mapAccumLBP+--  , testProperty "mapAccumL"   prop_mapAccumL_mapIndexedBP+    , testProperty "unfoldr"     prop_unfoldrBP+    , testProperty "unfoldr 2"   prop_unfoldr2BP+    , testProperty "unfoldr 2"   prop_unfoldr2CP+    , testProperty "head"        prop_headBP+    , testProperty "init"        prop_initBP+    , testProperty "isPrefixOf"  prop_isPrefixOfBP+    , testProperty "last"        prop_lastBP+    , testProperty "length"      prop_lengthBP+    , testProperty "readInt"     prop_readIntBP+    , testProperty "lines"       prop_linesBP+    , testProperty "lines \\n"   prop_linesNLBP+    , testProperty "map"         prop_mapBP+    , testProperty "maximum   "  prop_maximumBP+    , testProperty "minimum"     prop_minimumBP+    , testProperty "null"        prop_nullBP+    , testProperty "reverse"     prop_reverseBP+    , testProperty "snoc"        prop_snocBP+    , testProperty "tail"        prop_tailBP+    , testProperty "scanl"       prop_scanlBP+    , testProperty "transpose"   prop_transposeBP+    , testProperty "replicate"   prop_replicateBP+    , testProperty "take"        prop_takeBP+    , testProperty "drop"        prop_dropBP+    , testProperty "splitAt"     prop_splitAtBP+    , testProperty "takeWhile"   prop_takeWhileBP+    , testProperty "dropWhile"   prop_dropWhileBP+    , testProperty "break"       prop_breakBP+    , testProperty "span"        prop_spanBP+    , testProperty "split"       prop_splitBP+    , testProperty "count"       prop_countBP+    , testProperty "group"       prop_groupBP+    , testProperty "groupBy"     prop_groupByBP+    , testProperty "inits"       prop_initsBP+    , testProperty "tails"       prop_tailsBP+    , testProperty "elem"        prop_elemBP+    , testProperty "notElem"     prop_notElemBP+    , testProperty "elemIndex"   prop_elemIndexBP+    , testProperty "elemIndices" prop_elemIndicesBP+    , testProperty "intersperse" prop_intersperseBP+    , testProperty "concatMap"   prop_concatMapBP+    ]++------------------------------------------------------------------------+-- ByteString <=> List++pl_tests =+    [ testProperty "all"         prop_allPL+    , testProperty "any"         prop_anyPL+    , testProperty "append"      prop_appendPL+    , testProperty "compare"     prop_comparePL+    , testProperty "concat"      prop_concatPL+    , testProperty "cons"        prop_consPL+    , testProperty "eq"          prop_eqPL+    , testProperty "filter"      prop_filterPL+    , testProperty "filter rules"prop_filterPL_rule+    , testProperty "filter rules"prop_filterLC_rule+    , testProperty "partition"   prop_partitionPL+    , testProperty "partition"   prop_partitionLL+    , testProperty "find"        prop_findPL+    , testProperty "findIndex"   prop_findIndexPL+    , testProperty "findIndices" prop_findIndicesPL+    , testProperty "foldl"       prop_foldlPL+    , testProperty "foldl'"      prop_foldlPL'+    , testProperty "foldl1"      prop_foldl1PL+    , testProperty "foldl1'"     prop_foldl1PL'+    , testProperty "foldr1"      prop_foldr1PL+    , testProperty "foldr"       prop_foldrPL+    , testProperty "mapAccumL"   prop_mapAccumLPL+    , testProperty "mapAccumR"   prop_mapAccumRPL+    , testProperty "unfoldr"     prop_unfoldrPL+    , testProperty "scanl"       prop_scanlPL+    , testProperty "scanl1"      prop_scanl1PL+    , testProperty "scanl1"      prop_scanl1CL+    , testProperty "scanr"       prop_scanrCL+    , testProperty "scanr"       prop_scanrPL+    , testProperty "scanr1"      prop_scanr1PL+    , testProperty "scanr1"      prop_scanr1CL+    , testProperty "head"        prop_headPL+    , testProperty "init"        prop_initPL+    , testProperty "last"        prop_lastPL+    , testProperty "maximum"     prop_maximumPL+    , testProperty "minimum"     prop_minimumPL+    , testProperty "tail"        prop_tailPL+    , testProperty "zip"         prop_zipPL+    , testProperty "zip"         prop_zipLL+    , testProperty "zip"         prop_zipCL+    , testProperty "unzip"       prop_unzipPL+    , testProperty "unzip"       prop_unzipLL+    , testProperty "unzip"       prop_unzipCL+    , testProperty "zipWith"          prop_zipWithPL+--  , testProperty "zipWith"          prop_zipWithCL+    , testProperty "zipWith rules"   prop_zipWithPL_rules+--  , testProperty "zipWith/zipWith'" prop_zipWithPL'++    , testProperty "isPrefixOf"  prop_isPrefixOfPL+    , testProperty "isInfixOf"   prop_isInfixOfPL+    , testProperty "length"      prop_lengthPL+    , testProperty "map"         prop_mapPL+    , testProperty "null"        prop_nullPL+    , testProperty "reverse"     prop_reversePL+    , testProperty "snoc"        prop_snocPL+    , testProperty "transpose"   prop_transposePL+    , testProperty "replicate"   prop_replicatePL+    , testProperty "take"        prop_takePL+    , testProperty "drop"        prop_dropPL+    , testProperty "splitAt"     prop_splitAtPL+    , testProperty "takeWhile"   prop_takeWhilePL+    , testProperty "dropWhile"   prop_dropWhilePL+    , testProperty "break"       prop_breakPL+    , testProperty "span"        prop_spanPL+    , testProperty "group"       prop_groupPL+    , testProperty "groupBy"     prop_groupByPL+    , testProperty "inits"       prop_initsPL+    , testProperty "tails"       prop_tailsPL+    , testProperty "elem"        prop_elemPL+    , testProperty "notElem"     prop_notElemPL+    , testProperty "lines"       prop_linesPL+    , testProperty "elemIndex"   prop_elemIndexPL+    , testProperty "elemIndex"   prop_elemIndexCL+    , testProperty "elemIndices" prop_elemIndicesPL+    , testProperty "concatMap"   prop_concatMapPL+    , testProperty "IsString"    prop_isstring+    , testProperty "IsString LC" prop_isstring_lc+    ]++------------------------------------------------------------------------+-- extra ByteString properties++bb_tests =+    [ testProperty "bijection"      prop_bijectionBB+    , testProperty "bijection'"     prop_bijectionBB'+    , testProperty "pack/unpack"    prop_packunpackBB+    , testProperty "unpack/pack"    prop_packunpackBB'+    , testProperty "eq 1"           prop_eq1BB+    , testProperty "eq 2"           prop_eq2BB+    , testProperty "eq 3"           prop_eq3BB+    , testProperty "compare 1"      prop_compare1BB+    , testProperty "compare 2"      prop_compare2BB+    , testProperty "compare 3"      prop_compare3BB+    , testProperty "compare 4"      prop_compare4BB+    , testProperty "compare 5"      prop_compare5BB+    , testProperty "compare 6"      prop_compare6BB+    , testProperty "compare 7"      prop_compare7BB+    , testProperty "compare 7"      prop_compare7LL+    , testProperty "compare 8"      prop_compare8BB+    , testProperty "empty 1"        prop_nil1BB+    , testProperty "empty 2"        prop_nil2BB+    , testProperty "empty 1 monoid" prop_nil1LL_monoid+    , testProperty "empty 2 monoid" prop_nil2LL_monoid+    , testProperty "empty 1 monoid" prop_nil1BB_monoid+    , testProperty "empty 2 monoid" prop_nil2BB_monoid++    , testProperty "null"           prop_nullBB+    , testProperty "length 1"       prop_lengthBB+    , testProperty "length 2"       prop_lengthSBB+    , testProperty "cons 1"         prop_consBB+    , testProperty "cons 2"         prop_cons1BB+    , testProperty "cons 3"         prop_cons2BB+    , testProperty "cons 4"         prop_cons3BB+    , testProperty "cons 5"         prop_cons4BB+    , testProperty "snoc"           prop_snoc1BB+    , testProperty "head 1"         prop_head1BB+    , testProperty "head 2"         prop_head2BB+    , testProperty "head 3"         prop_head3BB+    , testProperty "tail"           prop_tailBB+    , testProperty "tail 1"         prop_tail1BB+    , testProperty "last"           prop_lastBB+    , testProperty "init"           prop_initBB+    , testProperty "append 1"       prop_append1BB+    , testProperty "append 2"       prop_append2BB+    , testProperty "append 3"       prop_append3BB+    , testProperty "mappend 1"      prop_append1BB_monoid+    , testProperty "mappend 2"      prop_append2BB_monoid+    , testProperty "mappend 3"      prop_append3BB_monoid++    , testProperty "map 1"          prop_map1BB+    , testProperty "map 2"          prop_map2BB+    , testProperty "map 3"          prop_map3BB+    , testProperty "filter1"        prop_filter1BB+    , testProperty "filter2"        prop_filter2BB+    , testProperty "map fusion"     prop_mapfusionBB+    , testProperty "filter fusion"  prop_filterfusionBB+    , testProperty "reverse 1"      prop_reverse1BB+    , testProperty "reverse 2"      prop_reverse2BB+    , testProperty "reverse 3"      prop_reverse3BB+    , testProperty "foldl 1"        prop_foldl1BB+    , testProperty "foldl 2"        prop_foldl2BB+    , testProperty "foldr 1"        prop_foldr1BB+    , testProperty "foldr 2"        prop_foldr2BB+    , testProperty "foldl1 1"       prop_foldl1_1BB+    , testProperty "foldl1 2"       prop_foldl1_2BB+    , testProperty "foldl1 3"       prop_foldl1_3BB+    , testProperty "foldr1 1"       prop_foldr1_1BB+    , testProperty "foldr1 2"       prop_foldr1_2BB+    , testProperty "foldr1 3"       prop_foldr1_3BB+    , testProperty "scanl/foldl"    prop_scanlfoldlBB+    , testProperty "all"            prop_allBB+    , testProperty "any"            prop_anyBB+    , testProperty "take"           prop_takeBB+    , testProperty "drop"           prop_dropBB+    , testProperty "takeWhile"      prop_takeWhileBB+    , testProperty "dropWhile"      prop_dropWhileBB+    , testProperty "dropWhile"      prop_dropWhileCC_isSpace+    , testProperty "splitAt"        prop_splitAtBB+    , testProperty "span"           prop_spanBB+    , testProperty "break"          prop_breakBB+    , testProperty "elem"           prop_elemBB+    , testProperty "notElem"        prop_notElemBB++    , testProperty "concat 1"       prop_concat1BB+    , testProperty "concat 2"       prop_concat2BB+    , testProperty "concat 3"       prop_concatBB+    , testProperty "mconcat 1"      prop_concat1BB_monoid+    , testProperty "mconcat 2"      prop_concat2BB_monoid+    , testProperty "mconcat 3"      prop_concatBB_monoid++    , testProperty "mconcat 1"      prop_concat1LL_monoid+    , testProperty "mconcat 2"      prop_concat2LL_monoid+    , testProperty "mconcat 3"      prop_concatLL_monoid++    , testProperty "lines"          prop_linesBB+    , testProperty "unlines"        prop_unlinesBB+    , testProperty "unlines"        prop_unlinesLC+    , testProperty "words"          prop_wordsBB+    , testProperty "words"          prop_wordsLC+    , testProperty "unwords"        prop_unwordsBB+    , testProperty "group"          prop_groupBB+    , testProperty "groupBy 0"      prop_groupByBB+    , testProperty "groupBy 1"      prop_groupBy1CC+    , testProperty "groupBy 2"      prop_groupBy1BB+    , testProperty "groupBy 3"      prop_groupBy2CC+    , testProperty "join"           prop_joinBB+    , testProperty "elemIndex 1"    prop_elemIndex1BB+    , testProperty "elemIndex 2"    prop_elemIndex2BB+    , testProperty "findIndex"      prop_findIndexBB+    , testProperty "findIndicies"   prop_findIndiciesBB+    , testProperty "elemIndices"    prop_elemIndicesBB+    , testProperty "find"           prop_findBB+    , testProperty "find/findIndex" prop_find_findIndexBB+    , testProperty "sort 1"         prop_sort1BB+    , testProperty "sort 2"         prop_sort2BB+    , testProperty "sort 3"         prop_sort3BB+    , testProperty "sort 4"         prop_sort4BB+    , testProperty "sort 5"         prop_sort5BB+    , testProperty "intersperse"    prop_intersperseBB+    , testProperty "maximum"        prop_maximumBB+    , testProperty "minimum"        prop_minimumBB+--  , testProperty "breakChar"      prop_breakCharBB+--  , testProperty "spanChar 1"     prop_spanCharBB+--  , testProperty "spanChar 2"     prop_spanChar_1BB+--  , testProperty "breakSpace"     prop_breakSpaceBB+--  , testProperty "dropSpace"      prop_dropSpaceBB+    , testProperty "spanEnd"        prop_spanEndBB+    , testProperty "breakEnd"       prop_breakEndBB+    , testProperty "breakEnd"       prop_breakEndCC+    , testProperty "elemIndexEnd 1" prop_elemIndexEnd1BB+    , testProperty "elemIndexEnd 1" prop_elemIndexEnd1CC+    , testProperty "elemIndexEnd 2" prop_elemIndexEnd2BB+--  , testProperty "words'"         prop_wordsBB'+--  , testProperty "lines'"         prop_linesBB'+--  , testProperty "dropSpaceEnd"   prop_dropSpaceEndBB+    , testProperty "unfoldr"        prop_unfoldrBB+    , testProperty "prefix"         prop_prefixBB+    , testProperty "suffix"         prop_suffixBB+    , testProperty "suffix"         prop_suffixLL+    , testProperty "copy"           prop_copyBB+    , testProperty "copy"           prop_copyLL+    , testProperty "inits"          prop_initsBB+    , testProperty "tails"          prop_tailsBB+    , testProperty "findSubstrings "prop_findSubstringsBB+    , testProperty "findSubstring "prop_findSubstringBB+    , testProperty "breakSubstring 1"prop_breakSubstringBB+    , testProperty "breakSubstring 2"prop_breakSubstring_findSubstring+    , testProperty "breakSubstring 3"prop_breakSubstring_isInfixOf++    , testProperty "replicate1"     prop_replicate1BB+    , testProperty "replicate2"     prop_replicate2BB+    , testProperty "replicate3"     prop_replicate3BB+    , testProperty "readInt"        prop_readintBB+    , testProperty "readInt 2"      prop_readint2BB+    , testProperty "readInteger"    prop_readintegerBB+    , testProperty "readInteger 2"  prop_readinteger2BB+    , testProperty "read"           prop_readLL+    , testProperty "read"           prop_readBB+    , testProperty "Lazy.readInt"   prop_readintLL+    , testProperty "Lazy.readInt"   prop_readintLL+    , testProperty "Lazy.readInteger" prop_readintegerLL+    , testProperty "mconcat 1"      prop_append1LL_monoid+    , testProperty "mconcat 2"      prop_append2LL_monoid+    , testProperty "mconcat 3"      prop_append3LL_monoid+--  , testProperty "filterChar1"    prop_filterChar1BB+--  , testProperty "filterChar2"    prop_filterChar2BB+--  , testProperty "filterChar3"    prop_filterChar3BB+--  , testProperty "filterNotChar1" prop_filterNotChar1BB+--  , testProperty "filterNotChar2" prop_filterNotChar2BB+    , testProperty "tail"           prop_tailSBB+    , testProperty "index"          prop_indexBB+    , testProperty "unsafeIndex"    prop_unsafeIndexBB+--  , testProperty "map'"           prop_mapBB'+    , testProperty "filter"         prop_filterBB+    , testProperty "elem"           prop_elemSBB+    , testProperty "take"           prop_takeSBB+    , testProperty "drop"           prop_dropSBB+    , testProperty "splitAt"        prop_splitAtSBB+    , testProperty "foldl"          prop_foldlBB+    , testProperty "foldr"          prop_foldrBB+    , testProperty "takeWhile "     prop_takeWhileSBB+    , testProperty "dropWhile "     prop_dropWhileSBB+    , testProperty "span "          prop_spanSBB+    , testProperty "break "         prop_breakSBB+    , testProperty "breakspan"      prop_breakspan_1BB+    , testProperty "lines "         prop_linesSBB+    , testProperty "unlines "       prop_unlinesSBB+    , testProperty "words "         prop_wordsSBB+    , testProperty "unwords "       prop_unwordsSBB+    , testProperty "unwords "       prop_unwordsSLC+--     , testProperty "wordstokens"    prop_wordstokensBB+    , testProperty "splitWith"      prop_splitWithBB+    , testProperty "joinsplit"      prop_joinsplitBB+    , testProperty "intercalate"    prop_intercalatePL+--     , testProperty "lineIndices"    prop_lineIndices1BB+    , testProperty "count"          prop_countBB+--  , testProperty "linessplit"     prop_linessplit2BB+    , testProperty "splitsplitWith" prop_splitsplitWithBB+--  , testProperty "joinjoinpath"   prop_joinjoinpathBB+    , testProperty "zip"            prop_zipBB+    , testProperty "zip"            prop_zipLC+    , testProperty "zip1"           prop_zip1BB+    , testProperty "zipWith"        prop_zipWithBB+    , testProperty "zipWith"        prop_zipWithCC+    , testProperty "zipWith"        prop_zipWithLC+--  , testProperty "zipWith'"       prop_zipWith'BB+    , testProperty "unzip"          prop_unzipBB+    , testProperty "concatMap"      prop_concatMapBB+--  , testProperty "join/joinByte"  prop_join_spec+--  , 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+    ]++-}+++------------------------------------------------------------------------+-- Extra lazy properties++ll_tests =+    [ testProperty "eq 1"               prop_eq1+    , testProperty "eq 2"               prop_eq2+    , testProperty "eq 3"               prop_eq3+    , testProperty "eq refl"            prop_eq_refl+    , testProperty "eq symm"            prop_eq_symm+    , testProperty "compare 1"          prop_compare1+    , testProperty "compare 2"          prop_compare2+    , testProperty "compare 3"          prop_compare3+    , testProperty "compare 4"          prop_compare4+    , testProperty "compare 5"          prop_compare5+    , testProperty "compare 6"          prop_compare6+    , testProperty "compare 7"          prop_compare7+    , testProperty "compare 8"          prop_compare8+    , testProperty "empty 1"            prop_empty1+    , testProperty "empty 2"            prop_empty2+    , testProperty "pack/unpack"        prop_packunpack+    , testProperty "unpack/pack"        prop_unpackpack+    , testProperty "null"               prop_null+    , testProperty "length 1"           prop_length1+    , testProperty "length 2"           prop_length2+    , testProperty "cons 1"             prop_cons1+    , testProperty "cons 2"             prop_cons2+    , testProperty "cons 3"             prop_cons3+    , testProperty "cons 4"             prop_cons4+    , testProperty "snoc"               prop_snoc1+    , testProperty "head/pack"          prop_head+    , testProperty "head/unpack"        prop_head1+    , testProperty "tail/pack"          prop_tail+    , testProperty "tail/unpack"        prop_tail1+    , testProperty "last"               prop_last+    , testProperty "init"               prop_init+    , testProperty "append 1"           prop_append1+    , testProperty "append 2"           prop_append2+    , testProperty "append 3"           prop_append3+    , testProperty "map 1"              prop_map1+    , testProperty "map 2"              prop_map2+    , testProperty "map 3"              prop_map3+    , testProperty "filter 1"           prop_filter1+    , testProperty "filter 2"           prop_filter2+    , testProperty "reverse"            prop_reverse+    , testProperty "reverse1"           prop_reverse1+    , testProperty "reverse2"           prop_reverse2+    , testProperty "transpose"          prop_transpose+    , testProperty "foldl"              prop_foldl+    , testProperty "foldl/reverse"      prop_foldl_1+    , testProperty "foldr"              prop_foldr+    , testProperty "foldr/id"           prop_foldr_1+    , testProperty "foldl1/foldl"       prop_foldl1_1+    , testProperty "foldl1/head"        prop_foldl1_2+    , testProperty "foldl1/tail"        prop_foldl1_3+    , testProperty "foldr1/foldr"       prop_foldr1_1+    , testProperty "foldr1/last"        prop_foldr1_2+    , testProperty "foldr1/head"        prop_foldr1_3+    , testProperty "concat 1"           prop_concat1+    , testProperty "concat 2"           prop_concat2+    , testProperty "concat/pack"        prop_concat3+    , testProperty "any"                prop_any+    , testProperty "all"                prop_all+    , testProperty "maximum"            prop_maximum+    , testProperty "minimum"            prop_minimum+    , testProperty "replicate 1"        prop_replicate1+    , testProperty "replicate 2"        prop_replicate2+    , testProperty "take"               prop_take1+    , testProperty "drop"               prop_drop1+    , testProperty "splitAt"            prop_drop1+    , testProperty "takeWhile"          prop_takeWhile+    , testProperty "dropWhile"          prop_dropWhile+    , testProperty "break"              prop_break+    , testProperty "span"               prop_span+    , testProperty "splitAt"            prop_splitAt+    , testProperty "break/span"         prop_breakspan+--  , testProperty "break/breakByte"    prop_breakByte+--  , testProperty "span/spanByte"      prop_spanByte+    , testProperty "split"              prop_split+    , testProperty "splitWith"          prop_splitWith+    , testProperty "splitWith"          prop_splitWith_D+    , testProperty "splitWith"          prop_splitWith_C+    , testProperty "join.split/id"      prop_joinsplit+--  , testProperty "join/joinByte"      prop_joinjoinByte+    , testProperty "group"              prop_group+    , testProperty "groupBy"            prop_groupBy+    , testProperty "groupBy"            prop_groupBy_LC+    , testProperty "index"              prop_index+    , testProperty "index"              prop_index_D+    , testProperty "index"              prop_index_C+    , testProperty "elemIndex"          prop_elemIndex+    , testProperty "elemIndices"        prop_elemIndices+    , testProperty "count/elemIndices"  prop_count+    , testProperty "findIndex"          prop_findIndex+    , testProperty "findIndices"        prop_findIndicies+    , testProperty "find"               prop_find+    , testProperty "find/findIndex"     prop_find_findIndex+    , testProperty "elem"               prop_elem+    , testProperty "notElem"            prop_notElem+    , testProperty "elem/notElem"       prop_elem_notelem+--  , testProperty "filterByte 1"       prop_filterByte+--  , testProperty "filterByte 2"       prop_filterByte2+--  , testProperty "filterNotByte 1"    prop_filterNotByte+--  , testProperty "filterNotByte 2"    prop_filterNotByte2+    , testProperty "isPrefixOf"         prop_isPrefixOf+    , testProperty "concatMap"          prop_concatMap+    , testProperty "isSpace"            prop_isSpaceWord8     ]
+ tests/builder/TestSuite.hs view
@@ -0,0 +1,21 @@+module Main where++--import           Test.Framework (defaultMain, Test, testGroup)++import qualified Data.ByteString.Lazy.Builder.BasicEncoding.Tests+import qualified Data.ByteString.Lazy.Builder.Tests+import           TestFramework+++main :: IO ()+main = defaultMain tests++tests :: [Test]+tests =+  [ testGroup "Data.ByteString.Lazy.Builder"+       Data.ByteString.Lazy.Builder.Tests.tests++  , testGroup "Data.ByteString.Lazy.Builder.BasicEncoding"+       Data.ByteString.Lazy.Builder.BasicEncoding.Tests.tests+  ]+