@@ -31,12 +31,13 @@ import Control.Monad.State (StateT(..), runStateT)
31
31
import Control.Plus (empty , (<|>))
32
32
import Data.Either (Either (..))
33
33
import Data.Foldable (class Foldable , foldl )
34
- import Data.List (List (..), many , reverse , (:))
34
+ import Data.List (List (..), many , manyRec , reverse , (:))
35
35
import Data.List.NonEmpty (NonEmptyList )
36
36
import Data.List.NonEmpty as NEL
37
37
import Data.Maybe (Maybe (..))
38
38
import Data.Newtype (unwrap )
39
39
import Data.Tuple (Tuple (..))
40
+ import Data.Tuple.Nested (type (/\), (/\))
40
41
import Text.Parsing.Parser (ParseError (..), ParseState (..), ParserT (..), fail )
41
42
42
43
-- | Provide an error message in the case of failure.
@@ -112,6 +113,10 @@ lookAhead p = (ParserT <<< ExceptT <<< StateT) \s -> do
112
113
many1 :: forall m s a . Monad m => ParserT s m a -> ParserT s m (NonEmptyList a )
113
114
many1 p = NEL .cons' <$> p <*> many p
114
115
116
+ -- | Stack-safe version of `many1` at the expense of `MonadRec` constraint
117
+ many1Rec :: forall m s a . MonadRec m => ParserT s m a -> ParserT s m (NonEmptyList a )
118
+ many1Rec p = NEL .cons' <$> p <*> manyRec p
119
+
115
120
-- | Parse phrases delimited by a separator.
116
121
-- |
117
122
-- | For example:
@@ -122,13 +127,24 @@ many1 p = NEL.cons' <$> p <*> many p
122
127
sepBy :: forall m s a sep . Monad m => ParserT s m a -> ParserT s m sep -> ParserT s m (List a )
123
128
sepBy p sep = map NEL .toList (sepBy1 p sep) <|> pure Nil
124
129
130
+ -- | Stack-safe version of `sepBy` at the expense of `MonadRec` constraint
131
+ sepByRec :: forall m s a sep . MonadRec m => ParserT s m a -> ParserT s m sep -> ParserT s m (List a )
132
+ sepByRec p sep = map NEL .toList (sepBy1Rec p sep) <|> pure Nil
133
+
125
134
-- | Parse phrases delimited by a separator, requiring at least one match.
126
135
sepBy1 :: forall m s a sep . Monad m => ParserT s m a -> ParserT s m sep -> ParserT s m (NonEmptyList a )
127
136
sepBy1 p sep = do
128
137
a <- p
129
138
as <- many $ sep *> p
130
139
pure (NEL .cons' a as)
131
140
141
+ -- | Stack-safe version of `sepBy1` at the expense of `MonadRec` constraint
142
+ sepBy1Rec :: forall m s a sep . MonadRec m => ParserT s m a -> ParserT s m sep -> ParserT s m (NonEmptyList a )
143
+ sepBy1Rec p sep = do
144
+ a <- p
145
+ as <- manyRec $ sep *> p
146
+ pure (NEL .cons' a as)
147
+
132
148
-- | Parse phrases delimited and optionally terminated by a separator.
133
149
sepEndBy :: forall m s a sep . Monad m => ParserT s m a -> ParserT s m sep -> ParserT s m (List a )
134
150
sepEndBy p sep = map NEL .toList (sepEndBy1 p sep) <|> pure Nil
@@ -168,51 +184,129 @@ sepEndBy1Rec p sep = do
168
184
endBy1 :: forall m s a sep . Monad m => ParserT s m a -> ParserT s m sep -> ParserT s m (NonEmptyList a )
169
185
endBy1 p sep = many1 $ p <* sep
170
186
187
+ -- | Stack-safe version of `endBy1` at the expense of `MonadRec` constraint
188
+ endBy1Rec :: forall m s a sep . MonadRec m => ParserT s m a -> ParserT s m sep -> ParserT s m (NonEmptyList a )
189
+ endBy1Rec p sep = many1Rec $ p <* sep
190
+
171
191
-- | Parse phrases delimited and terminated by a separator.
172
192
endBy :: forall m s a sep . Monad m => ParserT s m a -> ParserT s m sep -> ParserT s m (List a )
173
193
endBy p sep = many $ p <* sep
174
194
195
+ -- | Stack-safe version of `endBy` at the expense of `MonadRec` constraint
196
+ endByRec :: forall m s a sep . MonadRec m => ParserT s m a -> ParserT s m sep -> ParserT s m (List a )
197
+ endByRec p sep = manyRec $ p <* sep
198
+
175
199
-- | Parse phrases delimited by a right-associative operator.
176
200
-- |
177
201
-- | For example:
178
202
-- |
179
203
-- | ```purescript
180
- -- | chainr digit (string "+" * > add) 0
204
+ -- | chainr digit (string "+" $ > add) 0
181
205
-- | ```
182
206
chainr :: forall m s a . Monad m => ParserT s m a -> ParserT s m (a -> a -> a ) -> a -> ParserT s m a
183
207
chainr p f a = chainr1 p f <|> pure a
184
208
209
+ -- | Stack-safe version of `chainr` at the expense of `MonadRec` constraint.
210
+ chainrRec :: forall m s a . MonadRec m => ParserT s m a -> ParserT s m (a -> a -> a ) -> a -> ParserT s m a
211
+ chainrRec p f a = chainr1Rec p f <|> pure a
212
+
185
213
-- | Parse phrases delimited by a left-associative operator.
214
+ -- |
215
+ -- | For example:
216
+ -- |
217
+ -- | ```purescript
218
+ -- | chainr digit (string "+" $> add) 0
219
+ -- | ```
186
220
chainl :: forall m s a . Monad m => ParserT s m a -> ParserT s m (a -> a -> a ) -> a -> ParserT s m a
187
221
chainl p f a = chainl1 p f <|> pure a
188
222
223
+ -- | Stack-safe version of `chainl` at the expense of `MonadRec` constraint.
224
+ chainlRec :: forall m s a . MonadRec m => ParserT s m a -> ParserT s m (a -> a -> a ) -> a -> ParserT s m a
225
+ chainlRec p f a = chainl1Rec p f <|> pure a
226
+
189
227
-- | Parse phrases delimited by a left-associative operator, requiring at least one match.
190
228
chainl1 :: forall m s a . Monad m => ParserT s m a -> ParserT s m (a -> a -> a ) -> ParserT s m a
191
229
chainl1 p f = do
192
230
a <- p
193
- chainl1' p f a
194
-
195
- chainl1' :: forall m s a . Monad m => ParserT s m a -> ParserT s m (a -> a -> a ) -> a -> ParserT s m a
196
- chainl1' p f a =
197
- ( do
198
- f' <- f
199
- a' <- p
200
- chainl1' p f (f' a a')
201
- ) <|> pure a
231
+ chainl1' a
232
+ where
233
+ chainl1' a =
234
+ ( do
235
+ f' <- f
236
+ a' <- p
237
+ chainl1' (f' a a')
238
+ ) <|> pure a
239
+
240
+ -- | Stack-safe version of `chainl1` at the expense of `MonadRec` constraint.
241
+ chainl1Rec :: forall m s a . MonadRec m => ParserT s m a -> ParserT s m (a -> a -> a ) -> ParserT s m a
242
+ chainl1Rec p f = do
243
+ a <- p
244
+ tailRecM go a
245
+ where
246
+ go :: a -> ParserT s m (Step a a )
247
+ go a =
248
+ ( do
249
+ op <- f
250
+ a' <- p
251
+ pure $ Loop $ op a a'
252
+ )
253
+ <|> pure (Done a)
202
254
203
255
-- | Parse phrases delimited by a right-associative operator, requiring at least one match.
204
256
chainr1 :: forall m s a . Monad m => ParserT s m a -> ParserT s m (a -> a -> a ) -> ParserT s m a
205
257
chainr1 p f = do
206
258
a <- p
207
- chainr1' p f a
208
-
209
- chainr1' :: forall m s a . Monad m => ParserT s m a -> ParserT s m (a -> a -> a ) -> a -> ParserT s m a
210
- chainr1' p f a =
211
- ( do
212
- f' <- f
213
- a' <- chainr1 p f
214
- pure $ f' a a'
215
- ) <|> pure a
259
+ chainr1' a
260
+ where
261
+ chainr1' a =
262
+ ( do
263
+ f' <- f
264
+ a' <- chainr1 p f
265
+ pure $ f' a a'
266
+ ) <|> pure a
267
+
268
+ -- | Stack-safe version of `chainr1` at the expense of `MonadRec` constraint.
269
+ chainr1Rec :: forall m s a . MonadRec m => ParserT s m a -> ParserT s m (a -> a -> a ) -> ParserT s m a
270
+ chainr1Rec p f = do
271
+ a <- p
272
+ tailRecM go { last: a, init: Nil }
273
+ where
274
+ -- This looks scary at first glance, so I'm leaving a comment in a vain
275
+ -- attempt to explain how it works.
276
+ --
277
+ -- The loop state is a record {init, last}, where `last` is the last (i.e.
278
+ -- rightmost) `a` value that has been parsed so far, and `init` is a list of
279
+ -- (value + operator) pairs that have been parsed before that.
280
+ --
281
+ -- The very first value is parsed at top level, and it becomes the initial
282
+ -- value of `last`, while the initial value of `init` is just `Nil`,
283
+ -- indicating that no pairs of (value + operator) have been parsed yet.
284
+ --
285
+ -- At every step, we parse an operator and a value, and then the newly parsed
286
+ -- value becomes `last` (because, well, it's been parsed last), and the pair
287
+ -- of (previous last + operator) is prepended to `init`.
288
+ --
289
+ -- After we can no longer parse a pair of (value + operation), we're done. At
290
+ -- that point, we have a list of (value + operation) pairs in reverse order
291
+ -- (since we prepend each pair as we go) and the very last value. All that's
292
+ -- left is combine them all via `foldl`.
293
+ go
294
+ :: { init :: List (a /\ (a -> a -> a )), last :: a }
295
+ -> ParserT s m
296
+ ( Step
297
+ { init :: List (a /\ (a -> a -> a )), last :: a }
298
+ a
299
+ )
300
+ go { last, init } =
301
+ ( do
302
+ op <- f
303
+ a <- p
304
+ pure $ Loop { last: a, init: (last /\ op) : init }
305
+ )
306
+ <|> pure (Done $ foldl apply last init)
307
+
308
+ apply :: a -> (a /\ (a -> a -> a )) -> a
309
+ apply y (x /\ op) = x `op` y
216
310
217
311
-- | Parse one of a set of alternatives.
218
312
choice :: forall f m s a . Foldable f => Monad m => f (ParserT s m a ) -> ParserT s m a
@@ -222,13 +316,23 @@ choice = foldl (<|>) empty
222
316
skipMany :: forall s a m . Monad m => ParserT s m a -> ParserT s m Unit
223
317
skipMany p = skipMany1 p <|> pure unit
224
318
319
+ -- | Stack-safe version of `skipMany` at the expense of `MonadRec` constraint.
320
+ skipManyRec :: forall s a m . MonadRec m => ParserT s m a -> ParserT s m Unit
321
+ skipManyRec p = skipMany1Rec p <|> pure unit
322
+
225
323
-- | Skip at least one instance of a phrase.
226
324
skipMany1 :: forall s a m . Monad m => ParserT s m a -> ParserT s m Unit
227
325
skipMany1 p = do
228
326
_ <- p
229
327
_ <- skipMany p
230
328
pure unit
231
329
330
+ -- | Stack-safe version of `skipMany1` at the expense of `MonadRec` constraint.
331
+ skipMany1Rec :: forall s a m . MonadRec m => ParserT s m a -> ParserT s m Unit
332
+ skipMany1Rec p = p *> tailRecM go unit
333
+ where
334
+ go _ = (p $> Loop unit) <|> pure (Done unit)
335
+
232
336
-- | Fail if the specified parser matches.
233
337
notFollowedBy :: forall s a m . Monad m => ParserT s m a -> ParserT s m Unit
234
338
notFollowedBy p = try $ (try p *> fail " Negated parser succeeded" ) <|> pure unit
0 commit comments