Added one-argument lambdas.

A lambda λ counts as an opening paren. Parens are closed at end of line. Arguments are eccessed with ¹²³⁴⁵⁶⁷⁸⁹.

Expr.hs

@@ -19,7 +19,7 @@ instance (Show lit) => Show (Exp lit) where
   show (EVar name) = name
   show (ELit lit) = show lit
   show (EApp a b) = show a ++ "(" ++ show b ++ ")"
-  show (EAbs name exp) = "(λ" ++ name ++ "." ++ show exp ++ ")"
+  show (EAbs name exp) = "(\\" ++ name ++ "." ++ show exp ++ ")"
   show (ELet name exp body) = "let " ++ name ++ "=" ++ show exp ++ " in " ++ show body
 
 -- Literal in expression

Parser.hs

@@ -4,22 +4,55 @@ module Parser where
 import Expr
 import PrattParser
 import Text.Parsec
+import Text.Parsec.Char
 import qualified Data.Map as Map
+import Data.List (elemIndex)
 
 -- Convenience alias for TFun
 infixr 9 ~>
 (~>) = TFun
 
+-- Parser state
+data PState = PState {varStack :: [ELabel],
+                      varSupply :: Int}
+
+-- Parser type
+type Parser = Parsec String PState
+
 -- Unwrapped parser, giving strings for errors
 parseExpr :: String -> Either String (Exp [Lit])
-parseExpr str = case parse expression "" str of
+parseExpr str = case runParser expression initState "" str of
   Left err -> Left $ show err
   Right val -> Right val
+  where initState = PState [] 0
+
+-- Generate and push a new expression variable
+pushNewVar :: Parser ELabel
+pushNewVar = do
+  stat <- getState
+  let var = "x" ++ show (varSupply stat)
+  putState stat{varStack = var : varStack stat,
+                varSupply = varSupply stat + 1}
+  return var
+
+-- Peek at a variable from the stack
+peekVar :: Int -> Parser ELabel
+peekVar i = (!! i) . varStack <$> getState
+
+-- Pop a variable off the stack
+popVar :: Parser ()
+popVar = do
+  stat <- getState
+  putState stat{varStack = tail $ varStack stat}
+
+-- Parse a right paren or be at end of line
+rParen :: Parser ()
+rParen = (char ')' >> return ()) <|> (lookAhead endOfLine >> return ()) <|> lookAhead eof
 
 -- Parse an expression
-expression :: Parsec String () (Exp [Lit])
+expression :: Parser (Exp [Lit])
 expression = mkPrattParser opTable term
-  where term = between (char '(') (char ')') expression <|> builtin <|> integer
+  where term = between (char '(') (char ')') expression <|> builtin <|> integer <|> lambda <|> lambdaArg
         opTable = [[InfixL $ optional (char ' ') >> return (\a b -> EApp (EApp invisibleOp a) b)]]
         invisibleOp = ELit [Lit "com2" $ Scheme ["x", "y", "z", "u"] $
                              (TVar "z" ~> TVar "u") ~>
@@ -30,8 +63,8 @@ expression = mkPrattParser opTable term
                              (TVar "x" ~> TVar "y") ~>
                              (TVar "x" ~> TVar "z"),
                             Lit "app"  $ Scheme ["x", "y"] $
-                            (TVar "x" ~> TVar "y") ~>
-                            (TVar "x" ~> TVar "y")]
+                             (TVar "x" ~> TVar "y") ~>
+                             (TVar "x" ~> TVar "y")]
 
 -- List of builtin commands
 builtins :: [(Char, Exp [Lit])]
@@ -53,15 +86,34 @@ builtins = map (fmap ELit)
            (TList (TVar "x") ~> TList (TVar "y") ~> TList (TVar "z"))])]
 
 -- Parse a builtin
-builtin :: Parsec String () (Exp [Lit])
+builtin :: Parser (Exp [Lit])
 builtin = do
   label <- oneOf $ map fst builtins
   case lookup label builtins of
     Just expr -> return expr
     Nothing -> error "Unreachable condition."
 
 -- Parse an integer
-integer :: Parsec String () (Exp [Lit])
+integer :: Parser (Exp [Lit])
 integer = do
   i <- many1 digit
   return $ ELit [Lit i $ Scheme [] $ TConc TInt]
+
+-- Parse a lambda
+lambda :: Parser (Exp [Lit])
+lambda = do
+  char 'λ'
+  var <- pushNewVar
+  expr <- expression
+  popVar
+  rParen
+  return $ EAbs var expr
+
+-- Parse a lambda argument
+lambdaArg :: Parser (Exp [Lit])
+lambdaArg = do
+  sup <- oneOf sups
+  let Just ix = elemIndex sup sups
+  var <- peekVar ix
+  return $ EVar var
+  where sups = "¹²³⁴⁵⁶⁷⁸⁹"

PrattParser.hs

@@ -6,13 +6,13 @@ import Text.Parsec (Parsec, choice, (<|>))
 import Data.List (tails)
 import Control.Applicative (pure, (<*>))
 
-data Operator t = Postfix (Parsec String () (t -> t))
-                | InfixL (Parsec String () (t -> t -> t)) -- Left associative
-                | InfixR (Parsec String () (t -> t -> t)) -- Right associative
+data Operator u t = Postfix (Parsec String u (t -> t))
+                    | InfixL (Parsec String u (t -> t -> t)) -- Left associative
+                    | InfixR (Parsec String u (t -> t -> t)) -- Right associative
 
 -- Make a Pratt parser from a precedence table and a term parser
 -- Precedence table is given from highest to lowest precedence
-mkPrattParser :: [[Operator t]] -> Parsec String () t -> Parsec String () t
+mkPrattParser :: [[Operator u t]] -> Parsec String u t -> Parsec String u t
 mkPrattParser precTable parseTerm = parseExpr precs
   where precs = reverse precTable                                                              -- We go from lowest to highest precedence
         parseExpr operators = do

main.hs

@@ -13,4 +13,4 @@ main = do
   prog <- getLine
   case parseProg prog of
     Left err -> putStrLn err
-    Right typings -> flip mapM_ typings $ \(typ, expr) -> putStrLn $ show expr ++ " :: " ++ show typ
+    Right typings -> flip mapM_ typings $ \(typ, expr) -> putStrLn $ show expr ++ " :: " ++ show typ