Skip to content

Commit 059a959

Browse files
jamesdbrockjamesdbrock
authored
Merge pull request #182 from purescript-contrib/combinatorrm
Combinators CPS reorganization
2 parents 3b2f7a0 + 7e523ca commit 059a959

File tree

6 files changed

+156
-360
lines changed

6 files changed

+156
-360
lines changed

‎CHANGELOG.md

+1
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ Breaking changes:
2727
without causing issues with `<$>`.
2828
- Rename module prefix from `Text.Parsing.Parser` to `Parsing` (#169 by @jamesdbrock)
2929
- Replace the `regex` parser. (#170 by @jamesdbrock)
30+
- Reorganize Combinators for #154 (#182 by @jamesdbrock)
3031

3132
New features:
3233

‎bench/Json/Parsing.purs

-2
Original file line numberDiff line numberDiff line change
@@ -10,8 +10,6 @@ import Data.Maybe (Maybe(..))
1010
import Data.Number as Number
1111
import Data.String.Regex.Flags (noFlags)
1212
import Data.Tuple (Tuple(..))
13-
import Effect.Exception (throw)
14-
import Effect.Unsafe (unsafePerformEffect)
1513
import Parsing (ParserT, fail)
1614
import Parsing.Combinators (between, choice, sepBy, try)
1715
import Parsing.String (regex, skipSpaces, string)

‎bench/Main.purs

+20-63
Original file line numberDiff line numberDiff line change
@@ -59,8 +59,7 @@ import Bench.Json.TestData (largeJson, mediumJson)
5959
import Data.Array (fold, replicate)
6060
import Data.Array as Array
6161
import Data.Either (Either(..), either)
62-
import Data.List (many, manyRec)
63-
import Data.List.Types (List)
62+
import Data.List as List
6463
import Data.Maybe (Maybe(..))
6564
import Data.String.Regex (Regex, regex)
6665
import Data.String.Regex as Regex
@@ -69,9 +68,9 @@ import Effect (Effect)
6968
import Effect.Console (log)
7069
import Effect.Exception (throw)
7170
import Effect.Unsafe (unsafePerformEffect)
72-
import Parsing (Parser, runParser)
73-
import Parsing.Combinators (chainl, chainlRec, chainr, chainrRec, manyTill, manyTillRec, manyTillRec_, manyTill_, sepBy, sepByRec, sepEndBy1, sepEndBy1Rec)
74-
import Parsing.String (anyChar, char, eof, string)
71+
import Parsing (runParser)
72+
import Parsing.Combinators (chainl, chainr, many, manyTill, manyTill_, sepBy, sepEndBy1, skipMany)
73+
import Parsing.String (anyChar, eof, string)
7574
import Parsing.String.Basic (digit)
7675
import Performance.Minibench (benchWith)
7776
import StringParser as StringParser
@@ -81,36 +80,18 @@ import StringParser.CodeUnits as StringParser.CodeUnits
8180
string23 :: String
8281
string23 = "23"
8382

84-
string23_10000 :: String
85-
string23_10000 = fold $ replicate 5000 string23
86-
8783
string23_1000 :: String
8884
string23_1000 = fold $ replicate 500 string23
8985

86+
string23_10000 :: String
87+
string23_10000 = fold $ replicate 5000 string23
88+
9089
stringSkidoo :: String
9190
stringSkidoo = "skidoooooo"
9291

9392
stringSkidoo_100000 :: String
9493
stringSkidoo_100000 = fold $ replicate 10000 stringSkidoo
9594

96-
parse23 :: Parser String (List Char)
97-
parse23 = many digit
98-
99-
parse23Points :: StringParser.Parser (List Char)
100-
parse23Points = many StringParser.CodePoints.anyDigit
101-
102-
parse23Units :: StringParser.Parser (List Char)
103-
parse23Units = many StringParser.CodeUnits.anyDigit
104-
105-
parse23Rec :: Parser String (List Char)
106-
parse23Rec = manyRec digit
107-
108-
parse23PointsRec :: StringParser.Parser (List Char)
109-
parse23PointsRec = manyRec StringParser.CodePoints.anyDigit
110-
111-
parse23UnitsRec :: StringParser.Parser (List Char)
112-
parse23UnitsRec = manyRec StringParser.CodeUnits.anyDigit
113-
11495
pattern23 :: Regex
11596
pattern23 = either (unsafePerformEffect <<< throw) identity
11697
$ regex "\\d"
@@ -123,12 +104,6 @@ pattern23 = either (unsafePerformEffect <<< throw) identity
123104
, unicode: true
124105
}
125106

126-
parseSkidoo :: Parser String (List String)
127-
parseSkidoo = many $ string "skidoooooo"
128-
129-
parseSkidooRec :: Parser String (List String)
130-
parseSkidooRec = manyRec $ string "skidoooooo"
131-
132107
patternSkidoo :: Regex
133108
patternSkidoo = either (unsafePerformEffect <<< throw) identity
134109
$ regex "skidoooooo"
@@ -164,81 +139,63 @@ main = do
164139

165140
log "<th><h2>digit 10000</h2></th>"
166141
htmlTableWrap "runParser many digit 10000" $ benchWith 50
167-
$ \_ -> throwLeft $ runParser string23_10000 parse23
168-
htmlTableWrap "runParser manyRec digit 10000" $ benchWith 50
169-
$ \_ -> throwLeft $ runParser string23_10000 parse23Rec
142+
$ \_ -> throwLeft $ runParser string23_10000 (many digit)
170143
htmlTableWrap "runParser Array.many digit 10000" $ benchWith 50
171144
$ \_ -> throwLeft $ runParser string23_10000 (Array.many digit)
172145
htmlTableWrap "StringParser manyRec CodePoints.anyDigit 10000" $ benchWith 20
173-
$ \_ -> throwLeft $ StringParser.runParser parse23PointsRec string23_10000
146+
$ \_ -> throwLeft $ StringParser.runParser (List.manyRec StringParser.CodePoints.anyDigit) string23_10000
174147
htmlTableWrap "StringParser manyRec CodeUnits.anyDigit 10000" $ benchWith 200
175-
$ \_ -> throwLeft $ StringParser.runParser parse23UnitsRec string23_10000
148+
$ \_ -> throwLeft $ StringParser.runParser (List.manyRec StringParser.CodeUnits.anyDigit) string23_10000
176149
htmlTableWrap "Regex.match \\d* 10000" $ benchWith 200
177150
$ \_ -> throwNothing "Regex.match failed" $ Regex.match pattern23 string23_10000
178151

179152
log "<th><h2>string 100000</h2></th>"
180153
htmlTableWrap "runParser many string" $ benchWith 200
181-
$ \_ -> throwLeft $ runParser stringSkidoo_100000 parseSkidoo
182-
htmlTableWrap "runParser manyRec string" $ benchWith 200
183-
$ \_ -> throwLeft $ runParser stringSkidoo_100000 parseSkidooRec
154+
$ \_ -> throwLeft $ runParser stringSkidoo_100000 (many $ string "skidoooooo")
184155
htmlTableWrap "Regex.match literal*" $ benchWith 200
185156
$ \_ -> throwNothing "Regex.match failed" $ Regex.match patternSkidoo stringSkidoo_100000
186157

187-
log "<th><h2>sepBy 1000</h2></th>"
188-
htmlTableWrap "runParser sepBy 1000" $ benchWith 200
189-
$ \_ -> throwLeft $ runParser string23_1000 $ sepBy anyChar (pure unit)
190-
htmlTableWrap "runParser sepByRec 1000" $ benchWith 200
191-
$ \_ -> throwLeft $ runParser string23_1000 $ sepByRec anyChar (pure unit)
158+
log "<th><h2>many anyChar 10000</h2></th>"
159+
htmlTableWrap "runParser many anyChar 10000" $ benchWith 50
160+
$ \_ -> throwLeft $ runParser string23_10000 (many anyChar)
161+
htmlTableWrap "runParser Array.many anyChar 10000" $ benchWith 50
162+
$ \_ -> throwLeft $ runParser string23_10000 (Array.many anyChar)
163+
164+
log "<th><h2>skipMany anyChar 10000</h2></th>"
165+
htmlTableWrap "runParser skipMany anyChar 10000" $ benchWith 50
166+
$ \_ -> throwLeft $ runParser string23_10000 (skipMany anyChar)
192167

193168
log "<th><h2>sepBy 10000</h2></th>"
194169
htmlTableWrap "runParser sepBy 10000" $ benchWith 50
195170
$ \_ -> throwLeft $ runParser string23_10000 $ sepBy anyChar (pure unit)
196-
htmlTableWrap "runParser sepByRec 10000" $ benchWith 50
197-
$ \_ -> throwLeft $ runParser string23_10000 $ sepByRec anyChar (pure unit)
198171

199172
log "<th><h2>sepEndBy1 10000</h2></th>"
200173
htmlTableWrap "runParser sepEndBy1 10000" $ benchWith 50
201174
$ \_ -> throwLeft $ runParser string23_10000 $ sepEndBy1 anyChar (pure unit)
202-
htmlTableWrap "runParser sepEndBy1Rec 10000" $ benchWith 50
203-
$ \_ -> throwLeft $ runParser string23_10000 $ sepEndBy1Rec anyChar (pure unit)
204175

205176
log "<th><h2>chainl 10000</h2></th>"
206177
htmlTableWrap "runParser chainl 10000" $ benchWith 50
207178
$ \_ -> throwLeft $ runParser string23_10000 $ chainl anyChar (pure const) 'x'
208-
htmlTableWrap "runParser chainlRec 10000" $ benchWith 50
209-
$ \_ -> throwLeft $ runParser string23_10000 $ chainlRec anyChar (pure const) 'x'
210179

211180
log "<th><h2>chainr 1000</h2></th>"
212181
htmlTableWrap "runParser chainr 1000" $ benchWith 200
213182
$ \_ -> throwLeft $ runParser string23_1000 $ chainr anyChar (pure const) 'x'
214-
htmlTableWrap "runParser chainrRec 1000" $ benchWith 200
215-
$ \_ -> throwLeft $ runParser string23_1000 $ chainrRec anyChar (pure const) 'x'
216183

217184
log "<th><h2>chainr 10000</h2></th>"
218185
htmlTableWrap "runParser chainr 10000" $ benchWith 50
219186
$ \_ -> throwLeft $ runParser string23_10000 $ chainr anyChar (pure const) 'x'
220-
htmlTableWrap "runParser chainrRec 10000" $ benchWith 50
221-
$ \_ -> throwLeft $ runParser string23_10000 $ chainrRec anyChar (pure const) 'x'
222187

223188
log "<th><h2>manyTill 1000</h2></th>"
224189
htmlTableWrap "runParser manyTill 1000" $ benchWith 200
225190
$ \_ -> throwLeft $ runParser string23_1000 $ manyTill anyChar eof
226-
htmlTableWrap "runParser manyTillRec 1000" $ benchWith 200
227-
$ \_ -> throwLeft $ runParser string23_1000 $ manyTillRec anyChar eof
228191
htmlTableWrap "runParser manyTill_ 1000" $ benchWith 200
229192
$ \_ -> throwLeft $ runParser string23_1000 $ manyTill_ anyChar eof
230-
htmlTableWrap "runParser manyTillRec_ 1000" $ benchWith 200
231-
$ \_ -> throwLeft $ runParser string23_1000 $ manyTillRec_ anyChar eof
232193

233194
log "<th><h2>manyTill 10000</h2></th>"
234195
htmlTableWrap "runParser manyTill 10000" $ benchWith 50
235196
$ \_ -> throwLeft $ runParser string23_10000 $ manyTill anyChar eof
236-
htmlTableWrap "runParser manyTillRec 10000" $ benchWith 50
237-
$ \_ -> throwLeft $ runParser string23_10000 $ manyTillRec anyChar eof
238197
htmlTableWrap "runParser manyTill_ 10000" $ benchWith 50
239198
$ \_ -> throwLeft $ runParser string23_10000 $ manyTill_ anyChar eof
240-
htmlTableWrap "runParser manyTillRec_ 10000" $ benchWith 50
241-
$ \_ -> throwLeft $ runParser string23_10000 $ manyTillRec_ anyChar eof
242199

243200
log "<th><h2>mediumJson</h2></th>"
244201
htmlTableWrap "runParser json mediumJson" $ benchWith 200

‎spago-dev.dhall

-1
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,6 @@ in conf //
1414
, "console"
1515
, "enums"
1616
, "effect"
17-
, "free"
1817
, "psci-support"
1918
, "minibench"
2019
, "exceptions"

0 commit comments

Comments
 (0)