From a1e0b0e5071f851c865ae567de7a28014a1eafc4 Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Sun, 22 Mar 2026 16:05:42 +0100 Subject: Add strings handling --- .../haskell/test/Minilang/Lambda/ParserSpec.hs | 123 ++++++++++++++++++++- 1 file changed, 121 insertions(+), 2 deletions(-) (limited to 'lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs') 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 -- cgit v1.3.1