Stop using lists to represent args

src/Parser.hs

@@ -1,5 +1,7 @@
 module Parser where
 
+import Debug.Trace
+
 import Lexer
 import Research hiding (toList)
 
@@ -13,15 +15,16 @@ import Text.Megaparsec.Error (errorBundlePretty, ParseErrorBundle)
 
 type Parser = Parsec Void [LToken]
 data SaplingAST
-  = SVar String
-  | SInt Int
-  | SStr String
-  | SList [SaplingAST]
-  | SFunc String [String] SaplingAST
-  | SApp SaplingAST [SaplingAST]
+  = SVar    String
+  | SInt    Int
+  | SStr    String
+  | SList   [SaplingAST]
+  | SFunc   String       [String]     SaplingAST
+  | SApp    SaplingAST   SaplingAST
   | TLeaf
-  | TStem SaplingAST
-  | TFork SaplingAST SaplingAST
+  | TStem   SaplingAST
+  | TFork   SaplingAST   SaplingAST
+  | SLambda [String]     SaplingAST
   deriving (Show, Eq, Ord)
 
 parseSapling :: String -> [SaplingAST]
@@ -41,10 +44,11 @@ scnParser = skipMany (satisfy isNewline)
 parseExpression :: Parser SaplingAST
 parseExpression = choice
   [ try parseFunction
+  , try parseLambda
+  , try parseListLiteral
   , try parseApplication
-  , parseTreeTerm
+  , try parseTreeTerm
   , parseLiteral
-  , parseListLiteral
   ]
 
 parseFunction :: Parser SaplingAST
@@ -55,24 +59,54 @@ parseFunction = do
   body <- parseExpression
   return (SFunc name (map getIdentifier args) body)
 
+parseLambda :: Parser SaplingAST
+parseLambda = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) $ do
+  satisfy (== LBackslash)
+  param <- satisfy isIdentifier
+  rest <- many (satisfy isIdentifier)
+  satisfy (== LColon)
+  body <- parseLambdaExpression
+  let nestedLambda = foldr (\v acc -> SLambda [v] acc) body (map getIdentifier rest)
+  return (SLambda [getIdentifier param] nestedLambda)
+
+parseLambdaExpression :: Parser SaplingAST
+parseLambdaExpression = choice
+  [ try parseLambdaApplication
+  , parseAtomicLambda
+  ]
+
+parseAtomicLambda :: Parser SaplingAST
+parseAtomicLambda = choice
+  [ parseVar
+  , parseTreeLeaf
+  , parseLiteral
+  , parseListLiteral
+  , between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseLambdaExpression
+  ]
+
 parseApplication :: Parser SaplingAST
 parseApplication = do
   func <- parseAtomicBase
-  args <- many parseAtomicApplication
-  case func of
-    TLeaf | not (null args) && all isTreeTerm args -> fail "Defer to Tree Calculus"
-    _ -> return (SApp func args)
+  args <- many parseAtomic
+  return $ foldl (\acc arg -> SApp acc arg) func args
+
+parseLambdaApplication :: Parser SaplingAST
+parseLambdaApplication = do
+    func <- parseAtomicLambda
+    args <- many parseAtomicLambda
+    return $ foldl (\acc arg -> SApp acc arg) func args
 
 isTreeTerm :: SaplingAST -> Bool
-isTreeTerm TLeaf = True
-isTreeTerm (TStem _) = True
+isTreeTerm TLeaf       = True
+isTreeTerm (TStem _)   = True
 isTreeTerm (TFork _ _) = True
-isTreeTerm _ = False
+isTreeTerm _           = False
 
 parseAtomicBase :: Parser SaplingAST
 parseAtomicBase = choice
   [ parseVar
   , parseTreeLeaf
+  , parseGrouped
   ]
 
 parseTreeLeaf :: Parser SaplingAST
@@ -107,27 +141,15 @@ foldTree (x:y:rest) = TFork x (foldTree (y:rest))
 parseAtomic :: Parser SaplingAST
 parseAtomic = choice
   [ parseVar
-  , parseTreeLeafOrParenthesized
-  , parseLiteral
+  , parseTreeLeaf
   , parseListLiteral
-  , between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseExpression
+  , parseGrouped
+  , parseLiteral
   ]
 
-parseAtomicApplication :: Parser SaplingAST
-parseAtomicApplication = do
-  token <- anySingle
-  case token of
-    LAssign -> fail
-      "Unexpected `=` character in application context. \
-      \ This is usually caused by an incomplete definition such as: \
-      \ `function a b =`"
-    LIdentifier name -> return (SVar name)
-    LKeywordT -> return TLeaf
-    LIntegerLiteral value -> return (SInt value)
-    LStringLiteral value -> return (SStr value)
-    LOpenBracket -> parseListLiteral
-    LOpenParen -> between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseExpression
-    _ -> fail "Invalid token while parsing attempted function application"
+
+parseGrouped :: Parser SaplingAST
+parseGrouped = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseExpression
 
 parseLiteral :: Parser SaplingAST
 parseLiteral = choice