iteratee 0.8.9.1 → 0.8.9.3
raw patch · 10 files changed
+717/−341 lines, 10 filesdep +MonadCatchIO-mtldep +criteriondep +deepseqdep −HUnitdep −QuickCheckdep −test-frameworkdep ~ListLikedep ~bytestringdep ~monad-control
Dependencies added: MonadCatchIO-mtl, criterion, deepseq, iteratee
Dependencies removed: HUnit, QuickCheck, test-framework, test-framework-hunit, test-framework-quickcheck2
Dependency ranges changed: ListLike, bytestring, monad-control, mtl, transformers, transformers-base
Files
- bench/BenchAll.hs +7/−0
- bench/BenchBase.hs +239/−0
- bench/BenchIO.hs +80/−0
- iteratee.cabal +57/−21
- src/Data/Iteratee/Base.hs +4/−3
- src/Data/Iteratee/ListLike.hs +1/−3
- tests/benchmarkHandle.hs +0/−75
- tests/benchmarks.hs +0/−239
- tests/fusion.hs +95/−0
- tests/fusion2.hs +234/−0
+ bench/BenchAll.hs view
@@ -0,0 +1,7 @@+module Main where++import Criterion.Main+import BenchBase (allByteStringBenches)+import BenchIO (ioBenches)++main = defaultMain (allByteStringBenches: ioBenches)
+ bench/BenchBase.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE RankNTypes, KindSignatures, NoMonomorphismRestriction #-}++-- some basic benchmarking of iteratee++module BenchBase where++import Data.Iteratee+import qualified Data.Iteratee.ListLike as I+import qualified Data.Iteratee.Parallel as I+import qualified Data.Iteratee.Binary as I+import Data.Iteratee.ListLike (enumPureNChunk, stream2list, stream2stream)+import Data.Word+import Data.Monoid+import qualified Data.ByteString as BS+import Control.Applicative+import Control.DeepSeq+import Control.Monad.Identity+import Control.Monad+import qualified Data.ListLike as LL++import Criterion.Main++main = defaultMain [allListBenches, allByteStringBenches]++-- -------------------------------------------------------------+-- helper functions and data++-- |Hold information about a benchmark. This allows each+-- benchmark (and baseline) to be created independently of the stream types,+-- for easy comparison of different streams.+-- BDList is for creating baseline comparison functions. Although the name+-- is BDList, it will work for any stream type (e.g. bytestrings).+data BD a b s (m :: * -> *) = BDIter1 String (a -> b) (Iteratee s m a) + | BDIterN String Int (a -> b) (Iteratee s m a)+ | BDList String (s -> b) s++id1 name i = BDIter1 name id i+idN name i = BDIterN name 5 id i+idNx name sz i = BDIterN name sz id i+idNl name i = BDIterN name 1000 id i++defTotalSize = 10000++makeList name f = BDList name f [1..defTotalSize]++makeBench :: BD n eval [Int] Identity -> Benchmark+makeBench (BDIter1 n eval i) = bench n $+ proc eval runIdentity (enumPure1Chunk [1..defTotalSize]) i+makeBench (BDIterN n csize eval i) = bench n $+ proc eval runIdentity (enumPureNChunk [1..defTotalSize] csize) i+makeBench (BDList n f l) = bench n $ whnf f l++packedBS :: BS.ByteString+packedBS = (BS.pack [1..defTotalSize])++makeBenchBS (BDIter1 n eval i) = bench n $+ proc eval runIdentity (enumPure1Chunk packedBS) i+makeBenchBS (BDIterN n csize eval i) = bench n $+ proc eval runIdentity (enumPureNChunk packedBS csize) i+makeBenchBS (BDList n f l) = error "makeBenchBS can't be called on BDList"++proc :: (Functor m, Monad m)+ => (a -> b) --function to force evaluation of result+ -> (m a -> a)+ -> I.Enumerator s m a+ -> I.Iteratee s m a+ -> Pure+proc eval runner enum iter = whnf (eval . runner . (I.run <=< enum)) iter++-- -------------------------------------------------------------+-- benchmark groups+makeGroup n = bgroup n . map makeBench++makeGroupBS :: String -> [BD t t1 BS.ByteString Identity] -> Benchmark+makeGroupBS n = bgroup n . map makeBenchBS++listbench = makeGroup "stream2List" (slistBenches :: [BD [Int] () [Int] Identity])+streambench = makeGroup "stream" (streamBenches :: [BD [Int] () [Int] Identity])+breakbench = makeGroup "break" $ break0 : break0' : breakBenches+headsbench = makeGroup "heads" headsBenches+dropbench = makeGroup "drop" $ drop0 : dropBenches+zipbench = makeGroup "zip" $ zipBenches+consbench = makeGroup "consumed" consBenches+lengthbench = makeGroup "length" listBenches+takebench = makeGroup "take" $ take0 : takeBenches+takeUpTobench = makeGroup "takeUpTo" takeUpToBenches+groupbench = makeGroup "group" groupBenches+mapbench = makeGroup "map" $ mapBenches+foldbench = makeGroup "fold" $ foldBenches+convbench = makeGroup "convStream" convBenches+miscbench = makeGroup "other" miscBenches++listbenchbs = makeGroupBS "stream2List" slistBenches+streambenchbs = makeGroupBS "stream" streamBenches+breakbenchbs = makeGroupBS "break" breakBenches+headsbenchbs = makeGroupBS "heads" headsBenches+dropbenchbs = makeGroupBS "drop" dropBenches+zipbenchbs = makeGroupBS "zip" zipBenches+consbenchbs = makeGroupBS "consumed" consBenches+lengthbenchbs = makeGroupBS "length" listBenches+takebenchbs = makeGroupBS "take" takeBenches+takeUpTobenchbs = makeGroupBS "takeUpTo" takeUpToBenches+groupbenchbs = makeGroupBS "group" groupBenches+mapbenchbs = makeGroupBS "map" mapBenches+foldbenchbs = makeGroupBS "fold" $ foldBenches+convbenchbs = makeGroupBS "convStream" convBenches+miscbenchbs = makeGroupBS "other" miscBenches++endian2benchbs = makeGroupBS "2" endian2Benches+endian3benchbs = makeGroupBS "3" endian3Benches+endian4benchbs = makeGroupBS "4" endian4Benches+endian8benchbs = makeGroupBS "8" endian8Benches+endianbenchbs = bgroup "endian" [endian2benchbs, endian3benchbs, endian4benchbs, endian8benchbs]+++allListBenches = bgroup "list" [listbench, streambench, breakbench, headsbench, dropbench, zipbench, lengthbench, takebench, takeUpTobench, groupbench, mapbench, foldbench, convbench, miscbench, consbench]++allByteStringBenches = bgroup "bytestring" [listbenchbs, streambenchbs, breakbenchbs, headsbenchbs, dropbenchbs, zipbenchbs, lengthbenchbs, takebenchbs, takeUpTobenchbs, groupbenchbs, mapbenchbs, foldbenchbs, convbenchbs, endianbenchbs, miscbenchbs, consbenchbs]++list0 = makeList "list one go" deepseq+list1 = BDIter1 "stream2list one go" (flip deepseq ()) stream2list+list2 = BDIterN "stream2list chunk by 4" 4 (flip deepseq ()) stream2list+list3 = BDIterN "stream2list chunk by 1024" 1024 (flip deepseq ()) stream2list+slistBenches = [list1, list2, list3]++stream1 = BDIter1 "stream2stream one go" (flip deepseq ()) stream2stream+stream2 = BDIterN "stream2stream chunk by 4" 4 (flip deepseq ()) stream2stream+stream3 = BDIterN "stream2stream chunk by 1024" 1024 (flip deepseq ()) stream2stream+streamBenches = [stream1, stream2, stream3]++break0 = makeList "break early list" (fst . Prelude.break (>5))+break0' = makeList "break never list" (fst . Prelude.break (<0))+break1 = id1 "break early one go" (I.break (>5))+break2 = id1 "break never" (I.break (<0)) -- not ever true.+break3 = idN "break early chunked" (I.break (>500))+break4 = idN "break never chunked" (I.break (<0)) -- not ever true+break5 = idN "break late chunked" (I.break (>8000))+breakBenches = [break1, break2, break3, break4, break5]++heads1 = id1 "heads null" (I.heads $ LL.fromList [])+heads2 = id1 "heads 1" (I.heads $ LL.fromList [1])+heads3 = id1 "heads 100" (I.heads $ LL.fromList [1..100])+heads4 = idN "heads 100 over chunks" (I.heads $ LL.fromList [1..100])+headsBenches = [heads1, heads2, heads3, heads4]++benchpeek = id1 "peek" I.peek+benchskip = id1 "skipToEof" (I.skipToEof >> return Nothing)+miscBenches = [benchpeek, benchskip]++drop0 = makeList "drop plain (list only)"+ ( flip seq () . Prelude.drop 100)+drop1 = id1 "drop null" (I.drop 0)+drop2 = id1 "drop plain" (I.drop 100)+drop3 = idN "drop over chunks" (I.drop 100)++dropw0 = makeList "dropWhile all (list only)" (Prelude.dropWhile (const True))+dropw1 = id1 "dropWhile all" (I.dropWhile (const True))+dropw2 = idN "dropWhile all chunked" (I.dropWhile (const True))+dropw3 = id1 "dropWhile small" (I.dropWhile ( < 100))+dropw4 = id1 "dropWhile large" (I.dropWhile ( < 6000))+dropBenches = [drop1, drop2, drop3, dropw1, dropw2, dropw3, dropw4]++b_zip0 = idN "zip balanced" (I.zip (I.dropWhile (<100)) (I.dropWhile (<200))+ >> identity)+b_zip1 = idN "zip unbalanced" (I.zip (I.dropWhile (<8000)) (I.head) >> identity)+b_zip2 = idN "zip unbalanced 2" (I.zip identity I.length >> identity)+b_zip3 = idN "zip complete" (I.zip identity identity >> identity)+b_zip4 = idN "zip nonterminating" (I.zip I.length I.stream2stream >> identity)+zipBenches = [b_zip0, b_zip1, b_zip2, b_zip3, b_zip4 ]++consumed0 = idN "countConsumed" (I.countConsumed (I.foldl' (+) 0))+consumed1 = idN "countConsumed baseline (`I.enumWith` I.length)" (I.foldl' (+) 0 `I.enumWith` I.length)+consBenches = [consumed0, consumed1]+++l1 = makeList "length of list" Prelude.length+l2 = id1 "length single iteratee" I.length+l3 = idN "length chunked" I.length+listBenches = [l2, l3]++take0 = makeList "take length of list long" (Prelude.length . Prelude.take 1000)+take1 = id1 "take head short one go" (I.joinI $ I.take 20 I.head)+take2 = id1 "take head long one go" (I.joinI $ I.take 1000 I.head)+take3 = idN "take head short chunked" (I.joinI $ I.take 20 I.head)+take4 = idN "take head long chunked" (I.joinI $ I.take 1000 I.head)+take5 = id1 "take length long one go" (I.joinI $ I.take 1000 I.length)+take6 = idN "take length long chunked" (I.joinI $ I.take 1000 I.length)+takeBenches = [take1, take2, take3, take4, take5, take6]++takeUpTo1 = id1 "takeUpTo head short one go" (I.joinI $ I.take 20 I.head)+takeUpTo2 = id1 "takeUpTo head long one go" (I.joinI $ I.takeUpTo 1000 I.head)+takeUpTo3 = idN "takeUpTo head short chunked" (I.joinI $ I.takeUpTo 20 I.head)+takeUpTo4 = idN "takeUpTo head long chunked" (I.joinI $ I.takeUpTo 1000 I.head)+takeUpTo5 = id1 "takeUpTo length long one go" (I.joinI $ I.takeUpTo 1000 I.length)+takeUpTo6 = idN "takeUpTo length long chunked" (I.joinI $ I.takeUpTo 1000 I.length)+takeUpToBenches = [takeUpTo1, takeUpTo2, takeUpTo3, takeUpTo4, takeUpTo5, takeUpTo6]++group1 = id1 "group split" (I.joinI $ (I.group 24 ><> I.mapStream LL.length) I.length)+group2 = idN "group coalesce" (I.joinI $ (I.group 512 ><> I.mapStream LL.length) I.length)+groupBenches = [group1,group2]++map1 = id1 "map length one go" (I.joinI $ I.rigidMapStream id I.length)+map2 = idN "map length chunked" (I.joinI $ I.rigidMapStream id I.length)+map3 = id1 "map head one go" (I.joinI $ I.rigidMapStream id I.head)+map4 = idN "map head chunked" (I.joinI $ I.rigidMapStream id I.head)+mapBenches = [map1, map2, map3, map4]++foldB1 = idNl "foldl' sum" (I.foldl' (+) 0)+foldB2 = idNl "mapReduce foldl' 2 sum" (getSum <$> I.mapReduce 2 (Sum . LL.foldl' (+) 0))+foldB3 = idNl "mapReduce foldl' 4 sum" (getSum <$> I.mapReduce 4 (Sum . LL.foldl' (+) 0))+foldBenches = [foldB1, foldB2, foldB3]++conv1 = idN "convStream id head chunked" (I.joinI . I.convStream idChunk $ I.head)+conv2 = idN "convStream id length chunked" (I.joinI . I.convStream idChunk $ I.length)+idChunk = I.liftI step+ where+ step (I.Chunk xs)+ | LL.null xs = idChunk+ | True = idone xs (I.Chunk mempty)+convBenches = [conv1, conv2]++instance NFData BS.ByteString where++instance NFData a => NFData (Sum a) where+ rnf (Sum a) = rnf a++endianRead2_1 = id1 "endianRead2 single" (I.endianRead2 MSB)+endianRead2_2 = idNx "endianRead2 chunked" 1 (I.endianRead2 MSB)+endianRead3_1 = id1 "endianRead3 single" (I.endianRead3 MSB)+endianRead3_2 = idNx "endianRead3 chunked" 2 (I.endianRead3 MSB)+endianRead4_1 = id1 "endianRead4 single" (I.endianRead4 MSB)+endianRead4_2 = idNx "endianRead4 chunked" 2 (I.endianRead4 MSB)+endianRead8_1 = id1 "endianRead8 single" (I.endianRead8 MSB)+endianRead8_2 = idN "endianRead8 chunked" (I.endianRead8 MSB)+endianRead8_3 = idNx "endianRead8 multiple chunked" 2 (I.endianRead8 MSB)+endian2Benches = [endianRead2_1, endianRead2_2]+endian3Benches = [endianRead3_1, endianRead3_2]+endian4Benches = [endianRead4_1, endianRead4_2]+endian8Benches = [endianRead8_1, endianRead8_2, endianRead8_3]
+ bench/BenchIO.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE BangPatterns #-}++module BenchIO where++import Prelude hiding (null, length)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Criterion.Main+import Data.Monoid+import Data.Word+import Data.Iteratee+import Data.Iteratee.Parallel+import Data.Iteratee.Base.ReadableChunk+import Data.Iteratee.IO.Fd (fileDriverFd)+import Data.Iteratee.IO.Handle (fileDriverHandle)++bufSize = 65536+file = "/usr/share/dict/words"++length' :: Monad m => Iteratee ByteString m Int+length' = length++testFdString :: IO ()+testFdString = fileDriverFd bufSize len file >> return ()+ where+ len :: Monad m => Iteratee String m Int+ len = length++testFdByte :: IO ()+testFdByte = fileDriverFd bufSize len file >> return ()+ where+ len :: Monad m => Iteratee ByteString m Int+ len = length++testHdString :: IO ()+testHdString = fileDriverHandle bufSize len file >> return ()+ where+ len :: Monad m => Iteratee String m Int+ len = length++testHdByte :: IO ()+testHdByte = fileDriverHandle bufSize len file >> return ()+ where+ len :: Monad m => Iteratee ByteString m Int+ len = length++testFdMapReduce :: Int -> IO ()+testFdMapReduce n = fileDriverFd bufSize sum file >> return ()+ where+ sum :: Iteratee ByteString IO Word8+ sum = getSum `fmap` mapReduce n (Sum . B.foldl' (+) 0)++testFdFold :: IO ()+testFdFold = fileDriverFd bufSize sum file >> return ()+ where+ sum :: Iteratee ByteString IO Word8+ sum = foldl' (+) 0++main = defaultMain (stringIO ++ ioBenches)++stringIO =+ [ bgroup "String"+ [bench "Fd" testFdString+ ,bench "Hd with String" testHdString+ ]+ ]++ioBenches =+ [bgroup "ByteString" [+ bench "Fd" testFdByte+ ,bench "Hd" testHdByte+ ]++ ,bgroup "folds" [+ bench "Fd/fold" testFdFold+ ,bench "Fd/mapReduce 2" $ testFdMapReduce 2+ ,bench "Fd/mapReduce 4" $ testFdMapReduce 4+ ,bench "Fd/mapReduce 8" $ testFdMapReduce 8+ ]+ ]
iteratee.cabal view
@@ -1,5 +1,5 @@ name: iteratee-version: 0.8.9.1+version: 0.8.9.3 synopsis: Iteratee-based I/O description: The Iteratee monad provides strict, safe, and functional I/O. In addition@@ -12,10 +12,10 @@ license: BSD3 license-file: LICENSE homepage: http://www.tiresiaspress.us/haskell/iteratee-tested-with: GHC == 7.0.4, GHC == 7.2.1+tested-with: GHC == 7.6.0, GHC == 7.4.2 stability: experimental -cabal-version: >= 1.6+cabal-version: >= 1.10 build-type: Simple extra-source-files:@@ -25,12 +25,10 @@ Examples/*.lhs Examples/*.txt tests/*.hs--flag buildTests- description: Build test executables.- default: False+ bench/*.hs library+ default-language: Haskell2010 hs-source-dirs: src @@ -48,14 +46,14 @@ build-depends: base >= 3 && < 6,- ListLike >= 1.0 && < 4,+ ListLike >= 3.0 && < 4, MonadCatchIO-transformers > 0.2 && < 0.4, monad-control == 0.3.* ,- bytestring >= 0.9 && < 0.10,+ bytestring >= 0.9 && < 0.11, containers >= 0.2 && < 0.6, parallel >= 2 && < 4, transformers >= 0.2 && < 0.4,- transformers-base >= 0.3 && < 0.5+ transformers-base >= 0.4 && < 0.5 exposed-modules: Data.Nullable@@ -82,27 +80,65 @@ if impl(ghc >= 6.8) ghc-options: -fwarn-tabs -executable testIteratee- hs-source-dirs:- src- tests +Test-Suite testIteratee+ default-language: Haskell2010+ type: exitcode-stdio-1.0 main-is: testIteratee.hs-- other-modules:- QCUtils+ hs-source-dirs: tests src+ ghc-options: -fhpc -hpcdir dist/hpc/mix/iteratee-0.8.9.3 - if flag(buildTests)+ if os(windows)+ cpp-options: -DUSE_WINDOWS+ else+ cpp-options: -DUSE_POSIX build-depends:- base >= 3 && < 6,+ unix >= 2 && < 3++ build-depends:+ base,+ bytestring,+ iteratee,+ MonadCatchIO-mtl,+ monad-control,+ mtl,+ ListLike,+ transformers,+ transformers-base, HUnit == 1.2.* ,- mtl >= 2 && < 3, QuickCheck >= 2 && < 3, test-framework >= 0.3 && < 0.7, test-framework-quickcheck2 >= 0.2 && < 0.3, test-framework-hunit >= 0.2 && < 0.3++benchmark bench-all+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: BenchAll.hs++ if os(windows)+ cpp-options: -DUSE_WINDOWS else- buildable: False+ cpp-options: -DUSE_POSIX+ build-depends:+ unix >= 2 && < 3++ build-depends:+ iteratee,+ bytestring,+ MonadCatchIO-mtl,+ monad-control,+ mtl,+ ListLike,+ transformers,+ transformers-base,+ base >= 3 && < 6,+ criterion >= 0.6 && < 0.7,+ deepseq >= 1.2 && < 2,+ mtl >= 2 && < 3+ ghc-options: -O2+ source-repository head type: darcs
src/Data/Iteratee/Base.hs view
@@ -38,7 +38,7 @@ ) where -import Prelude hiding (null, catch)+import Prelude hiding (null) import Data.Iteratee.Exception import Data.Iteratee.Base.LooseMap as X import Data.Nullable as X@@ -51,7 +51,8 @@ import Control.Monad.Base import Control.Monad.IO.Class import Control.Monad.Trans.Class-import Control.Monad.CatchIO (MonadCatchIO (..), catch, block)+import Control.Monad.CatchIO (MonadCatchIO (..), block)+import qualified Control.Monad.CatchIO as EIO import Control.Monad.Trans.Control import Control.Applicative hiding (empty) import Control.Exception (SomeException)@@ -178,7 +179,7 @@ instance (MonadCatchIO m, Nullable s, NullPoint s) => MonadCatchIO (Iteratee s m) where- m `catch` f = Iteratee $ \od oc -> runIter m od oc `catch` (\e -> runIter (f e) od oc)+ m `catch` f = Iteratee $ \od oc -> runIter m od oc `EIO.catch` (\e -> runIter (f e) od oc) block = ilift block unblock = ilift unblock
src/Data/Iteratee/ListLike.hs view
@@ -229,10 +229,8 @@ roll t d | t > d = liftI step where step (Chunk vec)- | LL.length vec >= d =- idone (LL.singleton $ LL.take t vec) (Chunk $ LL.drop d vec) | LL.length vec >= t =- idone (LL.singleton $ LL.take t vec) mempty <* drop (d-LL.length vec)+ idone (LL.singleton $ LL.take t vec) (Chunk $ LL.drop d vec) | LL.null vec = liftI step | otherwise = liftI (step' vec) step stream = idone LL.empty stream
− tests/benchmarkHandle.hs
@@ -1,75 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module Main where--import Prelude hiding (null, length)-import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import Criterion.Main-import Data.Monoid-import Data.Word-import Data.Iteratee-import Data.Iteratee.Parallel-import Data.Iteratee.Base.ReadableChunk-import Data.Iteratee.IO.Fd (fileDriverFd)-import Data.Iteratee.IO.Handle (fileDriverHandle)--bufSize = 65536-file = "/usr/share/dict/words"--length' :: Monad m => Iteratee ByteString m Int-length' = length--testFdString :: IO ()-testFdString = fileDriverFd bufSize len file >> return ()- where- len :: Monad m => Iteratee String m Int- len = length--testFdByte :: IO ()-testFdByte = fileDriverFd bufSize len file >> return ()- where- len :: Monad m => Iteratee ByteString m Int- len = length--testHdString :: IO ()-testHdString = fileDriverHandle bufSize len file >> return ()- where- len :: Monad m => Iteratee String m Int- len = length--testHdByte :: IO ()-testHdByte = fileDriverHandle bufSize len file >> return ()- where- len :: Monad m => Iteratee ByteString m Int- len = length--testFdMapReduce :: Int -> IO ()-testFdMapReduce n = fileDriverFd bufSize sum file >> return ()- where- sum :: Iteratee ByteString IO Word8- sum = getSum `fmap` mapReduce n (Sum . B.foldl' (+) 0)--testFdFold :: IO ()-testFdFold = fileDriverFd bufSize sum file >> return ()- where- sum :: Iteratee ByteString IO Word8- sum = foldl' (+) 0--main = defaultMain- [- bgroup "String" [- bench "Fd" testFdString- ,bench "Hd with String" testHdString- ]- ,bgroup "ByteString" [- bench "Fd" testFdByte- ,bench "Hd" testHdByte- ]- ,bgroup "folds" [- bench "Fd/fold" testFdFold- ,bench "Fd/mapReduce 2" $ testFdMapReduce 2- ,bench "Fd/mapReduce 4" $ testFdMapReduce 4- ,bench "Fd/mapReduce 8" $ testFdMapReduce 8- ]- ]
− tests/benchmarks.hs
@@ -1,239 +0,0 @@-{-# LANGUAGE RankNTypes, KindSignatures, NoMonomorphismRestriction #-}---- some basic benchmarking of iteratee--module Main where--import Data.Iteratee-import qualified Data.Iteratee.ListLike as I-import qualified Data.Iteratee.Parallel as I-import qualified Data.Iteratee.Binary as I-import Data.Iteratee.ListLike (enumPureNChunk, stream2list, stream2stream)-import Data.Word-import Data.Monoid-import qualified Data.ByteString as BS-import Control.Applicative-import Control.DeepSeq-import Control.Monad.Identity-import Control.Monad-import qualified Data.ListLike as LL--import Criterion.Main--main = defaultMain [allListBenches, allByteStringBenches]---- ---------------------------------------------------------------- helper functions and data---- |Hold information about a benchmark. This allows each--- benchmark (and baseline) to be created independently of the stream types,--- for easy comparison of different streams.--- BDList is for creating baseline comparison functions. Although the name--- is BDList, it will work for any stream type (e.g. bytestrings).-data BD a b s (m :: * -> *) = BDIter1 String (a -> b) (Iteratee s m a) - | BDIterN String Int (a -> b) (Iteratee s m a)- | BDList String (s -> b) s--id1 name i = BDIter1 name id i-idN name i = BDIterN name 5 id i-idNx name sz i = BDIterN name sz id i-idNl name i = BDIterN name 1000 id i--defTotalSize = 10000--makeList name f = BDList name f [1..defTotalSize]--makeBench :: BD n eval [Int] Identity -> Benchmark-makeBench (BDIter1 n eval i) = bench n $- proc eval runIdentity (enumPure1Chunk [1..defTotalSize]) i-makeBench (BDIterN n csize eval i) = bench n $- proc eval runIdentity (enumPureNChunk [1..defTotalSize] csize) i-makeBench (BDList n f l) = bench n $ whnf f l--packedBS :: BS.ByteString-packedBS = (BS.pack [1..defTotalSize])--makeBenchBS (BDIter1 n eval i) = bench n $- proc eval runIdentity (enumPure1Chunk packedBS) i-makeBenchBS (BDIterN n csize eval i) = bench n $- proc eval runIdentity (enumPureNChunk packedBS csize) i-makeBenchBS (BDList n f l) = error "makeBenchBS can't be called on BDList"--proc :: (Functor m, Monad m)- => (a -> b) --function to force evaluation of result- -> (m a -> a)- -> I.Enumerator s m a- -> I.Iteratee s m a- -> Pure-proc eval runner enum iter = whnf (eval . runner . (I.run <=< enum)) iter---- ---------------------------------------------------------------- benchmark groups-makeGroup n = bgroup n . map makeBench--makeGroupBS :: String -> [BD t t1 BS.ByteString Identity] -> Benchmark-makeGroupBS n = bgroup n . map makeBenchBS--listbench = makeGroup "stream2List" (slistBenches :: [BD [Int] () [Int] Identity])-streambench = makeGroup "stream" (streamBenches :: [BD [Int] () [Int] Identity])-breakbench = makeGroup "break" $ break0 : break0' : breakBenches-headsbench = makeGroup "heads" headsBenches-dropbench = makeGroup "drop" $ drop0 : dropBenches-zipbench = makeGroup "zip" $ zipBenches-consbench = makeGroup "consumed" consBenches-lengthbench = makeGroup "length" listBenches-takebench = makeGroup "take" $ take0 : takeBenches-takeUpTobench = makeGroup "takeUpTo" takeUpToBenches-groupbench = makeGroup "group" groupBenches-mapbench = makeGroup "map" $ mapBenches-foldbench = makeGroup "fold" $ foldBenches-convbench = makeGroup "convStream" convBenches-miscbench = makeGroup "other" miscBenches--listbenchbs = makeGroupBS "stream2List" slistBenches-streambenchbs = makeGroupBS "stream" streamBenches-breakbenchbs = makeGroupBS "break" breakBenches-headsbenchbs = makeGroupBS "heads" headsBenches-dropbenchbs = makeGroupBS "drop" dropBenches-zipbenchbs = makeGroupBS "zip" zipBenches-consbenchbs = makeGroupBS "consumed" consBenches-lengthbenchbs = makeGroupBS "length" listBenches-takebenchbs = makeGroupBS "take" takeBenches-takeUpTobenchbs = makeGroupBS "takeUpTo" takeUpToBenches-groupbenchbs = makeGroupBS "group" groupBenches-mapbenchbs = makeGroupBS "map" mapBenches-foldbenchbs = makeGroupBS "fold" $ foldBenches-convbenchbs = makeGroupBS "convStream" convBenches-miscbenchbs = makeGroupBS "other" miscBenches--endian2benchbs = makeGroupBS "2" endian2Benches-endian3benchbs = makeGroupBS "3" endian3Benches-endian4benchbs = makeGroupBS "4" endian4Benches-endian8benchbs = makeGroupBS "8" endian8Benches-endianbenchbs = bgroup "endian" [endian2benchbs, endian3benchbs, endian4benchbs, endian8benchbs]---allListBenches = bgroup "list" [listbench, streambench, breakbench, headsbench, dropbench, zipbench, lengthbench, takebench, takeUpTobench, groupbench, mapbench, foldbench, convbench, miscbench, consbench]--allByteStringBenches = bgroup "bytestring" [listbenchbs, streambenchbs, breakbenchbs, headsbenchbs, dropbenchbs, zipbenchbs, lengthbenchbs, takebenchbs, takeUpTobenchbs, groupbenchbs, mapbenchbs, foldbenchbs, convbenchbs, endianbenchbs, miscbenchbs, consbenchbs]--list0 = makeList "list one go" deepseq-list1 = BDIter1 "stream2list one go" (flip deepseq ()) stream2list-list2 = BDIterN "stream2list chunk by 4" 4 (flip deepseq ()) stream2list-list3 = BDIterN "stream2list chunk by 1024" 1024 (flip deepseq ()) stream2list-slistBenches = [list1, list2, list3]--stream1 = BDIter1 "stream2stream one go" (flip deepseq ()) stream2stream-stream2 = BDIterN "stream2stream chunk by 4" 4 (flip deepseq ()) stream2stream-stream3 = BDIterN "stream2stream chunk by 1024" 1024 (flip deepseq ()) stream2stream-streamBenches = [stream1, stream2, stream3]--break0 = makeList "break early list" (fst . Prelude.break (>5))-break0' = makeList "break never list" (fst . Prelude.break (<0))-break1 = id1 "break early one go" (I.break (>5))-break2 = id1 "break never" (I.break (<0)) -- not ever true.-break3 = idN "break early chunked" (I.break (>500))-break4 = idN "break never chunked" (I.break (<0)) -- not ever true-break5 = idN "break late chunked" (I.break (>8000))-breakBenches = [break1, break2, break3, break4, break5]--heads1 = id1 "heads null" (I.heads $ LL.fromList [])-heads2 = id1 "heads 1" (I.heads $ LL.fromList [1])-heads3 = id1 "heads 100" (I.heads $ LL.fromList [1..100])-heads4 = idN "heads 100 over chunks" (I.heads $ LL.fromList [1..100])-headsBenches = [heads1, heads2, heads3, heads4]--benchpeek = id1 "peek" I.peek-benchskip = id1 "skipToEof" (I.skipToEof >> return Nothing)-miscBenches = [benchpeek, benchskip]--drop0 = makeList "drop plain (list only)"- ( flip seq () . Prelude.drop 100)-drop1 = id1 "drop null" (I.drop 0)-drop2 = id1 "drop plain" (I.drop 100)-drop3 = idN "drop over chunks" (I.drop 100)--dropw0 = makeList "dropWhile all (list only)" (Prelude.dropWhile (const True))-dropw1 = id1 "dropWhile all" (I.dropWhile (const True))-dropw2 = idN "dropWhile all chunked" (I.dropWhile (const True))-dropw3 = id1 "dropWhile small" (I.dropWhile ( < 100))-dropw4 = id1 "dropWhile large" (I.dropWhile ( < 6000))-dropBenches = [drop1, drop2, drop3, dropw1, dropw2, dropw3, dropw4]--b_zip0 = idN "zip balanced" (I.zip (I.dropWhile (<100)) (I.dropWhile (<200))- >> identity)-b_zip1 = idN "zip unbalanced" (I.zip (I.dropWhile (<8000)) (I.head) >> identity)-b_zip2 = idN "zip unbalanced 2" (I.zip identity I.length >> identity)-b_zip3 = idN "zip complete" (I.zip identity identity >> identity)-b_zip4 = idN "zip nonterminating" (I.zip I.length I.stream2stream >> identity)-zipBenches = [b_zip0, b_zip1, b_zip2, b_zip3, b_zip4 ]--consumed0 = idN "countConsumed" (I.countConsumed (I.foldl' (+) 0))-consumed1 = idN "countConsumed baseline (`I.enumWith` I.length)" (I.foldl' (+) 0 `I.enumWith` I.length)-consBenches = [consumed0, consumed1]---l1 = makeList "length of list" Prelude.length-l2 = id1 "length single iteratee" I.length-l3 = idN "length chunked" I.length-listBenches = [l2, l3]--take0 = makeList "take length of list long" (Prelude.length . Prelude.take 1000)-take1 = id1 "take head short one go" (I.joinI $ I.take 20 I.head)-take2 = id1 "take head long one go" (I.joinI $ I.take 1000 I.head)-take3 = idN "take head short chunked" (I.joinI $ I.take 20 I.head)-take4 = idN "take head long chunked" (I.joinI $ I.take 1000 I.head)-take5 = id1 "take length long one go" (I.joinI $ I.take 1000 I.length)-take6 = idN "take length long chunked" (I.joinI $ I.take 1000 I.length)-takeBenches = [take1, take2, take3, take4, take5, take6]--takeUpTo1 = id1 "takeUpTo head short one go" (I.joinI $ I.take 20 I.head)-takeUpTo2 = id1 "takeUpTo head long one go" (I.joinI $ I.takeUpTo 1000 I.head)-takeUpTo3 = idN "takeUpTo head short chunked" (I.joinI $ I.takeUpTo 20 I.head)-takeUpTo4 = idN "takeUpTo head long chunked" (I.joinI $ I.takeUpTo 1000 I.head)-takeUpTo5 = id1 "takeUpTo length long one go" (I.joinI $ I.takeUpTo 1000 I.length)-takeUpTo6 = idN "takeUpTo length long chunked" (I.joinI $ I.takeUpTo 1000 I.length)-takeUpToBenches = [takeUpTo1, takeUpTo2, takeUpTo3, takeUpTo4, takeUpTo5, takeUpTo6]--group1 = id1 "group split" (I.joinI $ (I.group 24 ><> I.mapStream LL.length) I.length)-group2 = idN "group coalesce" (I.joinI $ (I.group 512 ><> I.mapStream LL.length) I.length)-groupBenches = [group1,group2]--map1 = id1 "map length one go" (I.joinI $ I.rigidMapStream id I.length)-map2 = idN "map length chunked" (I.joinI $ I.rigidMapStream id I.length)-map3 = id1 "map head one go" (I.joinI $ I.rigidMapStream id I.head)-map4 = idN "map head chunked" (I.joinI $ I.rigidMapStream id I.head)-mapBenches = [map1, map2, map3, map4]--foldB1 = idNl "foldl' sum" (I.foldl' (+) 0)-foldB2 = idNl "mapReduce foldl' 2 sum" (getSum <$> I.mapReduce 2 (Sum . LL.foldl' (+) 0))-foldB3 = idNl "mapReduce foldl' 4 sum" (getSum <$> I.mapReduce 4 (Sum . LL.foldl' (+) 0))-foldBenches = [foldB1, foldB2, foldB3]--conv1 = idN "convStream id head chunked" (I.joinI . I.convStream idChunk $ I.head)-conv2 = idN "convStream id length chunked" (I.joinI . I.convStream idChunk $ I.length)-idChunk = I.liftI step- where- step (I.Chunk xs)- | LL.null xs = idChunk- | True = idone xs (I.Chunk mempty)-convBenches = [conv1, conv2]--instance NFData BS.ByteString where--instance NFData a => NFData (Sum a) where- rnf (Sum a) = rnf a--endianRead2_1 = id1 "endianRead2 single" (I.endianRead2 MSB)-endianRead2_2 = idNx "endianRead2 chunked" 1 (I.endianRead2 MSB)-endianRead3_1 = id1 "endianRead3 single" (I.endianRead3 MSB)-endianRead3_2 = idNx "endianRead3 chunked" 2 (I.endianRead3 MSB)-endianRead4_1 = id1 "endianRead4 single" (I.endianRead4 MSB)-endianRead4_2 = idNx "endianRead4 chunked" 2 (I.endianRead4 MSB)-endianRead8_1 = id1 "endianRead8 single" (I.endianRead8 MSB)-endianRead8_2 = idN "endianRead8 chunked" (I.endianRead8 MSB)-endianRead8_3 = idNx "endianRead8 multiple chunked" 2 (I.endianRead8 MSB)-endian2Benches = [endianRead2_1, endianRead2_2]-endian3Benches = [endianRead3_1, endianRead3_2]-endian4Benches = [endianRead4_1, endianRead4_2]-endian8Benches = [endianRead8_1, endianRead8_2, endianRead8_3]
+ tests/fusion.hs view
@@ -0,0 +1,95 @@+module Main where++import Data.Iteratee as I+import Criterion.Main+import Control.Monad.Identity+++runner+ :: Enumeratee [Int] xs Identity a+ -> [Int]+ -> Iteratee xs Identity a+ -> a+runner etee xs iter =+ runIdentity $ enumPureNChunk xs 5 (joinI $ etee iter) >>= I.run++-- test fusion of enumeratee/iteratee composition+runner2+ :: Enumeratee [Int] xs Identity a+ -> [Int]+ -> Iteratee xs Identity a+ -> a+runner2 etee xs iter =+ runIdentity $ enumPureNChunk xs 5 (etee =$ iter) >>= I.run++-- test fusion of enumerator/enumeratee composition+runner3+ :: Enumeratee [Int] xs Identity a+ -> [Int]+ -> Iteratee xs Identity a+ -> a+runner3 etee xs iter =+ runIdentity $ (enumPureNChunk xs 5 $= etee) iter >>= I.run++m2 :: Enumeratee [Int] [Int] Identity a+m2 = mapChunks id ><> mapChunks (map (+1))+{-# INLINE m2 #-}++m3 :: Enumeratee [Int] [Int] Identity a+m3 = mapChunks id ><> mapChunks (map (+1)) ><> I.filter (even)+{-# INLINE m3 #-}++m4 :: Enumeratee [Int] [Int] Identity a+m4 = m2 ><> m2++m10 :: Enumeratee [Int] [Int] Identity a+m10 = m3 ><> m2 ><> m3 ><> m2++m' :: Enumeratee [a] [a] Identity x+m' = convStream (getChunk)+{-# INLINE m' #-}++m'2 :: Num a => Enumeratee [a] [a] Identity x+m'2 = convStream (liftM (map (+1)) getChunk)+{-# INLINE m'2 #-}++fusedMap :: Iteratee [Int] Identity a -> a+fusedMap = runner m2 [1..100]++fusedMap' :: Iteratee [Int] Identity a -> a+fusedMap' = runner (m2 ><> m') [1..100]++fusedMap'2 :: Iteratee [Int] Identity a -> a+fusedMap'2 = runner (m2 ><> m' ><> m') [1..100]++fusedMap3 :: Iteratee [Int] Identity a -> a+fusedMap3 = runner m3 [1..100]++fusedMap4 :: Iteratee [Int] Identity a -> a+fusedMap4 = runner m4 [1..100]++fusedMap10 :: Iteratee [Int] Identity a -> a+fusedMap10 = runner m10 [1..100]++fusionBenches :: [Benchmark]+fusionBenches =+ [ bench "mapChunks/mapChunks fusion" $ whnf fusedMap I.sum+ , bench "mapChunks/filter fusion" $ whnf fusedMap3 I.sum+ , bench "nested mapChunks/mapChunks fusion" $ whnf fusedMap4 I.sum+ , bench "highly nested fusion" $ whnf fusedMap10 I.sum+ , bench "mapChunks/mapChunks/convStream" $ whnf fusedMap' I.sum+ , bench "mapChunks/mapChunks/convStream2" $ whnf fusedMap'2 I.sum+ ]++main :: IO ()+main = do+ print $ "fusedMap"+ print $ fusedMap I.sum+ print "fusedMap/filter"+ print $ fusedMap3 I.sum+ print "fusedMap4"+ print $ fusedMap4 I.sum+ print "fusedMap10"+ print $ fusedMap10 I.sum++ defaultMain fusionBenches
+ tests/fusion2.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RankNTypes #-}++module Main where++import Data.Iteratee as I+import Criterion.Main+import Control.Monad.Identity+import Control.Monad.Trans+++runner+ :: Enumeratee [Int] xs Identity a+ -> [Int]+ -> Iteratee xs Identity a+ -> a+runner etee xs iter =+ runIdentity $ enumPureNChunk xs 5 (joinI $ etee iter) >>= I.run++-- test fusion of enumeratee/iteratee composition+runner2+ :: Enumeratee [Int] xs Identity a+ -> [Int]+ -> Iteratee xs Identity a+ -> a+runner2 etee xs iter =+ runIdentity $ enumPureNChunk xs 5 (etee =$ iter) >>= I.run++-- test fusion of enumerator/enumeratee composition+runner3+ :: Enumeratee [Int] xs Identity a+ -> [Int]+ -> Iteratee xs Identity a+ -> a+runner3 etee xs iter =+ runIdentity $ (enumPureNChunk xs 5 $= etee) iter >>= I.run++m2 :: Enumeratee [Int] [Int] Identity a+m2 = mapChunks id ><> mapChunks (map (+1))++m3 :: Enumeratee [Int] [Int] Identity a+m3 = mapChunks id ><> mapChunks (map (+1)) ><> I.filter (even)++m4 :: Enumeratee [Int] [Int] Identity a+m4 = m2 ><> m2++m10 :: Enumeratee [Int] [Int] Identity a+m10 = m3 ><> m2 ><> m3 ><> m2++fusedMap :: Iteratee [Int] Identity a -> a+fusedMap = runner m2 [1..100]++fusedMap3 :: Iteratee [Int] Identity a -> a+fusedMap3 = runner m3 [1..100]++fusedMap4 :: Iteratee [Int] Identity a -> a+fusedMap4 = runner m4 [1..100]++fusedMap10 :: Iteratee [Int] Identity a -> a+fusedMap10 = runner m10 [1..100]++-- experiment with using stream-fusion like constructs for+-- enumeratees+data StreamF m b a = forall s. StreamF (s -> m (Step s b a)) !s++data Step s b a =+ Done+ | Yield [a] !s+ | Next (b -> P2 [a] s)++data P2 a b = P2 !a !b++map_t :: Monad m => (a -> b) -> StreamF m a b+map_t fn = StreamF loop ()+ where+ loop () = return (Next (\a -> P2 [fn a] () ))+{-# INLINE map_t #-}++filter_t :: Monad m => (a -> Bool) -> StreamF m a a+filter_t pred = StreamF loop ()+ where+ loop () = return (Next (\a -> P2 (if pred a then [a] else []) ()) )+{-# INLINE filter_t #-}++cmp_t :: Monad m => StreamF m a b -> StreamF m b c -> StreamF m a c+cmp_t (StreamF fn1 s1_0) (StreamF fn2 s2_0) = StreamF loop (s1_0,s2_0,[])+ where+ loop (s1,s2,supply) = fn2 s2 >>= \r2 -> case r2 of+ Done -> return Done+ Yield cS s2' -> return $ Yield cS (s1,s2',supply)+ Next fn -> case supply of+ (b:bS) -> let P2 cS s2' = fn b+ in return $ Yield cS (s1,s2',bS)+ [] -> fn1 s1 >>= \r1 -> case r1 of+ Done -> return Done+ Yield aS s1' -> loop (s1', s2, aS)+ Next f -> return $ Next $ \a ->+ let P2 bS s1' = f a+ in P2 [] (s1',s2,bS)+{-# INLINE cmp_t #-}++{-+id_t :: Monad m => StreamF m a -> StreamF m a+id_t (StreamF istep s0) = StreamF loop s0+ where+ loop s = istep s >>= \r -> case r of+ Done -> return Done+ Yield a s' -> return $ Yield a s'+ Skip s' -> return $ Skip s'+{-# INLINE id_t #-}++map_t :: Monad m => (a -> b) -> StreamF m a -> StreamF m b+map_t fn (StreamF istep s0) = StreamF loop s0+ where+ loop s = istep s >>= \r -> case r of+ Done -> return Done+ Yield a s' -> return $ Yield (fn a) s'+ Skip s' -> return $ Skip s'+{-# INLINE map_t #-}++filter_t :: Monad m => (a -> Bool) -> StreamF m a -> StreamF m a+filter_t pred (StreamF istep s0) = StreamF loop s0+ where+ loop s = istep s >>= \r -> case r of+ Done -> return Done+ Yield a s' -> return $ if pred a then Yield a s' else Skip s'+ Skip s' -> return $ Skip s'+{-# INLINE filter_t #-}++iStream :: Monad m => StreamF (Iteratee [a] m) a+iStream = StreamF loop []+ where+ loop (x:xs) = return $ Yield x xs+ loop [] = do+ r <- isStreamFinished+ case r of+ Nothing -> getChunk >>= loop+ Just _ -> return Done+{-# INLINE iStream #-}++-- this isn't really the correct type signature, but I don't know how to write+-- what it actually is. Maybe it won't be a problem, with the correct type+-- class constraints.+etee_t :: Monad m => (forall m. Monad m => StreamF m a -> StreamF m b) -> Enumeratee [a] [b] m x+etee_t stream_fn = case stream_fn iStream of+ StreamF b_fn s0 -> unfoldConvStream fn s0+ where+ fn s = do+ stepRes <- b_fn s+ case stepRes of+ Done -> return (s,[])+ Yield a s' -> return (s',[a])+ Skip s' -> return (s',[])+{-# INLINE etee_t #-}++type Trans m a b = Monad m => StreamF m a -> StreamF m b+-}+++etee_t :: Monad m => StreamF m a b -> Enumeratee [a] [b] m x+etee_t stream = case stream of+ StreamF b_fn s0 -> unfoldConvStream fn (s0,[])+ where+ fn (s,[]) = do+ ck <- getChunk+ return ((s,ck),[])+ fn (s,supply@(x:xs)) = do+ stepRes <- lift $ b_fn s+ case stepRes of+ Done -> return ((s,supply),[])+ Yield aS s' -> return ((s',supply),aS)+ Next f -> let P2 bS s' = f x+ in return ((s',xs),bS)++type Trans m a b = Monad m => StreamF m a b++m2_t :: Trans m Int Int+m2_t = map_t id `cmp_t` map_t (+1)++m3_t :: Trans m Int Int+m3_t = map_t id `cmp_t` map_t (+1) `cmp_t` filter_t even++m4_t :: Trans m Int Int+m4_t = m2_t `cmp_t` m2_t++fusedMap_t :: Iteratee [Int] Identity a -> a+fusedMap_t = runner_t m2_t [1..100]++fusedMap3_t :: Iteratee [Int] Identity a -> a+fusedMap3_t = runner_t m3_t [1..100]++fusedMap4_t :: Iteratee [Int] Identity a -> a+fusedMap4_t = runner_t m4_t [1..100]++runner_t+ :: (forall m. Trans m Int x)+ -> [Int]+ -> Iteratee [x] Identity a+ -> a+runner_t trans xs iter =+ runIdentity $ enumPureNChunk xs 5 (joinI $ (etee_t trans) iter) >>= I.run++fusionBenches :: [Benchmark]+fusionBenches =+ [ bench "mapChunks/mapChunks fusion" $ whnf fusedMap I.sum+ , bench "mapChunks/filter fusion" $ whnf fusedMap3 I.sum+ , bench "nested mapChunks/mapChunks fusion" $ whnf fusedMap4 I.sum+ , bench "highly nested fusion" $ whnf fusedMap10 I.sum+ , bench "stream mapChunks/mapChunks" $ whnf fusedMap_t I.sum+ , bench "stream mapChunks/filter" $ whnf fusedMap3_t I.sum+ , bench "stream nested mapChunks/mapChunks" $ whnf fusedMap4_t I.sum+ ]++main :: IO ()+main = do+ putStrLn "\n\n Original"+ print $ "fusedMap"+ print $ fusedMap I.sum+ print "fusedMap/filter"+ print $ fusedMap3 I.sum+ print "fusedMap4"+ print $ fusedMap4 I.sum+ print "fusedMap10"+ print $ fusedMap10 I.sum++ putStrLn "\n\n Stream-based"+ print $ "fusedMap"+ print $ fusedMap I.sum+ print "fusedMap/filter"+ print $ fusedMap3 I.sum+ print "fusedMap4"+ print $ fusedMap4 I.sum++ defaultMain fusionBenches