1 files changed, 25 insertions, 3 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
index a0cc577..bf92daa 100644
--- a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
+++ b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
@@ -14,8 +14,8 @@ import Data.Void (Void)
 import GHC.Generics (Generic)
 import Minilang.Lambda.Eval (Term)
 import qualified Minilang.Lambda.Eval as Eval
-import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, parse, some, try)
-import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, symbolChar)
+import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, optional, parse, some, try)
+import Text.Megaparsec.Char (alphaNumChar, char, digitChar, letterChar, space1, symbolChar)
 import qualified Text.Megaparsec.Char.Lexer as L
 
 type Parser = Parsec Void Text
@@ -25,6 +25,7 @@ data ParseError = ParseError Text
 
 data AST
   = Sym Text
+  | Lit Int
   | Abs [Text] AST
   | App AST AST [AST]
   | Def Text AST
@@ -33,6 +34,7 @@ data AST
 desugar :: AST -> Term
 desugar = \case
   Sym symb -> Eval.Var symb
+  Lit n -> Eval.Num n
   Abs bound body ->
     foldr
       Eval.Lam
@@ -49,6 +51,7 @@ desugar = \case
 resugar :: Term -> AST
 resugar = \case
   Eval.Var s -> Sym s
+  Eval.Num n -> Lit n
   Eval.Lam x body -> case resugar body of
     Abs vars ast -> Abs (x : vars) ast
     other -> Abs [x] other
@@ -63,10 +66,17 @@ resugar = \case
 pretty :: AST -> Text
 pretty = \case
   Sym symb -> symb
+  Lit n -> prettyInt n
   Abs bound body -> "(lam (" <> Text.unwords bound <> ") " <> pretty body <> ")"
   App x y rest -> "(" <> mconcat (List.intersperse " " (pretty <$> (x : y : rest))) <> ")"
   Def name body -> "(def " <> name <> " " <> pretty body <> ")"
 
+-- | Render an integer with no space between '-' and digits for negative numbers.
+prettyInt :: Int -> Text
+prettyInt n
+  | n < 0     = "-" <> Text.pack (show (abs n))
+  | otherwise = Text.pack (show n)
+
 parseProgram :: Text -> Either ParseError [AST]
 parseProgram input =
   first (ParseError . pack . errorBundlePretty) $
@@ -77,7 +87,7 @@ parse =
   first (ParseError . pack . errorBundlePretty) . Text.Megaparsec.parse ast ""
 
 ast :: Parser AST
-ast = try defExpr <|> try letExpr <|> try lambda <|> try sym <|> try app
+ast = try defExpr <|> try letExpr <|> try lambda <|> try lit <|> try sym <|> try app
 
 app :: Parser AST
 app =
@@ -141,6 +151,18 @@ rpar = symbol ")"
 symbol :: Text -> Parser Text
 symbol = L.symbol spaceConsumer
 
+-- | Parse an integer literal.  The minus sign, if present, must immediately
+-- precede the digits with no intervening whitespace; this distinguishes @-7@
+-- (a negative number) from @- 7@ (the identifier @-@ applied to @7@).
+lit :: Parser AST
+lit = lexeme $ do
+  sign <- optional (char '-')
+  digits <- some digitChar
+  let n = read digits
+  pure $ Lit $ case sign of
+    Just _  -> negate n
+    Nothing -> n
+
 sym :: Parser AST
 sym = Sym . pack <$> identifier