1 files changed, 24 insertions, 2 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
index bf92daa..b2f011b 100644
--- a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
+++ b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
@@ -14,7 +14,7 @@ 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, optional, parse, some, try)
+import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, manyTill, optional, parse, some, try)
 import Text.Megaparsec.Char (alphaNumChar, char, digitChar, letterChar, space1, symbolChar)
 import qualified Text.Megaparsec.Char.Lexer as L
 
@@ -26,6 +26,7 @@ data ParseError = ParseError Text
 data AST
   = Sym Text
   | Lit Int
+  | StrLit Text
   | Abs [Text] AST
   | App AST AST [AST]
   | Def Text AST
@@ -35,6 +36,7 @@ desugar :: AST -> Term
 desugar = \case
   Sym symb -> Eval.Var symb
   Lit n -> Eval.Num n
+  StrLit s -> Eval.Str s
   Abs bound body ->
     foldr
       Eval.Lam
@@ -52,6 +54,7 @@ resugar :: Term -> AST
 resugar = \case
   Eval.Var s -> Sym s
   Eval.Num n -> Lit n
+  Eval.Str s -> StrLit s
   Eval.Lam x body -> case resugar body of
     Abs vars ast -> Abs (x : vars) ast
     other -> Abs [x] other
@@ -67,10 +70,21 @@ pretty :: AST -> Text
 pretty = \case
   Sym symb -> symb
   Lit n -> prettyInt n
+  StrLit s -> "\"" <> escapeString s <> "\""
   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 <> ")"
 
+-- | Escape special characters in a string literal for pretty-printing.
+-- Only @\"@ and @\\@ need escaping; the parser uses 'L.charLiteral' which
+-- understands standard Haskell escape sequences.
+escapeString :: Text -> Text
+escapeString = Text.concatMap go
+  where
+    go '"'  = "\\\""
+    go '\\' = "\\\\"
+    go c    = Text.singleton c
+
 -- | Render an integer with no space between '-' and digits for negative numbers.
 prettyInt :: Int -> Text
 prettyInt n
@@ -87,7 +101,7 @@ parse =
   first (ParseError . pack . errorBundlePretty) . Text.Megaparsec.parse ast ""
 
 ast :: Parser AST
-ast = try defExpr <|> try letExpr <|> try lambda <|> try lit <|> try sym <|> try app
+ast = try defExpr <|> try letExpr <|> try lambda <|> try strLit <|> try lit <|> try sym <|> try app
 
 app :: Parser AST
 app =
@@ -163,6 +177,14 @@ lit = lexeme $ do
     Just _  -> negate n
     Nothing -> n
 
+-- | Parse a double-quoted string literal.
+-- Uses 'L.charLiteral' for each character so that standard Haskell escape
+-- sequences (e.g. @\"@, @\\@, @\n@, @\t@) are handled automatically.
+strLit :: Parser AST
+strLit = lexeme $ do
+  chars <- char '"' *> manyTill L.charLiteral (char '"')
+  pure $ StrLit $ pack chars
+
 sym :: Parser AST
 sym = Sym . pack <$> identifier