commit 00cdeca280f4675fae40490c5bd310133f7edebe
parent 3175132eec848009f2990e01b0bfc943f2d1785e
Author: James Eversole <james@eversole.co>
Date: Sat, 25 Jan 2025 09:18:13 -0600
Eval optimization! Tests for demos
Diffstat:
6 files changed, 70 insertions(+), 45 deletions(-)
diff --git a/demos/equality.tri b/demos/equality.tri
@@ -1,19 +1,19 @@
-- We represent `false` with a Leaf and `true` with a Stem Leaf
-false = t
-true = t t
+demo_false = t
+demo_true = t t
-- Tree Calculus representation of the Boolean `not` function
not_TC? = t (t (t t) (t t t)) (t t (t t t))
-- /demos/toSource.tri contains an explanation of `triage`
-triage = (\a b c : t (t a b) c)
-matchBool = (\ot of : triage
+demo_triage = (\a b c : t (t a b) c)
+demo_matchBool = (\ot of : demo_triage
of
(\_ : ot)
(\_ _ : ot)
)
-- Lambda representation of the Boolean `not` function
-not_Lambda? = matchBool false true
+not_Lambda? = demo_matchBool demo_false demo_true
-- Since tricu eliminates Lambda terms to SKI combinators, the tree form of many
-- functions defined via Lambda terms are larger than the most efficient TC
@@ -25,11 +25,11 @@ not_Lambda? = matchBool false true
lambdaEqualsTC = equal? not_TC? not_Lambda?
-- Here are some checks to verify their extensional behavior is the same:
-true_TC? = not_TC? false
-false_TC? = not_TC? true
+true_TC? = not_TC? demo_false
+false_TC? = not_TC? demo_true
-true_Lambda? = not_Lambda? false
-false_Lambda? = not_Lambda? true
+true_Lambda? = not_Lambda? demo_false
+false_Lambda? = not_Lambda? demo_true
bothTrueEqual? = equal? true_TC? true_Lambda?
bothFalseEqual? = equal? false_TC? false_Lambda?
diff --git a/demos/levelOrderTraversal.tri b/demos/levelOrderTraversal.tri
@@ -4,7 +4,7 @@
-- NOTICE: This demo relies on tricu base library functions
--
-- We model labelled binary trees as sublists where values act as labels. We
--- require explicit notation of empty nodes. Empty nodes can be represented
+-- require explicit not?ation of empty nodes. Empty nodes can be represented
-- with an empty list, `[]`, which is equivalent to a single node `t`.
--
-- Example tree inputs:
@@ -19,33 +19,33 @@
label = (\node : head node)
-left = (\node : if (emptyList node)
+left = (\node : if (emptyList? node)
[]
- (if (emptyList (tail node))
+ (if (emptyList? (tail node))
[]
(head (tail node))))
-right = (\node : if (emptyList node)
+right = (\node : if (emptyList? node)
[]
- (if (emptyList (tail node))
+ (if (emptyList? (tail node))
[]
- (if (emptyList (tail (tail node)))
+ (if (emptyList? (tail (tail node)))
[]
(head (tail (tail node))))))
-processLevel = y (\self queue : if (emptyList queue)
+processLevel = y (\self queue : if (emptyList? queue)
[]
(pair (map label queue) (self (filter
- (\node : not (emptyList node))
+ (\node : not? (emptyList? node))
(lconcat (map left queue) (map right queue))))))
levelOrderTraversal_ = (\a : processLevel (t a t))
-toLineString = y (\self levels : if (emptyList levels)
+toLineString = y (\self levels : if (emptyList? levels)
""
(lconcat
(lconcat (map (\x : lconcat x " ") (head levels)) "")
- (if (emptyList (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels))))))
+ (if (emptyList? (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels))))))
levelOrderToString = (\s : toLineString (levelOrderTraversal_ s))
diff --git a/demos/size.tri b/demos/size.tri
@@ -17,3 +17,5 @@ size = (\x :
self
(\x y : compose (self x) (self y))
x)) x 0))
+
+size size
diff --git a/demos/toSource.tri b/demos/toSource.tri
@@ -8,7 +8,7 @@
-- the Tree Calculus term, `triage` enables branching logic based on the term's
-- shape, making it possible to perform structure-specific operations such as
-- reconstructing the terms' source code representation.
-triage = (\leaf stem fork : t (t leaf stem) fork)
+-- triage = (\leaf stem fork : t (t leaf stem) fork)
-- Base case of a single Leaf
sourceLeaf = t (head "t")
diff --git a/src/Eval.hs b/src/Eval.hs
@@ -24,7 +24,7 @@ evalSingle env term
| SVar name <- term =
case Map.lookup name env of
Just v -> Map.insert "__result" v env
- Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
+ Nothing -> errorWithoutStackTrace $ "Variable `" ++ name ++ "` not defined"
| otherwise =
Map.insert "__result" (evalAST env term) env
@@ -59,11 +59,13 @@ evalAST env term
elimLambda :: TricuAST -> TricuAST
elimLambda = go
where
+ go (SLambda [v] (SApp f (SVar x)))
+ | v == x && not (isFree v f) = elimLambda f
go (SLambda (v:vs) body)
- | null vs = toSKI v (elimLambda body)
- | otherwise = elimLambda (SLambda [v] (SLambda vs body))
- go (SApp f g) = SApp (elimLambda f) (elimLambda g)
- go x = x
+ | null vs = toSKI v (elimLambda body)
+ | otherwise = elimLambda (SLambda [v] (SLambda vs body))
+ go (SApp f g) = SApp (elimLambda f) (elimLambda g)
+ go x = x
toSKI x (SVar y)
| x == y = _I
@@ -73,7 +75,6 @@ elimLambda = go
| otherwise = SApp (SApp _S (toSKI x n)) (toSKI x u)
toSKI x t
| not (isFree x t) = SApp _K t
- | otherwise = SApp (SApp _S (toSKI x t)) TLeaf
_S = parseSingle "t (t (t t t)) t"
_K = parseSingle "t t"
diff --git a/test/Spec.hs b/test/Spec.hs
@@ -25,16 +25,17 @@ runTricu s = show $ result (evalTricu Map.empty $ parseTricu s)
tests :: TestTree
tests = testGroup "Tricu Tests"
- [ lexerTests
- , parserTests
- , evaluationTests
- , lambdaEvalTests
- , libraryTests
- , fileEvaluationTests
+ [ lexer
+ , parser
+ , simpleEvaluation
+ , lambdas
+ , baseLibrary
+ , fileEval
+ , demos
]
-lexerTests :: TestTree
-lexerTests = testGroup "Lexer Tests"
+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"]
@@ -74,8 +75,8 @@ lexerTests = testGroup "Lexer Tests"
Right _ -> assertFailure "Expected failure when trying to assign the value of __result"
]
-parserTests :: TestTree
-parserTests = testGroup "Parser Tests"
+parser :: TestTree
+parser = testGroup "Parser Tests"
[ testCase "Error when assigning a value to T" $ do
let tokens = lexTricu "t = x"
case parseSingleExpr tokens of
@@ -175,8 +176,8 @@ parserTests = testGroup "Parser Tests"
parseTricu input @?= expect
]
-evaluationTests :: TestTree
-evaluationTests = testGroup "Evaluation Tests"
+simpleEvaluation :: TestTree
+simpleEvaluation = testGroup "Evaluation Tests"
[ testCase "Evaluate single Leaf" $ do
let input = "t"
let ast = parseSingle input
@@ -244,7 +245,7 @@ evaluationTests = testGroup "Evaluation Tests"
(result env) @?= (Stem (Stem Leaf))
- , testCase "Evaluate variable shadowing" $ do
+ , testCase "Immutable definitions" $ do
let input = "x = t t\nx = t\nx"
env = evalTricu Map.empty (parseTricu input)
result <- try (evaluate (runTricu input)) :: IO (Either SomeException String)
@@ -260,8 +261,8 @@ evaluationTests = testGroup "Evaluation Tests"
result env @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
]
-lambdaEvalTests :: TestTree
-lambdaEvalTests = testGroup "Lambda Evaluation Tests"
+lambdas :: TestTree
+lambdas = testGroup "Lambda Evaluation Tests"
[ testCase "Lambda Identity Function" $ do
let input = "id = (\\x : x)\nid t"
runTricu input @?= "Leaf"
@@ -340,8 +341,8 @@ lambdaEvalTests = testGroup "Lambda Evaluation Tests"
runTricu input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
]
-libraryTests :: TestTree
-libraryTests = testGroup "Library Tests"
+baseLibrary :: TestTree
+baseLibrary = testGroup "Library Tests"
[ testCase "K combinator 1" $ do
library <- evaluateFile "./lib/base.tri"
let input = "k (t) (t t)"
@@ -476,8 +477,8 @@ libraryTests = testGroup "Library Tests"
result env @?= Stem Leaf
]
-fileEvaluationTests :: TestTree
-fileEvaluationTests = testGroup "Evaluation tests"
+fileEval :: TestTree
+fileEval = testGroup "File evaluation tests"
[ testCase "Forks" $ do
res <- liftIO $ evaluateFileResult "./test/fork.tri"
res @?= Fork Leaf Leaf
@@ -495,3 +496,24 @@ fileEvaluationTests = testGroup "Evaluation tests"
res <- liftIO $ evaluateFileWithContext library "./test/string.tri"
decodeResult (result res) @?= "\"String test!\""
]
+
+
+demos :: TestTree
+demos = testGroup "Test provided demo functionality"
+ [ testCase "Structural equality demo" $ do
+ library <- liftIO $ evaluateFile "./lib/base.tri"
+ res <- liftIO $ evaluateFileWithContext library "./demos/equality.tri"
+ decodeResult (result res) @?= "t t"
+ , testCase "Convert values back to source code demo" $ do
+ library <- liftIO $ evaluateFile "./lib/base.tri"
+ res <- liftIO $ evaluateFileWithContext library "./demos/toSource.tri"
+ decodeResult (result res) @?= "\"(t (t (t t) (t t t)) (t t (t t t)))\""
+ , testCase "Determining the size of functions" $ do
+ library <- liftIO $ evaluateFile "./lib/base.tri"
+ res <- liftIO $ evaluateFileWithContext library "./demos/size.tri"
+ decodeResult (result res) @?= "2071"
+ , testCase "Level Order Traversal demo" $ do
+ library <- liftIO $ evaluateFile "./lib/base.tri"
+ res <- liftIO $ evaluateFileWithContext library "./demos/levelOrderTraversal.tri"
+ decodeResult (result res) @?= "\"\n1 \n2 3 \n4 5 6 7 \n8 11 10 9 12 \""
+ ]
