summaryrefslogtreecommitdiff
path: root/src/Parser.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-02-20 22:28:55 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2023-02-20 22:28:55 +0100
commitb27bbb421aa9806d1f3d6a524968a2f2df092b8e (patch)
tree48071f31a2d85c36cafa6a745e99e1eb272e41c4 /src/Parser.hs
parent82e4bdcaaefa88913a0dacf3496747251909219f (diff)
Range enumeration syntax for lists
Diffstat (limited to 'src/Parser.hs')
-rw-r--r--src/Parser.hs31
1 files changed, 27 insertions, 4 deletions
diff --git a/src/Parser.hs b/src/Parser.hs
index 9ba702b..0bc5995 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -75,7 +75,7 @@ osymbol str = void $ try $ (string (TL.pack str) <* notFollowedBy operatorChar)
wsymbol str = void $ try $ (string (TL.pack str) <* notFollowedBy wordChar) <* sc
operatorChar :: (MonadParsec e s m, Token s ~ Char) => m (Token s)
-operatorChar = satisfy $ (`elem` ['+', '-', '*', '/', '='])
+operatorChar = satisfy $ (`elem` ['.', '+', '-', '*', '/', '='])
{-# INLINE operatorChar #-}
localState :: TestParser a -> TestParser a
@@ -212,13 +212,36 @@ list :: TestParser SomeExpr
list = label "list" $ do
symbol "["
SomeExpr x <- someExpr
+
+ let enumErr off = parseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $
+ "list range enumeration not defined for '" <> textExprType x <> "'"
choice
[do symbol "]"
return $ SomeExpr $ UnOp (:[]) x
- ,do symbol ","
- xs <- listOf typedExpr
+
+ ,do off <- stateOffset <$> getParserState
+ osymbol ".."
+ ExprEnumerator fromTo _ <- maybe (enumErr off) return $ exprEnumerator x
+ y <- typedExpr
symbol "]"
- return $ SomeExpr $ foldr (BinOp (:)) (Literal []) (x:xs)
+ return $ SomeExpr $ UnOp fromTo x `App` y
+
+ ,do symbol ","
+ y <- typedExpr
+
+ choice
+ [do off <- stateOffset <$> getParserState
+ osymbol ".."
+ ExprEnumerator _ fromThenTo <- maybe (enumErr off) return $ exprEnumerator x
+ z <- typedExpr
+ symbol "]"
+ return $ SomeExpr $ UnOp fromThenTo x `App` y `App` z
+
+ ,do symbol ","
+ xs <- listOf typedExpr
+ symbol "]"
+ return $ SomeExpr $ foldr (BinOp (:)) (Literal []) (x:y:xs)
+ ]
]
data SomeExpr = forall a. ExprType a => SomeExpr (Expr a)