commit efc35ad1105f9fa62017806adc9fcb9b5b96133d
parent c70d21a9968a3521a4b5cd4b9fb6d3a988c204c2
Author: Robert Russell <robert@rr3.xyz>
Date: Thu, 29 Aug 2024 20:47:43 -0700
Add some combinators; remove some others
In particular, I forgot optional in Control.Applicative is a
thing, so we didn't need "opt".
Diffstat:
3 files changed, 33 insertions(+), 14 deletions(-)
diff --git a/README b/README
@@ -2,5 +2,9 @@ Simple Haskell parser combinator library
I use this for toy PL experiments. It's not particularly special.
+Some of the combinators are inspired by/taken from flatparse [1].
+
See the example directory for an example of parsing a sequent-based language
similar to Downen and Ariola's System CD.
+
+[1] https://github.com/AndrasKovacs/flatparse
diff --git a/Sparsec.hs b/Sparsec.hs
@@ -205,6 +205,9 @@ p `catch` h = ParseT \input loc ->
--------------------------------------------------------------------------------
-- General parse combinators
+eof :: Monad m => ParseT e m ()
+eof = (ByteString.null <$> read) >>= guard
+
-- Run a parser without changing the parser state.
lookahead :: Monad m => ParseT e m a -> ParseT e m a
lookahead p = do
@@ -236,25 +239,37 @@ p `cut` e = p <|> err e
try :: Monad m => ParseT e m a -> ParseT e m a
try p = p `catch` \_ -> fail
-opt :: Monad m => ParseT e m a -> ParseT e m (Maybe a)
-opt p = (Just <$> p) <|> pure Nothing
-
-eof :: Monad m => ParseT e m ()
-eof = (ByteString.null <$> read) >>= guard
-
+-- Iterate a parsing function until it fails. I.e.,
+-- iter f a = pure a >>= f >>= f >>= ...
+-- where the chain of binds is as long as possible without failure.
iter :: Monad m => (a -> ParseT e m a) -> a -> ParseT e m a
iter f a = (f a >>= iter f) <|> pure a
--- (branch pc pt pf) runs pc; if it succeeds, it continues with pc, and
+-- Parse a `b` and then zero or more `a`s, and then combine in a left-nested
+-- fashion.
+chainl :: Monad m => (b -> a -> b) -> ParseT e m b -> ParseT e m a -> ParseT e m b
+chainl f pb pa = pb >>= iter \b -> (f b <$> pa)
+
+-- Parse zero or more `a`s (greedily) and then a `b`, and then combine in a
+-- right-nested fashion.
+chainr :: Monad m => (a -> b -> b) -> ParseT e m a -> ParseT e m b -> ParseT e m b
+chainr f pa pb = f <$> pa <*> chainr f pa pb <|> pb
+
+-- `branch pc pt pf` runs pc; if it succeeds, it continues with pt, and
-- otherwise it continues with pf.
branch :: Monad m => ParseT e m a -> ParseT e m b -> ParseT e m b -> ParseT e m b
branch pc pt pf = pc *> pt <|> pf
-someUntil :: Monad m => ParseT e m a -> ParseT e m b -> ParseT e m [a]
-someUntil p end = some (notp end *> p)
+choice :: (Monad m, Foldable t) => t (ParseT e m a) -> ParseT e m a
+choice = asum
-manyUntil :: Monad m => ParseT e m a -> ParseT e m b -> ParseT e m [a]
-manyUntil p end = many (notp end *> p)
+-- `match scrut cases` binds scrut to the first non-failing case and returns
+-- the result.
+match :: (Monad m, Functor t, Foldable t)
+ => ParseT e m a
+ -> t (a -> ParseT e m b)
+ -> ParseT e m b
+match scrut cases = choice $ (scrut >>=) <$> cases
someSepBy :: Monad m => ParseT e m a -> ParseT e m b -> ParseT e m [a]
someSepBy p sep = (:) <$> p <*> many (sep *> p)
diff --git a/example/Main.hs b/example/Main.hs
@@ -76,7 +76,7 @@ pIdent = do
guard $ not $ isKw x
pure x
pDelim l p r = pSym l *> (p <* pSym r) `cut` Err
-pManySepByWithTrailer p sep = p `someSepBy` sep <* opt sep <|> pure []
+pManySepByWithTrailer p sep = p `someSepBy` sep <* optional sep <|> pure []
pList p = p `pManySepByWithTrailer` pSym ","
pXtorName = XtorName <$> pToken (char '#' *> pWord `cut` Err)
@@ -126,7 +126,7 @@ pKind = \case
pTypeLam = do
pSym "\\"
x <- pTypeName `cut` Err
- mk <- opt (pSym ":" *> pKind 0 `cut` Err)
+ mk <- optional (pSym ":" *> pKind 0 `cut` Err)
pSym "=>" `cut` Err
body <- pType 0 `cut` Err
pure $ TypeLam x mk body
@@ -150,7 +150,7 @@ pCase = do
pTermMu = do
pSym "\\"
x <- pTermName `cut` Err
- ma <- opt (pSym ":" *> pType 1 `cut` Err)
+ ma <- optional (pSym ":" *> pType 1 `cut` Err)
pSym "=>" `cut` Err
body <- pStmt `cut` Err
pure $ TermMu x ma body
