Skip to content

Commit d1f33ef

Browse files
jamesdbrockjamesdbrock
authored
Merge pull request #165 from purescript-contrib/bench-compare
Way to paste benchmark comparisons into Github
2 parents 51d2843 + 078b88c commit d1f33ef

File tree

4 files changed

+120
-58
lines changed

4 files changed

+120
-58
lines changed

‎bench/Json/Parsing.purs

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -8,11 +8,11 @@ import Data.List (List)
88
import Data.Maybe (Maybe(..))
99
import Data.Number as Number
1010
import Data.Tuple (Tuple(..))
11-
import Text.Parsing.Parser (Parser, fail)
11+
import Text.Parsing.Parser (ParserT, fail)
1212
import Text.Parsing.Parser.Combinators (between, choice, sepBy, try)
1313
import Text.Parsing.Parser.String (regex, skipSpaces, string)
1414

15-
json :: Parser String Json
15+
json :: forall m. Monad m => ParserT String m Json
1616
json = defer \_ ->
1717
skipSpaces *> choice
1818
[ JsonObject <$> jsonObject
@@ -23,36 +23,36 @@ json = defer \_ ->
2323
, JsonNull <$ jsonNull
2424
]
2525

26-
jsonObject :: Parser String (List (Tuple String Json))
26+
jsonObject :: forall m. Monad m => ParserT String m (List (Tuple String Json))
2727
jsonObject = defer \_ ->
2828
between (string "{") (skipSpaces *> string "}") do
2929
skipSpaces *> jsonObjectPair `sepBy` (try (skipSpaces *> string ","))
3030

31-
jsonObjectPair :: Parser String (Tuple String Json)
31+
jsonObjectPair :: forall m. Monad m => ParserT String m (Tuple String Json)
3232
jsonObjectPair = defer \_ ->
3333
Tuple <$> (skipSpaces *> jsonString <* skipSpaces <* string ":") <*> json
3434

35-
jsonArray :: Parser String (List Json)
35+
jsonArray :: forall m. Monad m => ParserT String m (List Json)
3636
jsonArray = defer \_ ->
3737
between (string "[") (skipSpaces *> string "]") do
3838
json `sepBy` (try (skipSpaces *> string ","))
3939

40-
jsonString :: Parser String String
40+
jsonString :: forall m. Monad m => ParserT String m String
4141
jsonString = between (string "\"") (string "\"") do
4242
regex {} """\\"|[^"]*"""
4343

44-
jsonNumber :: Parser String Number
44+
jsonNumber :: forall m. Monad m => ParserT String m Number
4545
jsonNumber = do
4646
n <- regex {} """(\+|-)?(\d+(\.\d*)?|\d*\.\d+)([eE](\+|-)?\d+)?"""
4747
case Number.fromString n of
4848
Just n' -> pure n'
4949
Nothing -> fail "Expected number"
5050

51-
jsonBoolean :: Parser String Boolean
51+
jsonBoolean :: forall m. Monad m => ParserT String m Boolean
5252
jsonBoolean = choice
5353
[ true <$ string "true"
5454
, false <$ string "false"
5555
]
5656

57-
jsonNull :: Parser String String
57+
jsonNull :: forall m. Monad m => ParserT String m String
5858
jsonNull = string "null"

‎bench/Main.purs

Lines changed: 85 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
-- | # Benchmarking
22
-- |
3-
-- | spago -x spago-dev.dhall run --main Bench.Main
3+
-- | spago -x spago-dev.dhall run --main Bench.Main --node-args '--expose-gc'
44
-- |
55
-- | This benchmark suite is intended to guide changes to this package so that
66
-- | we can compare the benchmarks of different commits.
@@ -10,6 +10,18 @@
1010
-- | than Regex?” Answer: approximately 100×. The Regex benchmarks also give
1111
-- | us a rough way to calibrate benchmarks run on different platforms.
1212
-- |
13+
-- | `--expose-gc` is from
14+
-- | https://pursuit.purescript.org/packages/purescript-minibench/3.0.0/docs/Performance.Minibench#v:benchWith
15+
-- |
16+
-- | # Benchmark comparison for different commits
17+
-- |
18+
-- | The file bench.html will contain a Github-flavored-Markdown-compatible HTML
19+
-- | table of the benchmarks side-by-side.
20+
-- |
21+
-- | spago -x spago-dev.dhall run --main Bench.Main --node-args '--expose-gc' > bench1.txt
22+
-- | spago -x spago-dev.dhall run --main Bench.Main --node-args '--expose-gc' > bench2.txt
23+
-- | nix-shell -p saxon --command 'saxon <(echo "<table>"; cat bench1.txt bench2.txt; echo "</table>") bench/tabletranspose.xslt > bench.html'
24+
-- |
1325
-- | # Profiling
1426
-- |
1527
-- | https://nodejs.org/en/docs/guides/simple-profiling/
@@ -44,6 +56,8 @@ import Prelude
4456
import Bench.Json.Parsing as BenchParsing
4557
import Bench.Json.StringParser as BenchStringParser
4658
import Bench.Json.TestData (largeJson, mediumJson, smallJson)
59+
import Control.Monad.Trampoline (runTrampoline)
60+
import Control.Monad.Free (liftF)
4761
import Data.Array (fold, replicate)
4862
import Data.Either (either)
4963
import Data.List (many, manyRec)
@@ -56,7 +70,7 @@ import Effect.Console (log)
5670
import Effect.Exception (throw)
5771
import Effect.Unsafe (unsafePerformEffect)
5872
import Performance.Minibench (benchWith)
59-
import Text.Parsing.Parser (Parser, runParser)
73+
import Text.Parsing.Parser (Parser, runParser, runParserT)
6074
import Text.Parsing.Parser.String (string)
6175
import Text.Parsing.Parser.String.Basic (digit)
6276
import StringParser as StringParser
@@ -69,26 +83,41 @@ string23 = "23"
6983
string23_2 :: String
7084
string23_2 = fold $ replicate 2 string23
7185

72-
string23_10000 :: String
73-
string23_10000 = fold $ replicate 10000 string23
86+
-- string23_10000 :: String
87+
-- string23_10000 = fold $ replicate 10000 string23
88+
89+
string23_500 :: String
90+
string23_500 = fold $ replicate 500 string23
7491

7592
stringSkidoo :: String
7693
stringSkidoo = "skidoo"
7794

7895
stringSkidoo_2 :: String
7996
stringSkidoo_2 = fold $ replicate 2 stringSkidoo
8097

81-
stringSkidoo_10000 :: String
82-
stringSkidoo_10000 = fold $ replicate 10000 stringSkidoo
98+
-- stringSkidoo_10000 :: String
99+
-- stringSkidoo_10000 = fold $ replicate 10000 stringSkidoo
100+
101+
stringSkidoo_1000 :: String
102+
stringSkidoo_1000 = fold $ replicate 1000 stringSkidoo
83103

84104
parse23 :: Parser String (List Char)
85-
parse23 = manyRec digit
105+
parse23 = many digit
86106

87107
parse23Points :: StringParser.Parser (List Char)
88-
parse23Points = manyRec StringParser.CodePoints.anyDigit
108+
parse23Points = many StringParser.CodePoints.anyDigit
89109

90110
parse23Units :: StringParser.Parser (List Char)
91-
parse23Units = manyRec StringParser.CodeUnits.anyDigit
111+
parse23Units = many StringParser.CodeUnits.anyDigit
112+
113+
parse23Rec :: Parser String (List Char)
114+
parse23Rec = manyRec digit
115+
116+
parse23PointsRec :: StringParser.Parser (List Char)
117+
parse23PointsRec = manyRec StringParser.CodePoints.anyDigit
118+
119+
parse23UnitsRec :: StringParser.Parser (List Char)
120+
parse23UnitsRec = manyRec StringParser.CodeUnits.anyDigit
92121

93122
pattern23 :: Regex
94123
pattern23 = either (unsafePerformEffect <<< throw) identity
@@ -105,6 +134,9 @@ pattern23 = either (unsafePerformEffect <<< throw) identity
105134
parseSkidoo :: Parser String (List String)
106135
parseSkidoo = many $ string "skidoo"
107136

137+
parseSkidooRec :: Parser String (List String)
138+
parseSkidooRec = manyRec $ string "skidoo"
139+
108140
patternSkidoo :: Regex
109141
patternSkidoo = either (unsafePerformEffect <<< throw) identity
110142
$ regex "skidoo"
@@ -117,51 +149,55 @@ patternSkidoo = either (unsafePerformEffect <<< throw) identity
117149
, unicode: true
118150
}
119151

152+
htmlTableWrap :: String -> Effect Unit -> Effect Unit
153+
htmlTableWrap caption benchmark = do
154+
log "<td><b>"
155+
log caption
156+
log "</b>"
157+
log "<pre>"
158+
benchmark
159+
log "</pre></td>"
160+
120161
main :: Effect Unit
121162
main = do
122-
-- log $ show $ runParser string23_2 parse23
123-
-- log $ show $ Regex.match pattern23 string23_2
124-
-- log $ show $ runParser stringSkidoo_2 parseSkidoo
125-
-- log $ show $ Regex.match patternSkidoo stringSkidoo_2
126-
log "runParser parse23"
127-
benchWith 200
128-
$ \_ -> runParser string23_10000 parse23
129-
log "StringParser.runParser parse23Points"
130-
benchWith 20
131-
$ \_ -> StringParser.runParser parse23Points string23_10000
132-
log "StringParser.runParser parse23Units"
133-
benchWith 200
134-
$ \_ -> StringParser.runParser parse23Units string23_10000
135-
log "Regex.match pattern23"
136-
benchWith 200
137-
$ \_ -> Regex.match pattern23 string23_10000
138-
log "runParser parseSkidoo"
139-
benchWith 200
140-
$ \_ -> runParser stringSkidoo_10000 parseSkidoo
141-
log "Regex.match patternSkidoo"
142-
benchWith 200
143-
$ \_ -> Regex.match patternSkidoo stringSkidoo_10000
144-
145-
log "runParser json smallJson"
146-
benchWith 1000
163+
log "<tr>"
164+
htmlTableWrap "runParser parse23" $ benchWith 200
165+
$ \_ -> runParser string23_500 parse23
166+
htmlTableWrap "StringParser.runParser parse23Points" $ benchWith 20
167+
$ \_ -> StringParser.runParser parse23Points string23_500
168+
htmlTableWrap "StringParser.runParser parse23Units" $ benchWith 200
169+
$ \_ -> StringParser.runParser parse23Units string23_500
170+
htmlTableWrap "runParser parse23Rec" $ benchWith 200
171+
$ \_ -> runParser string23_500 parse23Rec
172+
htmlTableWrap "StringParser.runParser parse23PointsRec" $ benchWith 20
173+
$ \_ -> StringParser.runParser parse23PointsRec string23_500
174+
htmlTableWrap "StringParser.runParser parse23UnitsRec" $ benchWith 200
175+
$ \_ -> StringParser.runParser parse23UnitsRec string23_500
176+
htmlTableWrap "Regex.match pattern23" $ benchWith 200
177+
$ \_ -> Regex.match pattern23 string23_500
178+
htmlTableWrap "runParser parseSkidoo" $ benchWith 200
179+
$ \_ -> runParser stringSkidoo_1000 parseSkidoo
180+
htmlTableWrap "runParser parseSkidooRec" $ benchWith 200
181+
$ \_ -> runParser stringSkidoo_1000 parseSkidooRec
182+
htmlTableWrap "Regex.match patternSkidoo" $ benchWith 200
183+
$ \_ -> Regex.match patternSkidoo stringSkidoo_1000
184+
htmlTableWrap "runParser json smallJson" $ benchWith 1000
147185
$ \_ -> runParser smallJson BenchParsing.json
148-
149-
log "StringParser.runParser json smallJson"
150-
benchWith 1000
186+
htmlTableWrap "runTrampoline runParser json smallJson" $ benchWith 1000
187+
$ \_ -> runTrampoline $ runParserT smallJson BenchParsing.json
188+
htmlTableWrap "StringParser.runParser json smallJson" $ benchWith 500
151189
$ \_ -> StringParser.runParser BenchStringParser.json smallJson
152-
153-
log "runParser json mediumJson"
154-
benchWith 500
190+
htmlTableWrap "runParser json mediumJson" $ benchWith 500
155191
$ \_ -> runParser mediumJson BenchParsing.json
156-
157-
log "StringParser.runParser json mediumJson"
158-
benchWith 500
192+
htmlTableWrap "runTrampoline runParser json mediumJson" $ benchWith 500
193+
$ \_ -> runTrampoline $ runParserT mediumJson BenchParsing.json
194+
htmlTableWrap "StringParser.runParser json mediumJson" $ benchWith 1000
159195
$ \_ -> StringParser.runParser BenchStringParser.json mediumJson
160-
161-
log "runParser json largeJson"
162-
benchWith 100
196+
htmlTableWrap "runParser json largeJson" $ benchWith 100
163197
$ \_ -> runParser largeJson BenchParsing.json
164-
165-
log "StringParser.runParser json largeJson"
166-
benchWith 100
198+
htmlTableWrap "runTrampoline runParser json largeJson" $ benchWith 100
199+
$ \_ -> runTrampoline $ runParserT largeJson BenchParsing.json
200+
htmlTableWrap "StringParser.runParser json largeJson" $ benchWith 100
167201
$ \_ -> StringParser.runParser BenchStringParser.json largeJson
202+
log "</tr>"
203+

‎bench/tabletranspose.xslt

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
<!--
2+
3+
https://stackoverflow.com/questions/4410084/transpose-swap-x-y-axes-in-html-table
4+
5+
-->
6+
7+
8+
<xsl:stylesheet version="1.0"
9+
xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
10+
<xsl:output omit-xml-declaration="yes"/>
11+
<xsl:template match="table">
12+
<table>
13+
<xsl:for-each select="tr[1]/td">
14+
<xsl:variable name="vRowPos" select="position()"/>
15+
<tr>
16+
<xsl:for-each select="/table/tr">
17+
<xsl:variable name="vColPos" select="position()"/>
18+
<xsl:copy-of select="/table/tr[$vColPos]/td[$vRowPos]"/>
19+
</xsl:for-each>
20+
</tr>
21+
</xsl:for-each>
22+
</table>
23+
</xsl:template>
24+
</xsl:stylesheet>
25+

‎spago-dev.dhall

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ in conf //
1414
, "console"
1515
, "enums"
1616
, "effect"
17+
, "free"
1718
, "psci-support"
1819
, "minibench"
1920
, "exceptions"

0 commit comments

Comments
 (0)