Make the parser produce a subtly better AST.

This is done by requiring applications to be at least 2 terms,
and making grouping a syntactic feature instead of a feature of applications.

I also made the code a bit more clear by handling whitespace a bit more cleanly;
now, each parser is responsible for its own trailing whitespace,
and whitespace handling is pushed down to the token level
to avoid cluttering high-level definitions with whitespace stuff.

This all also had the effect of improving error messages,
in part due to me labelling many of the parsers.

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.

package.yaml

@@ -13,6 +13,7 @@ extra-source-files:
 - README.md
 
 default-extensions:
+- BlockArguments
 - ImportQualifiedPost
 - OverloadedStrings
 - ViewPatterns

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

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")))