diff --git a/README.md b/README.md index 6e9ff13..10bc8e8 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# James Martin's Lambda Calculus +# Lambda Calculus This is a simple implementation of the untyped lambda calculus with an emphasis on clear, readable Haskell code. @@ -15,13 +15,15 @@ y y y >> (\x y z. x y) y λy' z. y y' +>> let fix = (\x. x x) \fix f x. f (fix fix f) x; S = \n f x. f (n f x); plus = fix \plus x. x S in plus (\f x. f (f (f x))) (\f x. f (f x)) f x +f (f (f (f (f x)))) >> ^C ``` ## Notation [Conventional Lambda Calculus notation applies](https://en.wikipedia.org/wiki/Lambda_calculus_definition#Notation), with the exception that variable names are multiple characters long, -`\` is used in lieu of `λ` to make it easier to type, +`\` is permitted in lieu of `λ` to make it easier to type, and spaces are used to separate variables rather than commas. * Variable names are alphanumeric, beginning with a letter. diff --git a/package.yaml b/package.yaml index 326d3da..2b5bd45 100644 --- a/package.yaml +++ b/package.yaml @@ -13,6 +13,7 @@ extra-source-files: - README.md default-extensions: +- BlockArguments - ImportQualifiedPost - OverloadedStrings - ViewPatterns diff --git a/src/LambdaCalculus/Parser.hs b/src/LambdaCalculus/Parser.hs index 5ca195f..0b29b06 100644 --- a/src/LambdaCalculus/Parser.hs +++ b/src/LambdaCalculus/Parser.hs @@ -9,64 +9,67 @@ import qualified Data.Text as T import LambdaCalculus.Expression (Expression, ast2expr) import qualified LambdaCalculus.Expression as Expr import LambdaCalculus.Parser.AbstractSyntax -import Text.Parsec hiding (spaces) -import Text.Parsec.Text +import Text.Parsec hiding (label, token) +import Text.Parsec qualified +import Text.Parsec.Text (Parser) import TextShow +label :: String -> Parser a -> Parser a +label = flip Text.Parsec.label + +token :: Char -> Parser () +token ch = label [ch] $ char ch *> spaces + keywords :: [Text] keywords = ["let", "in"] -- | A keyword is an exact string which is not part of an identifier. keyword :: Text -> Parser () -keyword kwd = do - void $ string (T.unpack kwd) - notFollowedBy letter +keyword kwd = label (T.unpack kwd) $ do + try do + string $ T.unpack kwd + notFollowedBy letter + spaces -- | An identifier is a sequence of letters which is not a keyword. identifier :: Parser Identifier -identifier = do +identifier = label "identifier" $ do notFollowedBy anyKeyword - T.pack <$> many1 letter - where anyKeyword = choice $ map (try . keyword) keywords + T.pack <$> (many1 letter <* spaces) + where anyKeyword = choice $ map keyword keywords variable :: Parser AbstractSyntax -variable = Variable <$> identifier +variable = label "variable" $ Variable <$> identifier -spaces :: Parser () -spaces = skipMany1 space +many2 :: Parser a -> Parser [a] +many2 p = (:) <$> p <*> many1 p + +grouping :: Parser AbstractSyntax +grouping = label "grouping" $ between (token '(') (token ')') expression application :: Parser AbstractSyntax -application = Application <$> sepEndBy1 applicationTerm spaces +application = Application <$> many2 applicationTerm where applicationTerm :: Parser AbstractSyntax - applicationTerm = abstraction <|> grouping <|> let_ <|> variable - where grouping :: Parser AbstractSyntax - grouping = between (char '(') (char ')') expression + applicationTerm = abstraction <|> let_ <|> grouping <|> variable abstraction :: Parser AbstractSyntax -abstraction = do - char '\\' <|> char 'λ' ; optional spaces - names <- sepEndBy1 identifier spaces - char '.' - Abstraction names <$> expression +abstraction = label "lambda abstraction" $ Abstraction <$> between lambda (token '.') (many1 identifier) <*> expression + where lambda = label "lambda" $ (char '\\' <|> char 'λ') *> spaces let_ :: Parser AbstractSyntax -let_ = do - try (keyword "let") ; spaces - defs <- sepBy1 definition (char ';' *> optional spaces) - keyword "in" - Let defs <$> expression - where definition :: Parser Definition - definition = do - name <- identifier ; optional spaces - char '=' +let_ = Let <$> between (keyword "let") (keyword "in") definitions <*> expression + where definitions :: Parser [Definition] + definitions = flip sepBy1 (token ';') do + name <- identifier + token '=' value <- expression pure (name, value) expression :: Parser AbstractSyntax -expression = optional spaces *> (abstraction <|> let_ <|> application <|> variable) <* optional spaces +expression = label "expression" $ abstraction <|> let_ <|> try application <|> grouping <|> variable parseAST :: Text -> Either ParseError AbstractSyntax -parseAST = parse (expression <* eof) "input" +parseAST = parse (spaces *> expression <* eof) "input" parseExpression :: Text -> Either ParseError Expression parseExpression = fmap ast2expr . parseAST diff --git a/test/Spec.hs b/test/Spec.hs index db692e4..87a0fb9 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -55,8 +55,6 @@ main = defaultMain $ , testGroup "Parser tests" [ testGroup "Unit tests" [ testCase "identity" $ parseExpression "\\x.x" @?= Right (Abstraction "x" $ Variable "x") - -- This syntax is forbidden because it interacts poorly with other syntax, e.g. `let x=in` becoming a valid program. - --, testCase "nullary application" $ parseExpression "()" @?= Right (Abstraction "x" $ Variable "x") , testCase "unary application" $ parseExpression "(x)" @?= Right (Variable "x") , testCase "application shorthand" $ parseExpression "a b c d" @?= Right (Application (Application (Application (Variable "a") (Variable "b")) (Variable "c")) (Variable "d")) , testCase "let" $ parseExpression "let x = \\y.y in x" @?= Right (Application (Abstraction "x" (Variable "x")) (Abstraction "y" (Variable "y")))