diff --git a/src/Parser.hs b/src/Parser.hs index 678b46b..513a781 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -73,12 +73,14 @@ parseOneExpression = scnParserM *> parseExpressionM scnParserM :: ParserM () scnParserM = skipMany $ do - t <- lookAhead anySingle + t <- lookAhead anySingle st <- get - if depth st > 0 && isNewline t - then void (satisfyM isNewline) - else - fail "In paren context or no space token" <|> empty + if | depth st > 0 && case t of + LNewline -> True + _ -> False -> void $ satisfyM $ \case + LNewline -> True + _ -> False + | otherwise -> fail "In paren context or no space token" <|> empty eofM :: ParserM () eofM = lift eof @@ -96,23 +98,32 @@ parseExpressionM = choice parseFunctionM :: ParserM TricuAST parseFunctionM = do - LIdentifier name <- satisfyM isIdentifier - args <- many (satisfyM isIdentifier) + LIdentifier name <- satisfyM $ \case + LIdentifier _ -> True + _ -> False + args <- many $ satisfyM $ \case + LIdentifier _ -> True + _ -> False _ <- satisfyM (== LAssign) scnParserM body <- parseExpressionM pure (SFunc name (map getIdentifier args) body) parseLambdaM :: ParserM TricuAST -parseLambdaM = between (satisfyM (== LOpenParen)) (satisfyM (== LCloseParen)) $ do - _ <- satisfyM (== LBackslash) - param <- satisfyM isIdentifier - rest <- many (satisfyM isIdentifier) - _ <- satisfyM (== LColon) - scnParserM - body <- parseLambdaExpressionM - let nested = foldr (\v acc -> SLambda [getIdentifier v] acc) body rest - pure (SLambda [getIdentifier param] nested) +parseLambdaM = + between (satisfyM (== LOpenParen)) (satisfyM (== LCloseParen)) $ do + _ <- satisfyM (== LBackslash) + param <- satisfyM $ \case + LIdentifier _ -> True + _ -> False + rest <- many $ satisfyM $ \case + LIdentifier _ -> True + _ -> False + _ <- satisfyM (== LColon) + scnParserM + body <- parseLambdaExpressionM + let nested = foldr (\v acc -> SLambda [getIdentifier v] acc) body rest + pure (SLambda [getIdentifier param] nested) parseLambdaExpressionM :: ParserM TricuAST parseLambdaExpressionM = choice @@ -158,8 +169,10 @@ parseAtomicBaseM = choice parseTreeLeafM :: ParserM TricuAST parseTreeLeafM = do - _ <- satisfyM isKeywordT - notFollowedBy (lift (satisfy (== LAssign))) + _ <- satisfyM $ \case + LKeywordT -> True + _ -> False + notFollowedBy $ lift $ satisfy (== LAssign) pure TLeaf parseTreeTermM :: ParserM TricuAST @@ -221,7 +234,10 @@ parseGroupedItemM = do parseSingleItemM :: ParserM TricuAST parseSingleItemM = do - token <- satisfyM isListItem + token <- satisfyM $ \case + LIdentifier _ -> True + LKeywordT -> True + _ -> False case token of LIdentifier name -> pure (SVar name) LKeywordT -> pure TLeaf @@ -229,51 +245,27 @@ parseSingleItemM = do parseVarM :: ParserM TricuAST parseVarM = do - LIdentifier name <- satisfyM isIdentifier + LIdentifier name <- satisfyM $ \case + LIdentifier _ -> True + _ -> False if name == "t" || name == "__result" then fail ("Reserved keyword: " ++ name ++ " cannot be assigned.") else pure (SVar name) parseIntLiteralM :: ParserM TricuAST parseIntLiteralM = do - LIntegerLiteral value <- satisfyM isIntegerLiteral + LIntegerLiteral value <- satisfyM $ \case + LIntegerLiteral _ -> True + _ -> False pure (SInt value) parseStrLiteralM :: ParserM TricuAST parseStrLiteralM = do - LStringLiteral value <- satisfyM isStringLiteral + LStringLiteral value <- satisfyM $ \case + LStringLiteral _ -> True + _ -> False pure (SStr value) -isKeywordT :: LToken -> Bool -isKeywordT LKeywordT = True -isKeywordT _ = False - -isIdentifier :: LToken -> Bool -isIdentifier (LIdentifier _) = True -isIdentifier _ = False - -isIntegerLiteral :: LToken -> Bool -isIntegerLiteral (LIntegerLiteral _) = True -isIntegerLiteral _ = False - -isStringLiteral :: LToken -> Bool -isStringLiteral (LStringLiteral _) = True -isStringLiteral _ = False - -isLiteral :: LToken -> Bool -isLiteral (LIntegerLiteral _) = True -isLiteral (LStringLiteral _) = True -isLiteral _ = False - -isListItem :: LToken -> Bool -isListItem (LIdentifier _) = True -isListItem LKeywordT = True -isListItem _ = False - -isNewline :: LToken -> Bool -isNewline LNewline = True -isNewline _ = False - getIdentifier :: LToken -> String getIdentifier (LIdentifier name) = name getIdentifier _ = error "Expected identifier" diff --git a/tricu.cabal b/tricu.cabal index 0e99a6e..76ee20d 100644 --- a/tricu.cabal +++ b/tricu.cabal @@ -18,6 +18,7 @@ executable tricu src default-extensions: DeriveDataTypeable + LambdaCase MultiWayIf OverloadedStrings ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC @@ -44,6 +45,7 @@ test-suite tricu-tests hs-source-dirs: test, src default-extensions: DeriveDataTypeable + LambdaCase MultiWayIf OverloadedStrings build-depends: