Skip to content

Commit b24b055

Browse files
jamesdbrockjamesdbrock
authored
Merge pull request #179 from purescript-contrib/benchrec2
Fix the sepBy benchmarks
2 parents d9ccd4f + 87262d9 commit b24b055

File tree

1 file changed

+53
-65
lines changed

1 file changed

+53
-65
lines changed

‎bench/Main.purs

Lines changed: 53 additions & 65 deletions
Original file line numberDiff line numberDiff line change
@@ -60,9 +60,10 @@ import Control.Monad.Free (liftF)
6060
import Control.Monad.Trampoline (runTrampoline)
6161
import Data.Array (fold, replicate)
6262
import Data.Array as Array
63-
import Data.Either (either)
63+
import Data.Either (Either(..), either)
6464
import Data.List (many, manyRec)
6565
import Data.List.Types (List)
66+
import Data.Maybe (Maybe(..))
6667
import Data.String.Regex (Regex, regex)
6768
import Data.String.Regex as Regex
6869
import Data.String.Regex.Flags (RegexFlags(..))
@@ -157,113 +158,100 @@ htmlTableWrap caption benchmark = do
157158
benchmark
158159
log "</pre></td>"
159160

161+
throwLeft :: forall a b. Show a => Either a b -> b
162+
throwLeft (Left err) = unsafePerformEffect $ throw $ show err
163+
throwLeft (Right x) = x
164+
165+
throwNothing :: forall a. String -> Maybe a -> a
166+
throwNothing err Nothing = unsafePerformEffect $ throw err
167+
throwNothing _ (Just x) = x
168+
160169
main :: Effect Unit
161170
main = do
162171
log "<tr>"
163172

164-
-- These inputs are too small for good measurement, but larger ones blow stack
165-
-- log "<th><h2>digit 1000</h2></th>"
166-
-- htmlTableWrap "runParser many digit 1000" $ benchWith 200
167-
-- $ \_ -> runParser string23_1000 parse23
168-
-- htmlTableWrap "StringParser many CodePoints.anyDigit 1000" $ benchWith 20
169-
-- $ \_ -> StringParser.runParser parse23Points string23_1000
170-
-- htmlTableWrap "StringParser many CodeUnits.anyDigit 1000" $ benchWith 200
171-
-- $ \_ -> StringParser.runParser parse23Units string23_1000
172-
-- htmlTableWrap "runParser manyRec digit 1000" $ benchWith 200
173-
-- $ \_ -> runParser string23_1000 parse23Rec
174-
-- htmlTableWrap "StringParser manyRec CodePoints.anyDigit 1000" $ benchWith 20
175-
-- $ \_ -> StringParser.runParser parse23PointsRec string23_1000
176-
-- htmlTableWrap "StringParser manyRec CodeUnits.anyDigit 1000" $ benchWith 200
177-
-- $ \_ -> StringParser.runParser parse23UnitsRec string23_1000
178-
-- htmlTableWrap "Regex.match \\d* 1000" $ benchWith 200
179-
-- $ \_ -> Regex.match pattern23 string23_1000
180-
181173
log "<th><h2>digit 10000</h2></th>"
182174
htmlTableWrap "runParser many digit 10000" $ benchWith 50
183-
$ \_ -> runParser string23_10000 parse23
175+
$ \_ -> throwLeft $ runParser string23_10000 parse23
184176
htmlTableWrap "runParser manyRec digit 10000" $ benchWith 50
185-
$ \_ -> runParser string23_10000 parse23Rec
177+
$ \_ -> throwLeft $ runParser string23_10000 parse23Rec
186178
htmlTableWrap "runParser Array.many digit 10000" $ benchWith 50
187-
$ \_ -> runParser string23_10000 (Array.many digit)
179+
$ \_ -> throwLeft $ runParser string23_10000 (Array.many digit)
188180
htmlTableWrap "StringParser manyRec CodePoints.anyDigit 10000" $ benchWith 20
189-
$ \_ -> StringParser.runParser parse23PointsRec string23_10000
181+
$ \_ -> throwLeft $ StringParser.runParser parse23PointsRec string23_10000
190182
htmlTableWrap "StringParser manyRec CodeUnits.anyDigit 10000" $ benchWith 200
191-
$ \_ -> StringParser.runParser parse23UnitsRec string23_10000
183+
$ \_ -> throwLeft $ StringParser.runParser parse23UnitsRec string23_10000
192184
htmlTableWrap "Regex.match \\d* 10000" $ benchWith 200
193-
$ \_ -> Regex.match pattern23 string23_10000
185+
$ \_ -> throwNothing "Regex.match failed" $ Regex.match pattern23 string23_10000
194186

195187
log "<th><h2>string 100000</h2></th>"
196188
htmlTableWrap "runParser many string" $ benchWith 200
197-
$ \_ -> runParser stringSkidoo_100000 parseSkidoo
189+
$ \_ -> throwLeft $ runParser stringSkidoo_100000 parseSkidoo
198190
htmlTableWrap "runParser manyRec string" $ benchWith 200
199-
$ \_ -> runParser stringSkidoo_100000 parseSkidooRec
191+
$ \_ -> throwLeft $ runParser stringSkidoo_100000 parseSkidooRec
200192
htmlTableWrap "Regex.match literal*" $ benchWith 200
201-
$ \_ -> Regex.match patternSkidoo stringSkidoo_100000
193+
$ \_ -> throwNothing "Regex.match failed" $ Regex.match patternSkidoo stringSkidoo_100000
202194

203195
log "<th><h2>sepBy 1000</h2></th>"
204-
htmlTableWrap "runParser sepBy 1000" $ benchWith 50
205-
$ \_ -> runParser string23_1000 $ sepBy anyChar (char '3')
206-
htmlTableWrap "runParser sepByRec 1000" $ benchWith 50
207-
$ \_ -> runParser string23_1000 $ sepByRec anyChar (char '3')
196+
htmlTableWrap "runParser sepBy 1000" $ benchWith 200
197+
$ \_ -> throwLeft $ runParser string23_1000 $ sepBy anyChar (char '2')
198+
htmlTableWrap "runParser sepByRec 1000" $ benchWith 200
199+
$ \_ -> throwLeft $ runParser string23_1000 $ sepByRec anyChar (char '2')
208200

209201
log "<th><h2>sepBy 10000</h2></th>"
210202
htmlTableWrap "runParser sepBy 10000" $ benchWith 50
211-
$ \_ -> runParser string23_10000 $ sepBy anyChar (char '3')
203+
$ \_ -> throwLeft $ runParser string23_10000 $ sepBy anyChar (char '2')
212204
htmlTableWrap "runParser sepByRec 10000" $ benchWith 50
213-
$ \_ -> runParser string23_10000 $ sepByRec anyChar (char '3')
205+
$ \_ -> throwLeft $ runParser string23_10000 $ sepByRec anyChar (char '2')
214206

215207
log "<th><h2>chainl 10000</h2></th>"
216208
htmlTableWrap "runParser chainl 10000" $ benchWith 50
217-
$ \_ -> runParser string23_10000 $ chainl anyChar (pure const) 'x'
209+
$ \_ -> throwLeft $ runParser string23_10000 $ chainl anyChar (pure const) 'x'
218210
htmlTableWrap "runParser chainlRec 10000" $ benchWith 50
219-
$ \_ -> runParser string23_10000 $ chainlRec anyChar (pure const) 'x'
211+
$ \_ -> throwLeft $ runParser string23_10000 $ chainlRec anyChar (pure const) 'x'
220212

221213
log "<th><h2>chainr 1000</h2></th>"
222-
htmlTableWrap "runParser chainr 1000" $ benchWith 5
223-
$ \_ -> runParser string23_1000 $ chainr anyChar (pure const) 'x'
224-
htmlTableWrap "runParser chainrRec 1000" $ benchWith 5
225-
$ \_ -> runParser string23_1000 $ chainrRec anyChar (pure const) 'x'
214+
htmlTableWrap "runParser chainr 1000" $ benchWith 200
215+
$ \_ -> throwLeft $ runParser string23_1000 $ chainr anyChar (pure const) 'x'
216+
htmlTableWrap "runParser chainrRec 1000" $ benchWith 200
217+
$ \_ -> throwLeft $ runParser string23_1000 $ chainrRec anyChar (pure const) 'x'
226218

227219
log "<th><h2>chainr 10000</h2></th>"
228-
htmlTableWrap "runParser chainr 10000" $ benchWith 5
229-
$ \_ -> runParser string23_10000 $ chainr anyChar (pure const) 'x'
230-
htmlTableWrap "runParser chainrRec 10000" $ benchWith 5
231-
$ \_ -> runParser string23_10000 $ chainrRec anyChar (pure const) 'x'
220+
htmlTableWrap "runParser chainr 10000" $ benchWith 50
221+
$ \_ -> throwLeft $ runParser string23_10000 $ chainr anyChar (pure const) 'x'
222+
htmlTableWrap "runParser chainrRec 10000" $ benchWith 50
223+
$ \_ -> throwLeft $ runParser string23_10000 $ chainrRec anyChar (pure const) 'x'
232224

233225
log "<th><h2>manyTill 1000</h2></th>"
234-
htmlTableWrap "runParser manyTill 1000" $ benchWith 50
235-
$ \_ -> runParser string23_1000x $ manyTill anyChar (char 'x')
236-
htmlTableWrap "runParser manyTillRec 1000" $ benchWith 50
237-
$ \_ -> runParser string23_1000x $ manyTillRec anyChar (char 'x')
238-
htmlTableWrap "runParser manyTill_ 1000" $ benchWith 50
239-
$ \_ -> runParser string23_1000x $ manyTill_ anyChar (char 'x')
240-
htmlTableWrap "runParser manyTillRec_ 1000" $ benchWith 50
241-
$ \_ -> runParser string23_1000x $ manyTillRec_ anyChar (char 'x')
226+
htmlTableWrap "runParser manyTill 1000" $ benchWith 200
227+
$ \_ -> throwLeft $ runParser string23_1000x $ manyTill anyChar (char 'x')
228+
htmlTableWrap "runParser manyTillRec 1000" $ benchWith 200
229+
$ \_ -> throwLeft $ runParser string23_1000x $ manyTillRec anyChar (char 'x')
230+
htmlTableWrap "runParser manyTill_ 1000" $ benchWith 200
231+
$ \_ -> throwLeft $ runParser string23_1000x $ manyTill_ anyChar (char 'x')
232+
htmlTableWrap "runParser manyTillRec_ 1000" $ benchWith 200
233+
$ \_ -> throwLeft $ runParser string23_1000x $ manyTillRec_ anyChar (char 'x')
242234

243235
log "<th><h2>manyTill 10000</h2></th>"
244236
htmlTableWrap "runParser manyTill 10000" $ benchWith 50
245-
$ \_ -> runParser string23_10000x $ manyTill anyChar (char 'x')
237+
$ \_ -> throwLeft $ runParser string23_10000x $ manyTill anyChar (char 'x')
246238
htmlTableWrap "runParser manyTillRec 10000" $ benchWith 50
247-
$ \_ -> runParser string23_10000x $ manyTillRec anyChar (char 'x')
239+
$ \_ -> throwLeft $ runParser string23_10000x $ manyTillRec anyChar (char 'x')
248240
htmlTableWrap "runParser manyTill_ 10000" $ benchWith 50
249-
$ \_ -> runParser string23_10000x $ manyTill_ anyChar (char 'x')
241+
$ \_ -> throwLeft $ runParser string23_10000x $ manyTill_ anyChar (char 'x')
250242
htmlTableWrap "runParser manyTillRec_ 10000" $ benchWith 50
251-
$ \_ -> runParser string23_10000x $ manyTillRec_ anyChar (char 'x')
243+
$ \_ -> throwLeft $ runParser string23_10000x $ manyTillRec_ anyChar (char 'x')
252244

253245
log "<th><h2>mediumJson</h2></th>"
254-
htmlTableWrap "runParser json mediumJson" $ benchWith 500
255-
$ \_ -> runParser mediumJson BenchParsing.json
256-
htmlTableWrap "runTrampoline runParser json mediumJson" $ benchWith 500
257-
$ \_ -> runTrampoline $ runParserT mediumJson BenchParsing.json
258-
htmlTableWrap "StringParser.runParser json mediumJson" $ benchWith 1000
259-
$ \_ -> StringParser.runParser BenchStringParser.json mediumJson
246+
htmlTableWrap "runParser json mediumJson" $ benchWith 200
247+
$ \_ -> throwLeft $ runParser mediumJson BenchParsing.json
248+
htmlTableWrap "StringParser.runParser json mediumJson" $ benchWith 200
249+
$ \_ -> throwLeft $ StringParser.runParser BenchStringParser.json mediumJson
260250

261251
log "<th><h2>largeJson</h2></th>"
262252
htmlTableWrap "runParser json largeJson" $ benchWith 100
263-
$ \_ -> runParser largeJson BenchParsing.json
264-
htmlTableWrap "runTrampoline runParser json largeJson" $ benchWith 100
265-
$ \_ -> runTrampoline $ runParserT largeJson BenchParsing.json
253+
$ \_ -> throwLeft $ runParser largeJson BenchParsing.json
266254
htmlTableWrap "StringParser.runParser json largeJson" $ benchWith 100
267-
$ \_ -> StringParser.runParser BenchStringParser.json largeJson
255+
$ \_ -> throwLeft $ StringParser.runParser BenchStringParser.json largeJson
268256
log "</tr>"
269257

0 commit comments

Comments
 (0)