diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2023-02-20 22:28:55 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2023-02-20 22:28:55 +0100 |
commit | b27bbb421aa9806d1f3d6a524968a2f2df092b8e (patch) | |
tree | 48071f31a2d85c36cafa6a745e99e1eb272e41c4 /src/Parser.hs | |
parent | 82e4bdcaaefa88913a0dacf3496747251909219f (diff) |
Range enumeration syntax for lists
Diffstat (limited to 'src/Parser.hs')
-rw-r--r-- | src/Parser.hs | 31 |
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) |