git.iko.soy/streamly
on dbaacea help sign in
streamly/benchmark/FileIO.hs
283 lines 11 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
26import qualified Streamly.String as SS
27#endif
29-- Input and output file handles
30data Handles = Handles Handle Handle
32scratchDir :: String
33scratchDir = "benchmark/scratch/"
35infile :: String
36infile = scratchDir ++ "in-100MB.txt"
38outfile :: String
39outfile = scratchDir ++ "out.txt"
41blockSize, blockCount :: Int
42blockSize = 32768
43blockCount = 3200
45#ifdef DEVBUILD
46fileSize :: Int
47fileSize = blockSize * blockCount
49foreign import ccall unsafe "u_iswspace"
50 iswspace :: Int -> Int
52-- Code copied from base/Data.Char to INLINE it
53{-# INLINE isSpace #-}
54isSpace :: Char -> Bool
55-- isSpace includes non-breaking space
56-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
57-- at or below 0x377 have been assigned, so we shouldn't have to worry about
58-- any new spaces appearing below there. It would probably be best to
59-- use branchless ||, but currently the eqLit transformation will undo that,
60-- so we'll do it like this until there's a way around that.
61isSpace c
62 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
63 | otherwise = iswspace (ord c) /= 0
64 where
65 uc = fromIntegral (ord c) :: Word
66#endif
68main :: IO ()
69main = do
70 -- XXX will this work on windows/msys?
71 let cmd = "mkdir -p " ++ scratchDir
72 ++ "; test -e " ++ infile
73 ++ " || { echo \"creating input file " ++ infile
74 ++ "\" && dd if=/dev/random of=" ++ infile
75 ++ " bs=" ++ show blockSize
76 ++ " count=" ++ show blockCount
77 ++ ";}"
79 runProcess_ (shell cmd)
80 inHandle <- openFile infile ReadMode
81 outHandle <- openFile outfile WriteMode
82 href <- newIORef $ Handles inHandle outHandle
84-- This is a 500MB text file for text processing benchmarks. We cannot have it
85-- in the repo, therefore we use it locally with DEVBUILD conditional (enabled
86-- by "dev" cabal flag).
87#ifdef DEVBUILD
88 inText <- openFile "benchmark/text-processing/gutenberg-500.txt" ReadMode
89#endif
91 defaultMain
92 [ bgroup "readArray"
93 [ mkBench "last" href $ do
94 Handles inh _ <- readIORef href
95 let s = FH.readArrays inh
96 larr <- S.last s
97 case larr of
98 Nothing -> return Nothing
99 Just arr -> A.readIndex arr (A.length arr - 1)
100 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
101 -- wc uses lseek to just determine the file size rather than reading
102 -- and counting characters.
103 , mkBench "length (bytecount)" href $ do
104 Handles inh _ <- readIORef href
105 let s = FH.readArrays inh
106 S.sum (S.map A.length s)
107 , mkBench "sum" href $ do
108 let foldlArr' f z = runIdentity . S.foldl' f z . A.read
109 Handles inh _ <- readIORef href
110 let s = FH.readArrays inh
111 S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
112 ]
113 , bgroup "readStream"
114 [ mkBench "last" href $ do
115 Handles inh _ <- readIORef href
116 S.last $ FH.read inh
117 , mkBench "length (bytecount)" href $ do
118 Handles inh _ <- readIORef href
119 S.length $ FH.read inh
120 , mkBench "sum" href $ do
121 Handles inh _ <- readIORef href
122 S.sum $ FH.read inh
123 ]
124 , bgroup "copyArray"
125 [ mkBench "copy" href $ do
126 Handles inh outh <- readIORef href
127 let s = FH.readArrays inh
128 FH.writeArrays outh s
129 ]
130#ifdef DEVBUILD
131 -- This takes a little longer therefore put under the dev conditional
132 , bgroup "copyStream"
133 [ mkBench "fromToHandle" href $ do
134 Handles inh outh <- readIORef href
135 FH.write outh (FH.read inh)
136 ]
137 -- This needs an ascii file, as decode just errors out.
138 , bgroup "decode-encode"
139 [ mkBench "encodeChar8-decodeChar8" href $ do
140 Handles inh outh <- readIORef href
141 FH.write outh
142 $ SS.encodeChar8
143 $ SS.decodeChar8
144 $ FH.read inh
145 , mkBench "encodeUtf8-decodeUtf8" href $ do
146 Handles inh outh <- readIORef href
147 FH.write outh
148 $ SS.encodeUtf8
149 $ SS.decodeUtf8
150 $ FH.read inh
151 ]
152 , bgroup "grouping"
153 [ mkBench "chunksOf 1 (toArray)" href $ do
154 Handles inh _ <- readIORef href
155 S.length $ FL.chunksOf fileSize (A.toArrayN fileSize)
156 (FH.read inh)
158 , mkBench "chunksOf 1" href $ do
159 Handles inh _ <- readIORef href
160 S.length $ FL.chunksOf 1 FL.drain (FH.read inh)
161 , mkBench "chunksOf 10" href $ do
162 Handles inh _ <- readIORef href
163 S.length $ FL.chunksOf 10 FL.drain (FH.read inh)
164 , mkBench "chunksOf 1000" href $ do
165 Handles inh _ <- readIORef href
166 S.length $ FL.chunksOf 1000 FL.drain (FH.read inh)
167 ]
168 , bgroup "group-ungroup"
169 [ mkBench "lines-unlines" href $ do
170 Handles inh outh <- readIORef href
171 FH.write outh
172 $ SS.encodeChar8
173 $ SS.unlines
174 $ SS.lines
175 $ SS.decodeChar8
176 $ FH.read inh
177 , mkBench "lines-unlines-arrays" href $ do
178 Handles inh outh <- readIORef href
179 FH.writeArraysPackedUpto (1024*1024) outh
180 $ S.insertAfterEach (return $ A.fromList [10])
181 $ A.splitArraysOn 10
182 $ FH.readArraysOfUpto (1024*1024) inh
183 , mkBench "words-unwords" href $ do
184 Handles inh outh <- readIORef href
185 FH.write outh
186 $ SS.encodeChar8
187 $ SS.unwords
188 $ SS.words
189 $ SS.decodeChar8
190 $ FH.read inh
191 ]
193 , let lf = fromIntegral (ord '\n')
194 lfarr = A.fromList [lf]
195 isSp = isSpace . chr . fromIntegral
196 toarr = A.fromList . map (fromIntegral . ord)
197 in bgroup "splitting"
198 [ bgroup "predicate"
199 [ mkBenchText "splitBy \\n (line count)" inText $ do
200 (S.length $ FL.splitBy (== lf) FL.drain
201 $ FH.read inText) >>= print
202 , mkBenchText "splitSuffixBy \\n (line count)" inText $ do
203 (S.length $ FL.splitSuffixBy (== lf) FL.drain
204 $ FH.read inText) >>= print
205 , mkBenchText "wordsBy isSpace (word count)" inText $ do
206 (S.length $ FL.wordsBy isSp FL.drain
207 $ FH.read inText) >>= print
208 ]
210 , bgroup "empty-pattern"
211 [ mkBenchText "splitOn \"\"" inText $ do
212 (S.length $ FL.splitOn (A.fromList []) FL.drain
213 $ FH.read inText) >>= print
214 , mkBenchText "splitSuffixOn \"\"" inText $ do
215 (S.length $ FL.splitSuffixOn (A.fromList []) FL.drain
216 $ FH.read inText) >>= print
217 ]
218 , bgroup "short-pattern"
219 [ mkBenchText "splitOn \\n (line count)" inText $ do
220 (S.length $ FL.splitOn lfarr FL.drain
221 $ FH.read inText) >>= print
222 , mkBenchText "splitSuffixOn \\n (line count)" inText $ do
223 (S.length $ FL.splitSuffixOn lfarr FL.drain
224 $ FH.read inText) >>= print
225 , mkBenchText "splitOn a" inText $ do
226 (S.length $ FL.splitOn (toarr "a") FL.drain
227 $ FH.read inText) >>= print
228 , mkBenchText "splitOn \\r\\n" inText $ do
229 (S.length $ FL.splitOn (toarr "\r\n") FL.drain
230 $ FH.read inText) >>= print
231 , mkBenchText "splitSuffixOn \\r\\n)" inText $ do
232 (S.length $ FL.splitSuffixOn (toarr "\r\n") FL.drain
233 $ FH.read inText) >>= print
234 , mkBenchText "splitOn aa" inText $ do
235 (S.length $ FL.splitOn (toarr "aa") FL.drain
236 $ FH.read inText) >>= print
237 , mkBenchText "splitOn aaaa" inText $ do
238 (S.length $ FL.splitOn (toarr "aaaa") FL.drain
239 $ FH.read inText) >>= print
240 , mkBenchText "splitOn abcdefgh" inText $ do
241 (S.length $ FL.splitOn (toarr "abcdefgh") FL.drain
242 $ FH.read inText) >>= print
243 ]
244 , bgroup "long-pattern"
245 [ mkBenchText "splitOn abcdefghi" inText $ do
246 (S.length $ FL.splitOn (toarr "abcdefghi") FL.drain
247 $ FH.read inText) >>= print
248 , mkBenchText "splitOn catcatcatcatcat" inText $ do
249 (S.length $ FL.splitOn (toarr "catcatcatcatcat") FL.drain
250 $ FH.read inText) >>= print
251 , mkBenchText "splitOn abc...xyz" inText $ do
252 (S.length $ FL.splitOn
253 (toarr "abcdefghijklmnopqrstuvwxyz")
254 FL.drain
255 $ FH.read inText) >>= print
256 , mkBenchText "splitSuffixOn abc...xyz" inText $ do
257 (S.length $ FL.splitSuffixOn
258 (toarr "abcdefghijklmnopqrstuvwxyz")
259 FL.drain
260 $ FH.read inText) >>= print
261 ]
262 ]
263#endif
264 ]
266 where
268 mkBench :: NFData b => String -> IORef Handles -> IO b -> Benchmark
269 mkBench name ref action =
270 bench name $ perRunEnv (do
271 (Handles inh outh) <- readIORef ref
272 hClose inh
273 hClose outh
274 inHandle <- openFile infile ReadMode
275 outHandle <- openFile outfile WriteMode
276 writeIORef ref (Handles inHandle outHandle)
277 )
278 (\_ -> action)
280#ifdef DEVBUILD
281 mkBenchText name h action =
282 bench name $ perRunEnv (hSeek h AbsoluteSeek 0) (\_ -> action)
283#endif