git.iko.soy/streamly
on 9e2e765 help sign in
streamly/benchmark/FileIO.hs
243 lines 9.6 kB history raw
1-- |
2-- Module : Main
3-- Copyright : (c) 2019 Harendra Kumar
4--
5-- License : BSD3
6-- Maintainer : harendra.kumar@gmail.com
8{-# LANGUAGE CPP #-}
10import Control.DeepSeq (NFData)
11import Data.Functor.Identity (runIdentity)
12import System.IO (openFile, IOMode(..), Handle, hClose)
13import System.Process.Typed (shell, runProcess_)
15import Data.IORef
16import Gauge
18import qualified Streamly.FileSystem.Handle as FH
19import qualified Streamly.Mem.Array as A
20import qualified Streamly.Prelude as S
22#ifdef DEVBUILD
23import Data.Char (ord, chr)
24import System.IO (hSeek, SeekMode(..))
25import qualified Streamly.Fold as FL
26#endif
28-- Input and output file handles
29data Handles = Handles Handle Handle
31scratchDir :: String
32scratchDir = "benchmark/scratch/"
34infile :: String
35infile = scratchDir ++ "in-100MB.txt"
37outfile :: String
38outfile = scratchDir ++ "out.txt"
40blockSize, blockCount :: Int
41blockSize = 32768
42blockCount = 3200
44#ifdef DEVBUILD
45fileSize :: Int
46fileSize = blockSize * blockCount
48foreign import ccall unsafe "u_iswspace"
49 iswspace :: Int -> Int
51-- Code copied from base/Data.Char to INLINE it
52{-# INLINE isSpace #-}
53isSpace :: Char -> Bool
54-- isSpace includes non-breaking space
55-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
56-- at or below 0x377 have been assigned, so we shouldn't have to worry about
57-- any new spaces appearing below there. It would probably be best to
58-- use branchless ||, but currently the eqLit transformation will undo that,
59-- so we'll do it like this until there's a way around that.
60isSpace c
61 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
62 | otherwise = iswspace (ord c) /= 0
63 where
64 uc = fromIntegral (ord c) :: Word
65#endif
67main :: IO ()
68main = do
69 -- XXX will this work on windows/msys?
70 let cmd = "mkdir -p " ++ scratchDir
71 ++ "; test -e " ++ infile
72 ++ " || { echo \"creating input file " ++ infile
73 ++ "\" && dd if=/dev/random of=" ++ infile
74 ++ " bs=" ++ show blockSize
75 ++ " count=" ++ show blockCount
76 ++ ";}"
78 runProcess_ (shell cmd)
79 inHandle <- openFile infile ReadMode
80 outHandle <- openFile outfile WriteMode
81 href <- newIORef $ Handles inHandle outHandle
83-- This is a 500MB text file for text processing benchmarks. We cannot have it
84-- in the repo, therefore we use it locally with DEVBUILD conditional (enabled
85-- by "dev" cabal flag).
86#ifdef DEVBUILD
87 inText <- openFile "benchmark/text-processing/gutenberg-500.txt" ReadMode
88#endif
90 defaultMain
91 [ bgroup "readArray"
92 [ mkBench "last" href $ do
93 Handles inh _ <- readIORef href
94 let s = FH.readArrays inh
95 larr <- S.last s
96 return $ case larr of
97 Nothing -> Nothing
98 Just arr -> A.readIndex arr (A.length arr - 1)
99 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
100 -- wc uses lseek to just determine the file size rather than reading
101 -- and counting characters.
102 , mkBench "length (bytecount)" href $ do
103 Handles inh _ <- readIORef href
104 let s = FH.readArrays inh
105 S.sum (S.map A.length s)
106 , mkBench "sum" href $ do
107 let foldlArr' f z = runIdentity . S.foldl' f z . A.read
108 Handles inh _ <- readIORef href
109 let s = FH.readArrays inh
110 S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
111 ]
112 , bgroup "readStream"
113 [ mkBench "last" href $ do
114 Handles inh _ <- readIORef href
115 S.last $ FH.read inh
116 , mkBench "length (bytecount)" href $ do
117 Handles inh _ <- readIORef href
118 S.length $ FH.read inh
119 , mkBench "sum" href $ do
120 Handles inh _ <- readIORef href
121 S.sum $ FH.read inh
122 ]
123 , bgroup "copyArray"
124 [ mkBench "copy" href $ do
125 Handles inh outh <- readIORef href
126 let s = FH.readArrays inh
127 FH.writeArrays outh s
128 ]
129#ifdef DEVBUILD
130 -- This takes a little longer therefore put under the dev conditional
131 , bgroup "copyStream"
132 [ mkBench "fromToHandle" href $ do
133 Handles inh outh <- readIORef href
134 FH.write outh (FH.read inh)
135 ]
136 , bgroup "grouping"
137 [ mkBench "chunksOf 1 (toArray)" href $ do
138 Handles inh _ <- readIORef href
139 S.length $ FL.chunksOf fileSize (A.toArrayN fileSize)
140 (FH.read inh)
142 , mkBench "chunksOf 1" href $ do
143 Handles inh _ <- readIORef href
144 S.length $ FL.chunksOf 1 FL.drain (FH.read inh)
145 , mkBench "chunksOf 10" href $ do
146 Handles inh _ <- readIORef href
147 S.length $ FL.chunksOf 10 FL.drain (FH.read inh)
148 , mkBench "chunksOf 1000" href $ do
149 Handles inh _ <- readIORef href
150 S.length $ FL.chunksOf 1000 FL.drain (FH.read inh)
151 ]
153 , let lf = fromIntegral (ord '\n')
154 lfarr = A.fromList [lf]
155 isSp = isSpace . chr . fromIntegral
156 toarr = A.fromList . map (fromIntegral . ord)
157 in bgroup "splitting"
158 [ bgroup "predicate"
159 [ mkBenchText "splitBy \\n (line count)" inText $ do
160 (S.length $ FL.splitBy (== lf) FL.drain
161 $ FH.read inText) >>= print
162 , mkBenchText "splitSuffixBy \\n (line count)" inText $ do
163 (S.length $ FL.splitSuffixBy (== lf) FL.drain
164 $ FH.read inText) >>= print
165 , mkBenchText "wordsBy isSpace (word count)" inText $ do
166 (S.length $ FL.wordsBy isSp FL.drain
167 $ FH.read inText) >>= print
168 ]
170 , bgroup "empty-pattern"
171 [ mkBenchText "splitOn \"\"" inText $ do
172 (S.length $ FL.splitOn (A.fromList []) FL.drain
173 $ FH.read inText) >>= print
174 , mkBenchText "splitSuffixOn \"\"" inText $ do
175 (S.length $ FL.splitSuffixOn (A.fromList []) FL.drain
176 $ FH.read inText) >>= print
177 ]
178 , bgroup "short-pattern"
179 [ mkBenchText "splitOn \\n (line count)" inText $ do
180 (S.length $ FL.splitOn lfarr FL.drain
181 $ FH.read inText) >>= print
182 , mkBenchText "splitSuffixOn \\n (line count)" inText $ do
183 (S.length $ FL.splitSuffixOn lfarr FL.drain
184 $ FH.read inText) >>= print
185 , mkBenchText "splitOn a" inText $ do
186 (S.length $ FL.splitOn (toarr "a") FL.drain
187 $ FH.read inText) >>= print
188 , mkBenchText "splitOn \\r\\n" inText $ do
189 (S.length $ FL.splitOn (toarr "\r\n") FL.drain
190 $ FH.read inText) >>= print
191 , mkBenchText "splitSuffixOn \\r\\n)" inText $ do
192 (S.length $ FL.splitSuffixOn (toarr "\r\n") FL.drain
193 $ FH.read inText) >>= print
194 , mkBenchText "splitOn aa" inText $ do
195 (S.length $ FL.splitOn (toarr "aa") FL.drain
196 $ FH.read inText) >>= print
197 , mkBenchText "splitOn aaaa" inText $ do
198 (S.length $ FL.splitOn (toarr "aaaa") FL.drain
199 $ FH.read inText) >>= print
200 , mkBenchText "splitOn abcdefgh" inText $ do
201 (S.length $ FL.splitOn (toarr "abcdefgh") FL.drain
202 $ FH.read inText) >>= print
203 ]
204 , bgroup "long-pattern"
205 [ mkBenchText "splitOn abcdefghi" inText $ do
206 (S.length $ FL.splitOn (toarr "abcdefghi") FL.drain
207 $ FH.read inText) >>= print
208 , mkBenchText "splitOn catcatcatcatcat" inText $ do
209 (S.length $ FL.splitOn (toarr "catcatcatcatcat") FL.drain
210 $ FH.read inText) >>= print
211 , mkBenchText "splitOn abc...xyz" inText $ do
212 (S.length $ FL.splitOn
213 (toarr "abcdefghijklmnopqrstuvwxyz")
214 FL.drain
215 $ FH.read inText) >>= print
216 , mkBenchText "splitSuffixOn abc...xyz" inText $ do
217 (S.length $ FL.splitSuffixOn
218 (toarr "abcdefghijklmnopqrstuvwxyz")
219 FL.drain
220 $ FH.read inText) >>= print
221 ]
222 ]
223#endif
224 ]
226 where
228 mkBench :: NFData b => String -> IORef Handles -> IO b -> Benchmark
229 mkBench name ref action =
230 bench name $ perRunEnv (do
231 (Handles inh outh) <- readIORef ref
232 hClose inh
233 hClose outh
234 inHandle <- openFile infile ReadMode
235 outHandle <- openFile outfile WriteMode
236 writeIORef ref (Handles inHandle outHandle)
237 )
238 (\_ -> action)
240#ifdef DEVBUILD
241 mkBenchText name h action =
242 bench name $ perRunEnv (hSeek h AbsoluteSeek 0) (\_ -> action)
243#endif