commit 98faf1318937a356e86868f4d1c16ed1dd6ae954
parent 583f6d6d52331001ec375226710d0f53f1722f32
Author: James Eversole <james@eversole.co>
Date: Wed, 14 Oct 2026 18:41:38 -0500
Retire historical frontend tests and self-hosting comparisons
Diffstat:
2 files changed, 31 insertions(+), 772 deletions(-)
diff --git a/docs/validation.md b/docs/validation.md
@@ -12,9 +12,12 @@ Haskell lexer/parser/compiler/source loader, and recovery workspace resolution.
This makes accidental production dependencies on the recovery frontend build
failures. The test component retains those inputs during migration; the benchmark executable
also builds without recovery sources.
-The runtime-presentation tests compare constructor display with the recovery AST
-oracle and an independently written golden; runtime demand tests exercise the
-same extracted reducer used by production.
+Runtime-presentation tests use independent constructor-display goldens; runtime
+demand tests exercise the same reducer used by production. Historical Haskell
+lexer/parser/lambda-elimination tests and self-hosting differential comparisons
+are retired, not maintained as language oracles. Portable source tests retain
+their explicit expected values, locations, diagnostics and negative controls.
+Representation tests concern retained portable artifacts, not old-host parity.
```sh
nix flake check
diff --git a/test/Spec.hs b/test/Spec.hs
@@ -10,7 +10,6 @@ import ReferenceFixtures
import PackageTests (packageTests)
import InteractionInspectionTests (interactionInspectionTests)
import FileEval
-import Lexer
import Parser
import REPL
import Research
@@ -44,7 +43,6 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Word (Word8)
import Test.Tasty
import Test.Tasty.HUnit
-import Text.Megaparsec (runParser)
import Data.ByteString (ByteString)
import qualified Data.Foldable as Foldable
@@ -59,9 +57,6 @@ main = do
putStrLn "Reference-artifact tests: authenticated compiler/support snapshots, not working-tree candidate coverage."
defaultMain tests
-tricuTestString :: String -> String
-tricuTestString s = show $ result (evalTricu Map.empty $ parseTricu s)
-
testStore :: StorePath
testStore = StorePath "/tmp/tricu-test-store"
{-# NOINLINE testStore #-}
@@ -84,11 +79,7 @@ tests = testGroup "Tricu Tests"
[ runtimePresentationTests
, interactionInspectionTests
, packageTests
- , lexer
- , parser
- , simpleEvaluation
, evaluationDemandTests
- , lambdas
, arithmetic
, providedLibraries
, contractsTests
@@ -96,8 +87,6 @@ tests = testGroup "Tricu Tests"
, fileEval
, demos
, decoding
- , elimLambdaSingle
- , stressElimLambda
, byteMarshallingTests
, sourceObjectCodecTests
, sharedTreeDecodingTests
@@ -132,15 +121,11 @@ tests = testGroup "Tricu Tests"
]
--- Independent compatibility oracle: production rendering no longer imports ASTs.
+-- Constructor display is a runtime presentation format, not a frontend AST.
runtimePresentationTests :: TestTree
runtimePresentationTests = testGroup "Runtime presentation"
- [ testCase "AST constructor display agrees with recovery oracle" $ do
- let trees 0 = [Leaf]
- trees n = let children = trees (n - 1)
- in Leaf : map Stem children ++ [Fork a b | a <- children, b <- children]
- forM_ (trees (3 :: Int)) $ \term ->
- formatT AST term @?= show (toAST term)
+ [ testCase "AST leaf constructor golden" $ formatT AST Leaf @?= "TLeaf"
+ , testCase "AST stem constructor golden" $ formatT AST (Stem Leaf) @?= "TStem TLeaf"
, testCase "AST nested constructor golden" $
formatT AST (Fork (Stem Leaf) (Fork Leaf Leaf)) @?=
"TFork (TStem TLeaf) (TFork TLeaf TLeaf)"
@@ -719,585 +704,6 @@ sourceObjectCodecTests = testGroup "Portable tree object codec"
apply decoder encoded @?= Fork (Stem Leaf) (Fork tree Leaf)
]
-lexer :: TestTree
-lexer = testGroup "Lexer Tests"
- [ testCase "Lex simple identifiers" $ do
- let input = "x a b = a"
- expect = Right [LIdentifier "x", LIdentifier "a", LIdentifier "b", LAssign, LIdentifier "a"]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex Tree Calculus terms" $ do
- let input = "t t t"
- expect = Right [LKeywordT, LKeywordT, LKeywordT]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex escaped characters in strings" $ do
- let input = "\"hello\\nworld\""
- expect = Right [LStringLiteral "hello\nworld"]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex multiple escaped characters in strings" $ do
- let input = "\"tab:\\t newline:\\n quote:\\\" backslash:\\\\\""
- expect = Right [LStringLiteral "tab:\t newline:\n quote:\" backslash:\\"]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex escaped characters in string literals" $ do
- let input = "x = \"line1\\nline2\\tindented\""
- expect = Right [LIdentifier "x", LAssign, LStringLiteral "line1\nline2\tindented"]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex empty string with escape sequence" $ do
- let input = "\"\\\"\""
- expect = Right [LStringLiteral "\""]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex mixed literals" $ do
- let input = "t \"string\" 42"
- expect = Right [LKeywordT, LStringLiteral "string", LIntegerLiteral 42]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex invalid token" $ do
- let input = "&invalid"
- case runParser tricuLexer "" input of
- Left _ -> return ()
- Right _ -> assertFailure "Expected lexer to fail on invalid token"
-
- , testCase "Drop trailing whitespace in definitions" $ do
- let input = "x = 5 "
- expect = [LIdentifier "x",LAssign,LIntegerLiteral 5]
- case (runParser tricuLexer "" input) of
- Left _ -> assertFailure "Failed to lex input"
- Right i -> i @?= expect
-
- , testCase "Error when using invalid characters in identifiers" $ do
- case (runParser tricuLexer "" "!result = 5") of
- Left _ -> return ()
- Right _ -> assertFailure "Expected failure when trying to assign the value of !result"
-
- , testCase "Lex <| as arrow-left token" $ do
- let input = "f <| g"
- expect = Right [LIdentifier "f", LArrowLeft, LIdentifier "g"]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex <| without surrounding spaces" $ do
- let input = "a<|b"
- expect = Right [LIdentifier "a", LArrowLeft, LIdentifier "b"]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex |> as arrow-right token" $ do
- let input = "f |> g"
- expect = Right [LIdentifier "f", LArrowRight, LIdentifier "g"]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex |> without surrounding spaces" $ do
- let input = "a|>b"
- expect = Right [LIdentifier "a", LArrowRight, LIdentifier "b"]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex <- as bind arrow token" $ do
- let input = "x <- action"
- expect = Right [LIdentifier "x", LBindArrow, LIdentifier "action"]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex $ remains legal identifier char" $ do
- let input = "foo$bar = 1"
- expect = Right [LIdentifier "foo$bar", LAssign, LIntegerLiteral 1]
- runParser tricuLexer "" input @?= expect
-
- , testCase "Lex @ and =@ as annotation tokens" $ do
- let input = "f x@Bool =@String x"
- expect = Right
- [ LIdentifier "f"
- , LIdentifier "x"
- , LAt
- , LIdentifier "Bool"
- , LAssignAt
- , LIdentifier "String"
- , LIdentifier "x"
- ]
- runParser tricuLexer "" input @?= expect
- ]
-
-parser :: TestTree
-parser = testGroup "Parser Tests"
- [ testCase "Error when assigning a value to T" $ do
- let tokens = lexTricu "t = x"
- case parseSingleExpr tokens of
- Left _ -> return ()
- Right _ -> assertFailure "Expected failure when trying to assign the value of T"
-
- , testCase "Parse function definitions" $ do
- let input = "x = (a b c : a)"
- expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SLambda ["c"] (SVar "a" Nothing))))
- parseSingle input @?= expect
-
- , testCase "Parse nested Tree Calculus terms" $ do
- let input = "t (t t) t"
- expect = SApp (SApp TLeaf (SApp TLeaf TLeaf)) TLeaf
- parseSingle input @?= expect
-
- , testCase "Parse sequential Tree Calculus terms" $ do
- let input = "t t t"
- expect = SApp (SApp TLeaf TLeaf) TLeaf
- parseSingle input @?= expect
-
- , testCase "Parse mixed list literals" $ do
- let input = "[t (\"hello\") t]"
- expect = SList [TLeaf, SStr "hello", TLeaf]
- parseSingle input @?= expect
-
- , testCase "Parse function with applications" $ do
- let input = "f = (x : t x)"
- expect = SDef "f" [] (SLambda ["x"] (SApp TLeaf (SVar "x" Nothing)))
- parseSingle input @?= expect
-
- , testCase "Parse nested lists" $ do
- let input = "[t [(t t)]]"
- expect = SList [TLeaf,SList [SApp TLeaf TLeaf]]
- parseSingle input @?= expect
-
- , testCase "Parse complex parentheses" $ do
- let input = "t (t t (t t))"
- expect = SApp TLeaf (SApp (SApp TLeaf TLeaf) (SApp TLeaf TLeaf))
- parseSingle input @?= expect
-
- , testCase "Parse empty list" $ do
- let input = "[]"
- expect = SList []
- parseSingle input @?= expect
-
- , testCase "Parse multiple nested lists" $ do
- let input = "[[t t] [t (t t)]]"
- expect = SList [SList [TLeaf,TLeaf],SList [TLeaf,SApp TLeaf TLeaf]]
- parseSingle input @?= expect
-
- , testCase "Parse whitespace variance" $ do
- let input1 = "[t t]"
- let input2 = "[ t t ]"
- expect = SList [TLeaf, TLeaf]
- parseSingle input1 @?= expect
- parseSingle input2 @?= expect
-
- , testCase "Parse string in list" $ do
- let input = "[(\"hello\")]"
- expect = SList [SStr "hello"]
- parseSingle input @?= expect
-
- , testCase "Parse parentheses inside list" $ do
- let input = "[t (t t)]"
- expect = SList [TLeaf,SApp TLeaf TLeaf]
- parseSingle input @?= expect
-
- , testCase "Parse nested parentheses in function body" $ do
- let input = "f = (x : t (t (t t)))"
- expect = SDef "f" [] (SLambda ["x"] (SApp TLeaf (SApp TLeaf (SApp TLeaf TLeaf))))
- parseSingle input @?= expect
-
- , testCase "Parse lambda abstractions" $ do
- let input = "(a : a)"
- expect = (SLambda ["a"] (SVar "a" Nothing))
- parseSingle input @?= expect
-
- , testCase "Parse multiple arguments to lambda abstractions" $ do
- let input = "x = (a b : a)"
- expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SVar "a" Nothing)))
- parseSingle input @?= expect
-
- , testCase "Parse top-level definition arguments" $ do
- let input = "const a b = a"
- expect = SDef "const" ["a", "b"] (SVar "a" Nothing)
- parseSingle input @?= expect
-
- , testCase "Evaluate top-level definition arguments" $ do
- tricuTestString "const a b = a\nconst 1 2" @?= "Fork (Stem Leaf) Leaf"
-
- , testCase "Parse annotated definition binders" $ do
- let input = "foo x@Bool xs@(List Bool) =@String x"
- expect = SDefAnn
- "foo"
- [DefBinder "x" (Just (VEName "Bool")), DefBinder "xs" (Just (VEApp (VEName "List") (VEName "Bool")))]
- (Just (VEName "String"))
- (SVar "x" Nothing)
- parseSingle input @?= expect
-
- , testCase "Parse phantom tail annotations" $ do
- let input = "foo x@Bool @(List Bool) =@String x"
- expect = SDefAnn
- "foo"
- [DefBinder "x" (Just (VEName "Bool")), DefPhantom (VEApp (VEName "List") (VEName "Bool"))]
- (Just (VEName "String"))
- (SVar "x" Nothing)
- parseSingle input @?= expect
-
- , testCase "Parse pure phantom function annotation" $ do
- let input = "foo @Bool @(Fn [Bool] String) =@Unit (x : x)"
- expect = SDefAnn
- "foo"
- [DefPhantom (VEName "Bool"), DefPhantom (VEApp (VEApp (VEName "Fn") (VEList [VEName "Bool"])) (VEName "String"))]
- (Just (VEName "Unit"))
- (SLambda ["x"] (SVar "x" Nothing))
- parseSingle input @?= expect
-
- , testCase "Evaluate annotated definition applies runtime contract boundary" $ do
- let input = unlines
- [ "bool? = guardC \"not a boolean\" (b : or? (equal? b true) (equal? b false))"
- , "id x@bool? =@bool? x"
- , "main = id true"
- ]
- env = evalTricu allTestLibsEnv (parseTricu input)
- result env @?= trueT
-
- , testCase "Reject named binders after phantom annotations" $ do
- let tokens = lexTricu "foo @Bool x@Bool =@Bool x"
- case parseSingleExpr tokens of
- Left _ -> return ()
- Right ast -> assertFailure $ "Expected parse failure, got " ++ show ast
-
- , testCase "Unparenthesized annotation names remain ordinary aliases" $ do
- let input = "foo x@List Bool =@Bool x"
- expect = SDefAnn "foo"
- [DefBinder "x" (Just (VEName "List")), DefBinder "Bool" Nothing]
- (Just (VEName "Bool"))
- (SVar "x" Nothing)
- parseSingle input @?= expect
-
- , testCase "Parse let expression" $ do
- let input = "let x = t t in x"
- expect = SLet "x" (SApp TLeaf TLeaf) (SVar "x" Nothing)
- parseSingle input @?= expect
-
- , testCase "Evaluate let expression" $ do
- tricuTestString "let x = 1 in x" @?= "Fork (Stem Leaf) Leaf"
-
- , testCase "Parse let function binding" $ do
- let input = "let f x = x in f t"
- expect = SLet "f" (SLambda ["x"] (SVar "x" Nothing))
- (SApp (SVar "f" Nothing) TLeaf)
- parseSingle input @?= expect
-
- , testCase "Parse where expression" $ do
- let input = "x where x = t t"
- expect = SLet "x" (SApp TLeaf TLeaf) (SVar "x" Nothing)
- parseSingle input @?= expect
-
- , testCase "Evaluate where expression" $ do
- tricuTestString "x where x = 1" @?= "Fork (Stem Leaf) Leaf"
-
- , testCase "Parse where binding with arguments (SLet)" $ do
- let input = "f 3 where f x = x"
- expect = SLet "f" (SLambda ["x"] (SVar "x" Nothing))
- (SApp (SVar "f" Nothing) (SInt 3))
- parseSingle input @?= expect
-
- , testCase "Evaluate where binding with arguments matches applied lambda" $ do
- tricuTestString "f (t t) where f x = t x x"
- @?= tricuTestString "(f : f (t t)) (x : t x x)"
-
- , testCase "Evaluate nested let bindings" $ do
- tricuTestString "let a = t t in let b = t in t a b"
- @?= tricuTestString "t (t t) t"
-
- , testCase "Inner let binding shadows outer binding" $ do
- tricuTestString "let x = t in let x = t t in x"
- @?= tricuTestString "t t"
-
- , testCase "Parse indented multiline definition body" $ do
- let input = "x =\n t\n t"
- expect = SDef "x" [] (SApp TLeaf TLeaf)
- parseSingle input @?= expect
-
- , testCase "Evaluate indented multiline let" $ do
- tricuTestString "let\n x =\n 1\nin\n x" @?= "Fork (Stem Leaf) Leaf"
-
- , testCase "Evaluate indented multiline where" $ do
- tricuTestString "x\n where x =\n 1" @?= "Fork (Stem Leaf) Leaf"
-
- , testCase "Parse explicit custom-bind do" $ do
- let input = "do bind\n x <- pure t\n pure x"
- expect = SApp
- (SApp (SVar "bind" Nothing) (SApp (SVar "pure" Nothing) TLeaf))
- (SLambda ["x"] (SApp (SVar "pure" Nothing) (SVar "x" Nothing)))
- parseSingle input @?= expect
-
- , testCase "Parse do statement without binder" $ do
- let input = "do bind\n pure t\n pure t"
- expect = SApp
- (SApp (SVar "bind" Nothing) (SApp (SVar "pure" Nothing) TLeaf))
- (SLambda ["_"] (SApp (SVar "pure" Nothing) TLeaf))
- parseSingle input @?= expect
-
- , testCase "Reject bare do without explicit bind operator" $ do
- parsed <- try (evaluate (parseSingle "do\n x <- pure t\n pure x")) :: IO (Either SomeException TricuAST)
- case parsed of
- Left _ -> pure ()
- Right _ -> assertFailure "Expected bare do to fail"
-
- , testCase "Grouping T terms with parentheses in function application" $ do
- let input = "x = (a : a)\nx (t)"
- expect = [SDef "x" [] (SLambda ["a"] (SVar "a" Nothing)),SApp (SVar "x" Nothing) TLeaf]
- parseTricu input @?= expect
-
- , testCase "Comments 1" $ do
- let input = "(t) (t) -- (t)"
- expect = [SApp TLeaf TLeaf]
- parseTricu input @?= expect
-
- , testCase "Comments 2" $ do
- let input = "(t) -- (t) -- (t)"
- expect = [TLeaf]
- parseTricu input @?= expect
-
- , testCase "Parse <| as low-precedence application" $ do
- let input = "f x <| g y"
- expect = SApp (SApp (SVar "f" Nothing) (SVar "x" Nothing))
- (SApp (SVar "g" Nothing) (SVar "y" Nothing))
- parseSingle input @?= expect
-
- , testCase "Parse chained <| as left-associative" $ do
- let input = "f <| g <| h"
- expect = SApp (SApp (SVar "f" Nothing) (SVar "g" Nothing))
- (SVar "h" Nothing)
- parseSingle input @?= expect
-
- , testCase "Parse <| after newline inside parens" $ do
- let input = "(f x <|\n g y)"
- expect = SApp (SApp (SVar "f" Nothing) (SVar "x" Nothing))
- (SApp (SVar "g" Nothing) (SVar "y" Nothing))
- parseSingle input @?= expect
-
- , testCase "Parse <| in lambda body" $ do
- let input = "(x : f x <| g)"
- expect = SLambda ["x"] (SApp (SApp (SVar "f" Nothing) (SVar "x" Nothing))
- (SVar "g" Nothing))
- parseSingle input @?= expect
-
- , testCase "Parse |> as low-precedence application" $ do
- let input = "f x |> g y"
- expect = SApp (SApp (SVar "g" Nothing) (SVar "y" Nothing))
- (SApp (SVar "f" Nothing) (SVar "x" Nothing))
- parseSingle input @?= expect
-
- , testCase "Parse chained |> as left-associative" $ do
- let input = "f |> g |> h"
- expect = SApp (SVar "h" Nothing)
- (SApp (SVar "g" Nothing) (SVar "f" Nothing))
- parseSingle input @?= expect
-
- , testCase "Parse |> after newline inside parens" $ do
- let input = "(f x |>\n g y)"
- expect = SApp (SApp (SVar "g" Nothing) (SVar "y" Nothing))
- (SApp (SVar "f" Nothing) (SVar "x" Nothing))
- parseSingle input @?= expect
-
- , testCase "Parse |> in lambda body" $ do
- let input = "(x : f x |> g)"
- expect = SLambda ["x"] (SApp (SVar "g" Nothing)
- (SApp (SVar "f" Nothing) (SVar "x" Nothing)))
- parseSingle input @?= expect
-
- , testCase "Parse mixed <| and |>" $ do
- let input = "f |> g <| h"
- expect = SApp (SApp (SVar "g" Nothing) (SVar "f" Nothing))
- (SVar "h" Nothing)
- parseSingle input @?= expect
-
- , testCase "Parse forward pipe chain" $ do
- let input = "x |> f |> g"
- expect = SApp (SVar "g" Nothing)
- (SApp (SVar "f" Nothing) (SVar "x" Nothing))
- parseSingle input @?= expect
-
- , testCase "Parse backward pipe" $ do
- let input = "f <| x"
- expect = SApp (SVar "f" Nothing) (SVar "x" Nothing)
- parseSingle input @?= expect
-
- , testCase "Parse backward pipe chain left associative" $ do
- let input = "f <| x <| y"
- expect = SApp (SApp (SVar "f" Nothing) (SVar "x" Nothing))
- (SVar "y" Nothing)
- parseSingle input @?= expect
-
- , testCase "Parse newline after forward pipe" $ do
- let input = "x |>\nf"
- expect = SApp (SVar "f" Nothing) (SVar "x" Nothing)
- parseSingle input @?= expect
-
- , testCase "Parse newline after backward pipe" $ do
- let input = "f <|\nx"
- expect = SApp (SVar "f" Nothing) (SVar "x" Nothing)
- parseSingle input @?= expect
- ]
-
-simpleEvaluation :: TestTree
-simpleEvaluation = testGroup "Evaluation Tests"
- [ testCase "Evaluate single Leaf" $ do
- let input = "t"
- let ast = parseSingle input
- (result $ evalSingle Map.empty ast) @?= Leaf
-
- , testCase "Evaluate single Stem" $ do
- let input = "t t"
- let ast = parseSingle input
- (result $ evalSingle Map.empty ast) @?= Stem Leaf
-
- , testCase "Evaluate single Fork" $ do
- let input = "t t t"
- let ast = parseSingle input
- (result $ evalSingle Map.empty ast) @?= Fork Leaf Leaf
-
- , testCase "Evaluate nested Fork and Stem" $ do
- let input = "t (t t) t"
- let ast = parseSingle input
- (result $ evalSingle Map.empty ast) @?= Fork (Stem Leaf) Leaf
-
- , testCase "Evaluate `not` function" $ do
- let input = "t (t (t t) (t t t)) t"
- let ast = parseSingle input
- (result $ evalSingle Map.empty ast) @?=
- Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
-
- , testCase "Environment updates with definitions" $ do
- let input = "x = t\ny = x"
- env = evalTricu Map.empty (parseTricu input)
- Map.lookup "x" env @?= Just Leaf
- Map.lookup "y" env @?= Just Leaf
-
- , testCase "Variable substitution" $ do
- let input = "x = t t\ny = t x\ny"
- env = evalTricu Map.empty (parseTricu input)
- (result env) @?= Stem (Stem Leaf)
-
- , testCase "Multiline input evaluation" $ do
- let input = "x = t\ny = t t\nx"
- env = evalTricu Map.empty (parseTricu input)
- (result env) @?= Leaf
-
- , testCase "Evaluate string literal" $ do
- let input = "\"hello\""
- let ast = parseSingle input
- (result $ evalSingle Map.empty ast) @?= ofString "hello"
-
- , testCase "Evaluate list literal" $ do
- let input = "[t (t t)]"
- let ast = parseSingle input
- (result $ evalSingle Map.empty ast) @?= ofList [Leaf, Stem Leaf]
-
- , testCase "Evaluate empty list" $ do
- let input = "[]"
- let ast = parseSingle input
- (result $ evalSingle Map.empty ast) @?= ofList []
-
- , testCase "Evaluate variable dependency chain" $ do
- let input = "x = t (t t)\n \
- \ y = x\n \
- \ z = y\n \
- \ variablewithamuchlongername = z\n \
- \ variablewithamuchlongername"
- env = evalTricu Map.empty (parseTricu input)
- (result env) @?= (Stem (Stem Leaf))
-
-
- , testCase "Immutable definitions" $ do
- let input = "x = t t\nx = t\nx"
- env = evalTricu Map.empty (parseTricu input)
- result <- try (evaluate (tricuTestString input)) :: IO (Either SomeException String)
- case result of
- Left _ -> return ()
- Right _ -> assertFailure "Expected evaluation error"
-
-
- , testCase "Apply identity to Boolean Not" $ do
- let not = "(t (t (t t) (t t t)) t)"
- let input = "x = (a : a)\nx " ++ not
- env = evalTricu Map.empty (parseTricu input)
- result env @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
- ]
-
-lambdas :: TestTree
-lambdas = testGroup "Lambda Evaluation Tests"
- [ testCase "Lambda Identity Function" $ do
- let input = "id = (x : x)\nid t"
- tricuTestString input @?= "Leaf"
-
- , testCase "Lambda Constant Function (K combinator)" $ do
- let input = "k = (x y : x)\nk t (t t)"
- tricuTestString input @?= "Leaf"
-
- , testCase "Lambda Application with Variable" $ do
- let input = "id = (x : x)\nval = t t\nid val"
- tricuTestString input @?= "Stem Leaf"
-
- , testCase "Lambda Application with Multiple Arguments" $ do
- let input = "apply = (f x y : f x y)\nk = (a b : a)\napply k t (t t)"
- tricuTestString input @?= "Leaf"
-
- , testCase "Nested Lambda Application" $ do
- let input = "apply = (f x y : f x y)\nid = (x : x)\napply (f x : f x) id t"
- tricuTestString input @?= "Leaf"
-
- , testCase "Lambda with a complex body" $ do
- let input = "f = (x : t (t x))\nf t"
- tricuTestString input @?= "Stem (Stem Leaf)"
-
- , testCase "Lambda returning a function" $ do
- let input = "f = (x : (y : x))\ng = f t\ng (t t)"
- tricuTestString input @?= "Leaf"
-
- , testCase "Lambda with Shadowing" $ do
- let input = "f = (x : (x : x))\nf t (t t)"
- tricuTestString input @?= "Stem Leaf"
-
- , testCase "Lambda returning another lambda" $ do
- let input = "k = (x : (y : x))\nk_app = k t\nk_app (t t)"
- tricuTestString input @?= "Leaf"
-
- , testCase "Lambda with free variables" $ do
- let input = "y = t t\nf = (x : y)\nf t"
- tricuTestString input @?= "Stem Leaf"
-
- , testCase "SKI Composition" $ do
- let input = "s = (x y z : x z (y z))\nk = (x y : x)\ni = (x : x)\ncomp = s k i\ncomp t (t t)"
- tricuTestString input @?= "Stem (Stem Leaf)"
-
- , testCase "Lambda with multiple parameters and application" $ do
- let input = "f = (a b c : t a b c)\nf t (t t) (t t t)"
- tricuTestString input @?= "Stem Leaf"
-
- , testCase "Lambda with nested application in the body" $ do
- let input = "f = (x : t (t (t x)))\nf t"
- tricuTestString input @?= "Stem (Stem (Stem Leaf))"
-
- , testCase "Lambda returning a function and applying it" $ do
- let input = "f = (x : (y : t x y))\ng = f t\ng (t t)"
- tricuTestString input @?= "Fork Leaf (Stem Leaf)"
-
- , testCase "Lambda applying a variable" $ do
- let input = "id = (x : x)\na = t t\nid a"
- tricuTestString input @?= "Stem Leaf"
-
- , testCase "Nested lambda abstractions in the same expression" $ do
- let input = "f = (x : (y : x y))\ng = (z : z)\nf g t"
- tricuTestString input @?= "Leaf"
-
- , testCase "Lambda applied to string literal" $ do
- let input = "f = (x : x)\nf \"hello\""
- tricuTestString input @?= "Fork (Fork Leaf (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) Leaf))))"
-
-
- , testCase "Lambda applied to integer literal" $ do
- let input = "f = (x : x)\nf 42"
- tricuTestString input @?= "Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) Leaf)))))"
-
- , testCase "Lambda applied to list literal" $ do
- let input = "f = (x : x)\nf [t (t t)]"
- tricuTestString input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
-
- , testCase "Lambda containing list literal" $ do
- let input = "(a : [(a)]) 1"
- tricuTestString input @?= "Fork (Fork (Stem Leaf) Leaf) Leaf"
- ]
-
maybeTests :: TestTree
maybeTests = testGroup "Maybe Tests"
[ testCase "nothing is Leaf" $ do
@@ -2364,75 +1770,6 @@ decoding = testGroup "Decoding Tests"
decodeResult input @?= "[[\"nested\"], \"string\"]"
]
-elimLambdaSingle :: TestTree
-elimLambdaSingle = testCase "elimLambda preserves eval, fires eta, and SDef binds" $ do
- -- 1) eta reduction, purely structural and parsed from source
- let [etaIn] = parseTricu "x : f x"
- [fRef ] = parseTricu "f"
- elimLambda etaIn @?= fRef
-
- -- 2) SDef binds its own name and parameters
- let [defFXY] = parseTricu "f x y : f x"
- fv = freeVars defFXY
- assertBool "f should be bound in SDef" ("f" `Set.notMember` fv)
- assertBool "x should be bound in SDef" ("x" `Set.notMember` fv)
- assertBool "y should be bound in SDef" ("y" `Set.notMember` fv)
-
- -- 3) semantics preserved on a small program that exercises compose and triage
- let src =
- unlines
- [ "false = t"
- , "_ = t"
- , "true = t t"
- , "id = a : a"
- , "const = a b : a"
- , "compose = f g x : f (g x)"
- , "triage = leaf stem fork : t (t leaf stem) fork"
- , "test = triage \"Leaf\" (_ : \"Stem\") (_ _ : \"Fork\")"
- , "main = compose id id test"
- ]
- prog = parseTricu src
- progElim = map elimLambda prog
- evalBefore = result (evalTricu Map.empty prog)
- evalAfter = result (evalTricu Map.empty progElim)
- evalAfter @?= evalBefore
-
-stressElimLambda :: TestTree
-stressElimLambda = testCase "stress elimLambda on wide list under deep curried lambda" $ do
- let numVars = 200
- numBody = 800
- vars = [ "x" ++ show i | i <- [1..numVars] ]
- body = "(" ++ unwords (replicate numBody "t") ++ ")"
- etaOne = "h : f h"
- etaTwo = "k : id k"
- defId = "id = a : a"
- lambda = unwords vars ++ " : " ++ body
- src = unlines
- [ defId
- , etaOne
- , "compose = f g x : f (g x)"
- , "f = t t"
- , etaTwo
- , lambda
- , "main = compose id id (" ++ head vars ++ " : f " ++ head vars ++ ")"
- ]
- prog = parseTricu src
-
- let out = map elimLambda prog
- let noLambda term = case term of
- SLambda _ _ -> False
- SApp f g -> noLambda f && noLambda g
- SList xs -> all noLambda xs
- TFork l r -> noLambda l && noLambda r
- TStem u -> noLambda u
- _ -> True
-
- assertBool "all lambdas eliminated" (all noLambda out)
-
- let before = result (evalTricu Map.empty prog)
- after = result (evalTricu Map.empty out)
- after @?= before
-
-- --------------------------------------------------------------------------
-- Byte marshalling tests
-- --------------------------------------------------------------------------
@@ -3291,9 +2628,6 @@ gateLexerTests = testGroup "Feasibility-gate source lexer"
env <- evaluateCompilerFile "./test/sourceLexerImport.tri"
Map.lookup "main" env @?= Just Leaf
, testCase "keyword, identifiers, and punctuation carry spans" $ do
- runParser tricuLexer "" "t (foo : turtle)" @?=
- Right [LKeywordT, LOpenParen, LIdentifier "foo", LColon,
- LIdentifier "turtle", LCloseParen]
check "t (foo : turtle)"
(portableReply True
(ofList
@@ -3305,8 +2639,6 @@ gateLexerTests = testGroup "Feasibility-gate source lexer"
, gateToken 4 Leaf (gatePosition 1 16 15) (gatePosition 1 17 16)
]) Leaf True False)
, testCase "decimal digits accumulate and retain leading-zero span" $ do
- runParser tricuLexer "" "009 x" @?=
- Right [LIntegerLiteral 9, LIdentifier "x"]
check "009 x" (portableReply True
(ofList
[ gateToken 7 (ofNumber 9) (gatePosition 1 1 0) (gatePosition 1 4 3)
@@ -3314,22 +2646,18 @@ gateLexerTests = testGroup "Feasibility-gate source lexer"
]) Leaf True False)
, testCase "quoted string decodes escapes and retains raw source span" $ do
let input = "\"a\\n\\\"b\""
- runParser tricuLexer "" input @?= Right [LStringLiteral "a\n\"b"]
check input (portableReply True
(ofList [gateToken 8 (ofString "a\n\"b")
(gatePosition 1 1 0) (gatePosition 1 9 8)]) Leaf True False)
- , testCase "bootstrap string escape repertoire is preserved" $ do
+ , testCase "source string escape repertoire is preserved" $ do
let input = "\"\\t\\r\\f\\b\\\\\\'\""
decoded = "\t\r\f\b\\'"
width = fromIntegral (length input)
- runParser tricuLexer "" input @?= Right [LStringLiteral decoded]
check input (portableReply True
(ofList [gateToken 8 (ofString decoded)
(gatePosition 1 1 0) (gatePosition 1 (width + 1) width)])
Leaf True False)
, testCase "bracket punctuation retains both half-open spans" $ do
- runParser tricuLexer "" "[t]" @?=
- Right [LOpenBracket, LKeywordT, LCloseBracket]
check "[t]" (portableReply True
(ofList
[ gateToken 9 Leaf (gatePosition 1 1 0) (gatePosition 1 2 1)
@@ -3356,8 +2684,6 @@ gateLexerTests = testGroup "Feasibility-gate source lexer"
(portableDiagnostic (ofNumber 5) (ofNumber 34) Leaf
(gatePosition 1 1 0) Leaf) Leaf True False)
, testCase "line comment preserves newline token and locations" $ do
- runParser tricuLexer "" "t --hello\nx" @?=
- Right [LKeywordT, LNewline, LIdentifier "x"]
check "t --hello\nx" (portableReply True
(ofList
[ gateToken 1 (ofString "t") (gatePosition 1 1 0) (gatePosition 1 2 1)
@@ -3366,7 +2692,6 @@ gateLexerTests = testGroup "Feasibility-gate source lexer"
]) Leaf True False)
, testCase "block comment consumes internal newlines but preserves end span" $ do
let input = "t |-ab\nc-| t"
- runParser tricuLexer "" input @?= Right [LKeywordT, LKeywordT]
check input (portableReply True
(ofList
[ gateToken 1 (ofString "t") (gatePosition 1 1 0) (gatePosition 1 2 1)
@@ -3389,8 +2714,6 @@ gateLexerTests = testGroup "Feasibility-gate source lexer"
(portableDiagnostic (ofNumber 4) Leaf (ofNumber 45)
(gatePosition 1 1 0) Leaf) (ofString "-") False False)
, testCase "newline advances source position" $ do
- runParser tricuLexer "" "t\nfoo" @?=
- Right [LKeywordT, LNewline, LIdentifier "foo"]
check "t\nfoo"
(portableReply True
(ofList
@@ -3416,16 +2739,13 @@ gateLexerTests = testGroup "Feasibility-gate source lexer"
(portableReply False
(portableDiagnostic (ofNumber 4) Leaf (ofNumber 9)
(gatePosition 1 2 1) Leaf) (ofString "\tfoo") True False)
- , testCase "pipe operators retain bootstrap token kinds and two-character spans" $ do
- runParser tricuLexer "" "<| |>" @?= Right [LArrowLeft, LArrowRight]
+ , testCase "pipe operators retain token kinds and two-character spans" $ do
check "<| |>" (portableReply True
(ofList
[ gateToken 15 Leaf (gatePosition 1 1 0) (gatePosition 1 3 2)
, gateToken 16 Leaf (gatePosition 1 4 3) (gatePosition 1 6 5)
]) Leaf True False)
, testCase "do and bind arrow have independent located token kinds" $ do
- runParser tricuLexer "" "do <-" @?=
- Right [LIdentifier "do", LBindArrow]
check "do <-" (portableReply True
(ofList
[ gateToken 17 (ofString "do")
@@ -3433,7 +2753,6 @@ gateLexerTests = testGroup "Feasibility-gate source lexer"
, gateToken 18 Leaf (gatePosition 1 4 3) (gatePosition 1 6 5)
]) Leaf True False)
, testCase "ASCII letter/digit range boundaries remain recognized" $ do
- runParser tricuLexer "" "AZaz09" @?= Right [LIdentifier "AZaz09"]
check "AZaz09" (portableReply True
(ofList [gateToken 2 (ofString "AZaz09")
(gatePosition 1 1 0) (gatePosition 1 7 6)]) Leaf True False)
@@ -3731,16 +3050,6 @@ compilerFixtureTests = testGroup "self-built reference compiler fixture"
[(drop (length alias + 1) name, tree) | (name, tree) <- Map.toList exports,
(alias ++ ".") `isPrefixOf` name]
owned "prelude" @?= Map.unions (map owned ["base", "bytes", "conversions"])
- , testCase "recovery foundations are immutable and separate from native base" $ do
- Map.keys recoveryFoundationSources @?= Map.keys recoveryFoundationDependencies
- historical <- readPinnedSource "test/fixtures/reference-source"
- (recoveryFoundationSources Map.! "base")
- native <- readFixtureSourceBytes "lib/base.tri"
- assertBool "native publication must not move the recovery source pin" (historical /= native)
- recovery <- recoveryFoundationEnv "base"
- portable <- compiledModuleEnv "base"
- assertBool "old worker belongs only to historical recovery"
- (Map.member "map_" recovery && not (Map.member "map_" portable))
, testCase "native base effect interpreter and guard use the rebuilt kernels" $ do
env <- compiledModuleEnv "base"
let pureValue value = Fork (ofNumber 0) value
@@ -3759,11 +3068,6 @@ compilerFixtureTests = testGroup "self-built reference compiler fixture"
handled @?= pureValue (ofNumber 9)
foldl apply (env Map.! "guardC") [ofString "bad", predicate, value, ofNumber 7]
@?= success value (ofNumber 7)
- , testCase "recovery reference cannot interpret compiler modules" $ do
- outcome <- try (recoveryFoundationEnv "source.map") :: IO (Either SomeException Env)
- case outcome of
- Left _ -> pure ()
- Right _ -> assertFailure "reference cohort widened beyond six foundations"
, testCase "mixed support reuse requires all provider trees, including unused ones" $ do
let before = Map.fromList [("P.used",1),("P.unused",2)]
source = "!import P as X\n!export f\nf x = X.used x\n"
@@ -4189,9 +3493,6 @@ gateProgramTests = testGroup "Feasibility-gate program parser"
"./test/sourceGateProgramImport.tri"
Map.lookup "main" env @?= Just programResult
, testCase "definition arguments elaborate to located lambdas" $ do
- parseTricu "id x = x\nid t" @?=
- [SDef "id" ["x"] (SVar "x" Nothing),
- SApp (SVar "id" Nothing) TLeaf]
check "id x = x\nid t" programResult
, testCase "an identifier-led expression without assignment stays an expression" $
let name = gateAst 2 (ofString "f")
@@ -4317,48 +3618,24 @@ gateUnitTests :: TestTree
gateUnitTests = testGroup "Feasibility-gate program compiler"
[ testCase "real source files compile without rewriting or relexing" $ do
let corpus =
- [ ("./test/fork.tri", "[]", Fork Leaf Leaf, Fork Leaf Leaf)
- , ("./test/comments-1.tri", "[]", Fork (Stem Leaf) Leaf,
- Fork (Stem Leaf) Leaf)
- , ("./test/map.tri",
- "[(pair \"map\" map) (pair \"append\" append) "
- ++ "(pair \"equal?\" equal?) (pair \"head\" head)]",
- trueT, trueT)
- -- Intensional counts depend on the executable stdlib cohort.
- -- This fixture's stable-built compiler/stdlib cohort returns 680;
- -- the preceding optimized-built fixture returned 237. The host
- -- recovery cohort below remains 321. These are intensional sizes,
- -- not a backend-independent numeric program outcome.
- , ("./test/size.tri",
- "[(pair \"y\" y) (pair \"triage\" triage)]",
- ofNumber 680, ofNumber 321)
+ [ ("./test/fork.tri", [], Fork Leaf Leaf)
+ , ("./test/comments-1.tri", [], Fork (Stem Leaf) Leaf)
+ , ("./test/map.tri", ["map", "append", "equal?", "head"], trueT)
]
- forM_ corpus $ \(path, externals, expected, bootstrapExpected) -> do
+ forM_ corpus $ \(path, names, expected) -> do
source <- readFile path
- let portable = result (evalTricu
- (Map.union gateUnitEnv allTestLibsEnv)
- (parseTricu ("compileGateProgram " ++ externals
- ++ " " ++ show source)))
- portable @?= parserOk expected Leaf
- if path == "./test/size.tri"
- then result (evalTricu allTestLibsEnv (parseTricu source)) @?=
- bootstrapExpected
- else do
- bootstrap <- evaluateFileWithContext allTestLibsEnv path
- Map.lookup "main" bootstrap @?= Just bootstrapExpected
+ let external = ofList [Fork (ofString name) (fixtureExports "base" Map.! name) | name <- names]
+ foldl apply (fixtureExports "source.unit" Map.! "compileGateProgram")
+ [external, ofString source] @?= parserOk expected Leaf
, testCase "portable size counts leaf, stem, and fork arguments" $ do
source <- readFile "./test/size.tri"
let definitions = unlines (init (lines source))
- external = "[(pair \"y\" y) (pair \"triage\" triage)]"
+ external = ofList [Fork (ofString name) (fixtureExports "base" Map.! name)
+ | name <- ["y", "triage"]]
forM_ [("t", 1), ("t t", 2), ("t t t", 3)] $ \(argument, count) -> do
let input = definitions ++ "size (" ++ argument ++ ")\n"
- portable = result (evalTricu
- (Map.union gateUnitEnv allTestLibsEnv)
- (parseTricu ("compileGateProgram " ++ external ++ " "
- ++ show input)))
- bootstrap = result (evalTricu allTestLibsEnv (parseTricu input))
- portable @?= parserOk (ofNumber count) Leaf
- bootstrap @?= ofNumber count
+ foldl apply (fixtureExports "source.unit" Map.! "compileGateProgram")
+ [external, ofString input] @?= parserOk (ofNumber count) Leaf
, testCase "real file inputs match the natively packed self-built artifact" $
withSystemTempDirectory "gate-file-corpus" $ \dir -> do
let path = dir </> "file-matches.arboricx"
@@ -4686,10 +3963,6 @@ gateUnitTests = testGroup "Feasibility-gate program compiler"
forM_ cases $ \(source, input, expected) -> do
foldl apply comparator
[compiler, Leaf, ofString source, input, expected] @?= trueT
- let bootstrap = evalTricu Map.empty (parseTricu source)
- case Map.lookup "main" bootstrap of
- Just fun -> apply fun input @?= expected
- Nothing -> assertFailure ("bootstrap missing main: " ++ source)
let rootComparator = comparatorEnv Map.! "matchesSourceRootArtifact"
unused = "unused = (x : x x) (x : x x)\nmain = t"
unusedRoot <- Timeout.timeout (30 * 1000000) $
@@ -4702,8 +3975,6 @@ gateUnitTests = testGroup "Feasibility-gate program compiler"
Map.lookup "main" env @?= Just (parserOk Leaf Leaf)
, testCase "forward definitions with arguments evaluate before main" $ do
let source = "main = id 42\nid x = x"
- bootstrap = evalTricu Map.empty (parseTricu source)
- Map.lookup "main" bootstrap @?= Just (ofNumber 42)
check "[]" source (parserOk (ofNumber 42) Leaf)
, testCase "final expression selects root in absence of main" $
check "[]" "id x = x\nid t" (parserOk Leaf Leaf)
@@ -4745,7 +4016,7 @@ gateUnitTests = testGroup "Feasibility-gate program compiler"
apply fun (Stem Leaf) @?= Leaf
apply fun (Fork (Stem Leaf) Leaf) @?= Leaf
other -> assertFailure ("Expected fully sourced recursive function, got " ++ show other)
- , testCase "indented definition bodies follow bootstrap continuation rules" $ do
+ , testCase "indented definition bodies preserve continuation layout" $ do
let sources =
[ ("main =\n t", Leaf)
, ("main =\nt", Leaf)
@@ -4755,10 +4026,8 @@ gateUnitTests = testGroup "Feasibility-gate program compiler"
, ("main =\n value\n where value = t", Leaf)
]
forM_ sources $ \(source, value) -> do
- Map.lookup "main" (evalTricu Map.empty (parseTricu source)) @?=
- Just value
check "[]" source (parserOk value Leaf)
- , testCase "multiline grouped applications match the bootstrap" $ do
+ , testCase "multiline grouped applications retain expected results" $ do
let sources =
[ ("main = (t\n t)", Stem Leaf)
, ("main = [(t\n t)]", ofList [Stem Leaf])
@@ -4766,8 +4035,6 @@ gateUnitTests = testGroup "Feasibility-gate program compiler"
, ("main = (x\n where x = t)", Leaf)
]
forM_ sources $ \(source, value) -> do
- Map.lookup "main" (evalTricu Map.empty (parseTricu source)) @?=
- Just value
check "[]" source (parserOk value Leaf)
, testCase "an unindented do block has a located diagnostic" $
let diagnostic = portableDiagnostic (ofNumber 40)
@@ -4780,7 +4047,7 @@ gateUnitTests = testGroup "Feasibility-gate program compiler"
, testCase "pipe followed by a local assignment stays a final expression" $
check "[]" "f = 2\nf |> let id x = x in id"
(parserOk (ofNumber 2) Leaf)
- , testCase "explicit-bind do with nested statements matches bootstrap" $ do
+ , testCase "explicit-bind do with nested statements retains expected results" $ do
let sources =
[ "main = do bind\n x <- 2\n x\nbind a f = f a"
, "main = do unused\n 2"
@@ -4789,10 +4056,8 @@ gateUnitTests = testGroup "Feasibility-gate program compiler"
, "main = do bind\n x <- 2\n do bind\n y <- x\n y\nbind a f = f a"
]
forM_ sources $ \source -> do
- Map.lookup "main" (evalTricu Map.empty (parseTricu source)) @?=
- Just (ofNumber 2)
check "[]" source (parserOk (ofNumber 2) Leaf)
- , testCase "pipe directions, precedence, and local names match bootstrap" $ do
+ , testCase "pipe directions, precedence, and local names retain expected results" $ do
let sources =
[ ("main = 2 |> (x : x)", ofNumber 2)
, ("main = (x : x) <| 2", ofNumber 2)
@@ -4804,8 +4069,6 @@ gateUnitTests = testGroup "Feasibility-gate program compiler"
, ("main = 2 |>\n (x : x)", ofNumber 2)
]
forM_ sources $ \(source, value) -> do
- Map.lookup "main" (evalTricu Map.empty (parseTricu source)) @?=
- Just value
check "[]" source (parserOk value Leaf)
, testCase "multiline local let/where layout matches the bootstrap" $ do
let sources =
@@ -4819,10 +4082,8 @@ gateUnitTests = testGroup "Feasibility-gate program compiler"
, ("main = let id x = x in\n id\n 2", ofNumber 2)
]
forM_ sources $ \(source, value) -> do
- Map.lookup "main" (evalTricu Map.empty (parseTricu source)) @?=
- Just value
check "[]" source (parserOk value Leaf)
- , testCase "local bindings preserve bootstrap semantics and argument order" $ do
+ , testCase "local bindings preserve lexical scope and argument order" $ do
let sources =
[ ("main = let x = 2 in x", ofNumber 2)
, ("main = let id x = x in id 2", ofNumber 2)
@@ -4831,10 +4092,6 @@ gateUnitTests = testGroup "Feasibility-gate program compiler"
, ("main = let x = t in (y : x) 2", Leaf)
]
forM_ sources $ \(source, value) -> do
- let bootstrap = evalTricu Map.empty (parseTricu source)
- selected = if source == "result where result = t"
- then "!result" else "main"
- Map.lookup selected bootstrap @?= Just value
check "[]" source (parserOk value Leaf)
, testCase "local binding value has no self-reference" $
check "[]" "main = let x = x in x" (parserErr
@@ -4853,7 +4110,6 @@ gateUnitTests = testGroup "Feasibility-gate program compiler"
(parserOk (ofList [ofNumber 2]) Leaf)
, testCase "unused divergent body is checked but not demanded" $ do
let source = "unused = (x : x x) (x : x x)\nmain = t"
- Map.lookup "main" (evalTricu Map.empty (parseTricu source)) @?= Just Leaf
check "[]" source (parserOk Leaf Leaf)
, testCase "missing multiline definition body is a structured diagnostic" $
check "[]" "main =\n" (parserErr
@@ -5096,10 +4352,10 @@ gateCompilationTests = testGroup "Feasibility-gate source compiler"
, testCase "decimal literal compiles to the canonical number tree" $ do
check "42" (parserOk (ofNumber 42) Leaf)
check "000" (parserOk Leaf Leaf)
- , testCase "list element boundaries match the bootstrap grammar" $ do
- parseSingle "[t t]" @?= SList [TLeaf, TLeaf]
- parseSingle "[(t t)]" @?= SList [SApp TLeaf TLeaf]
- parseSingle "[t\n2]" @?= SList [TLeaf, SInt 2]
+ , testCase "list element boundaries distinguish atoms from grouped applications" $ do
+ check "[t t]" (parserOk (ofList [Leaf, Leaf]) Leaf)
+ check "[(t t)]" (parserOk (ofList [Stem Leaf]) Leaf)
+ check "[t\n2]" (parserOk (ofList [Leaf, ofNumber 2]) Leaf)
, testCase "lists compile to canonical Fork cells" $ do
check "[]" (parserOk Leaf Leaf)
check "[t 2]" (parserOk (ofList [Leaf, ofNumber 2]) Leaf)
