Add strings handling

1 files changed, 121 insertions, 2 deletions

diff --git a/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs b/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
index 08ec661..40866bb 100644
--- a/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
+++ b/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
@@ -10,7 +10,7 @@ import Data.Text (Text, pack)
 import qualified Data.Text as Text
 import Minilang.Lambda.Eval (Term (Lam))
 import qualified Minilang.Lambda.Eval as Eval
-import Minilang.Lambda.Parser (AST (..), desugar, initialChars, parse, parseProgram, pretty, restChars)
+import Minilang.Lambda.Parser (AST (..), desugar, initialChars, parse, parseProgram, pretty, restChars, escapeString)
 import Minilang.Lambda.Eval (normalise)
 import Test.Hspec (Spec, describe, it, parallel, shouldBe, shouldSatisfy)
 import Test.Hspec.QuickCheck (prop)
@@ -175,6 +175,115 @@ spec = parallel $ do
     it "pretty (+ 1) is \"(+ 1)\"" $
       pretty (App (Sym "+") (Lit 1) []) `shouldBe` "(+ 1)"
 
+  describe "string literals" $ do
+    -- Round-trip: parse . pretty == id for all safe StrLit values
+    prop "any StrLit rendered by pretty parses back to the same StrLit" $
+      forAll genStrLit $ \ast ->
+        parse (pretty ast) === Right ast
+
+    it "parses empty string literal" $
+      parse "\"\"" `shouldBe` Right (StrLit "")
+
+    it "parses simple string literal" $
+      parse "\"hello\"" `shouldBe` Right (StrLit "hello")
+
+    it "parses string with spaces" $
+      parse "\"foo bar\"" `shouldBe` Right (StrLit "foo bar")
+
+    it "parses escaped double-quote inside string" $
+      parse "\"say \\\"hi\\\"\"" `shouldBe` Right (StrLit "say \"hi\"")
+
+    it "parses escaped backslash inside string" $
+      parse "\"back\\\\slash\"" `shouldBe` Right (StrLit "back\\slash")
+
+    it "pretty-prints string with double-quote escaped" $
+      pretty (StrLit "say \"hi\"") `shouldBe` "\"say \\\"hi\\\"\""
+
+    it "pretty-prints string with backslash escaped" $
+      pretty (StrLit "back\\slash") `shouldBe` "\"back\\\\slash\""
+
+    -- desugar / normalise
+    it "desugar and normalise string self-evaluates" $
+      normalise (desugar (StrLit "hello")) `shouldBe` Eval.Str "hello"
+
+    it "desugar and normalise str-concat" $
+      normalise (desugar (App (Sym "str-concat") (StrLit "foo") [StrLit "bar"]))
+        `shouldBe` Eval.Str "foobar"
+
+    it "desugar and normalise str-length" $
+      normalise (desugar (App (Sym "str-length") (StrLit "hello") []))
+        `shouldBe` Eval.Num 5
+
+    it "desugar and normalise str-slice" $
+      normalise (desugar (App (Sym "str-slice") (Lit 1) [Lit 3, StrLit "abcde"]))
+        `shouldBe` Eval.Str "bc"
+
+    it "desugar and normalise str= equal strings gives Church True" $
+      normalise (desugar (App (Sym "str=") (StrLit "abc") [StrLit "abc"]))
+        `shouldBe` Eval.Lam "f" (Eval.Lam "t" (Eval.Var "t"))
+
+    it "desugar and normalise str= unequal strings gives Church False" $
+      normalise (desugar (App (Sym "str=") (StrLit "abc") [StrLit "xyz"]))
+        `shouldBe` Eval.Lam "f" (Eval.Lam "t" (Eval.Var "f"))
+
+    it "partial str-concat pretty-prints as application" $
+      pretty (App (Sym "str-concat") (StrLit "hello") [])
+        `shouldBe` "(str-concat \"hello\")"
+
+  describe "strings containing parentheses" $ do
+    -- The parser must not treat ( or ) inside a string literal as
+    -- delimiters for an application or lambda expression.
+
+    it "parses a string containing only an opening paren" $
+      parse "\"(\"" `shouldBe` Right (StrLit "(")
+
+    it "parses a string containing only a closing paren" $
+      parse "\")\"" `shouldBe` Right (StrLit ")")
+
+    it "parses a string containing balanced parens" $
+      parse "\"(hello)\"" `shouldBe` Right (StrLit "(hello)")
+
+    it "parses a string containing doubly-nested parens" $
+      parse "\"((nested))\"" `shouldBe` Right (StrLit "((nested))")
+
+    it "parses a string containing unbalanced parens" $
+      parse "\"a(b\"" `shouldBe` Right (StrLit "a(b")
+
+    it "parses a string that looks like a lambda expression" $
+      parse "\"(lam (x) x)\"" `shouldBe` Right (StrLit "(lam (x) x)")
+
+    it "parses a string that looks like an application" $
+      parse "\"(f x)\"" `shouldBe` Right (StrLit "(f x)")
+
+    -- Round-trip: pretty-printing a StrLit with parens re-parses correctly
+    it "pretty-prints and re-parses string with opening paren" $
+      parse (pretty (StrLit "(")) `shouldBe` Right (StrLit "(")
+
+    it "pretty-prints and re-parses string with balanced parens" $
+      parse (pretty (StrLit "(hello)")) `shouldBe` Right (StrLit "(hello)")
+
+    it "pretty-prints and re-parses string with doubly-nested parens" $
+      parse (pretty (StrLit "((x))")) `shouldBe` Right (StrLit "((x))")
+
+    -- Property: any string containing only parens and letters round-trips
+    prop "strings with parentheses round-trip through pretty and parse" $
+      forAll (StrLit . Text.pack <$> listOf (elements "abcdef()")) $ \ast ->
+        parse (pretty ast) === Right ast
+
+    -- The paren-containing string is correctly passed through an application
+    it "paren string survives beta-reduction" $
+      normalise (desugar (App (Abs ["x"] (Sym "x")) (StrLit "(hello)") []))
+        `shouldBe` Eval.Str "(hello)"
+
+    -- str-concat of two paren strings
+    it "str-concat of paren strings produces correct result" $
+      normalise (desugar (App (Sym "str-concat") (StrLit "(") [StrLit ")"]))
+        `shouldBe` Eval.Str "()"
+
+    it "str-length of paren string counts parens" $
+      normalise (desugar (App (Sym "str-length") (StrLit "(hello)") []))
+        `shouldBe` Eval.Num 7
+
   it "parses multiline program with blank lines" $ do
     let program =
           "(def id (lam (x) x))\n\
@@ -230,6 +339,7 @@ instance Arbitrary AST where
   shrink = \case
     Sym _ -> []
     Lit _ -> []
+    StrLit _ -> []
     Abs bind body -> case shrink (Identifier <$> bind) of
       [] -> shrink body
       bind' ->
@@ -245,15 +355,24 @@ instance Arbitrary AST where
     Def _name body -> shrink body -- never generated
 
 genAst :: Int -> Gen AST
-genAst 0 = oneof [Sym . unIdent <$> arbitrary, Lit <$> arbitrary]
+genAst 0 = oneof [Sym . unIdent <$> arbitrary, Lit <$> arbitrary, genStrLit]
 genAst depth =
   oneof
     [ Sym . unIdent <$> arbitrary
     , Lit <$> arbitrary
+    , genStrLit
     , genAbstraction depth
     , genApplication depth
     ]
 
+-- | Generate a random string literal. We restrict the alphabet to printable
+-- ASCII excluding @\"@ and @\\@ to keep round-trip tests simple; the escape
+-- logic is tested separately.
+genStrLit :: Gen AST
+genStrLit = StrLit . pack <$> listOf (elements safeChars)
+  where
+    safeChars = filter (\c -> c /= '"' && c /= '\\') [' '..'~']
+
 genDef :: Int -> Gen AST
 genDef n = Def . unIdent <$> arbitrary <*> genAst n