Eval optimization! Tests for demos

demos/equality.tri

@@ -1,19 +1,19 @@
 -- We represent `false` with a Leaf and `true` with a Stem Leaf
-false = t
+demo_false = t
-true  = t 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)
+demo_triage = (\a b c : t (t a b) c)
-matchBool = (\ot of : triage
+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
+true_TC?  = not_TC? demo_false
-false_TC? = not_TC? true
+false_TC? = not_TC? demo_true
 
-true_Lambda?  = not_Lambda? false
+true_Lambda?  = not_Lambda? demo_false
-false_Lambda? = not_Lambda? true
+false_Lambda? = not_Lambda? demo_true
 
 bothTrueEqual?  = equal? true_TC?  true_Lambda?
 bothFalseEqual? = equal? false_TC? false_Lambda?

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))
 

demos/size.tri

@@ -17,3 +17,5 @@ size = (\x :
         self 
         (\x y : compose (self x) (self y)) 
         x)) x 0))
+
+size size

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")

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)
+      | null vs                    = toSKI v (elimLambda body)
-      | otherwise            = elimLambda (SLambda [v] (SLambda vs body))
+      | otherwise                  = elimLambda (SLambda [v] (SLambda vs body))
-    go (SApp f g)            = SApp (elimLambda f) (elimLambda g)
+    go (SApp f g)                  = SApp (elimLambda f) (elimLambda g)
-    go x                     = x
+    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"

test/Spec.hs

@@ -25,16 +25,17 @@ runTricu s = show $ result (evalTricu Map.empty $ parseTricu s)
 
 tests :: TestTree
 tests = testGroup "Tricu Tests"
-  [ lexerTests
+  [ lexer
-  , parserTests
+  , parser
-  , evaluationTests
+  , simpleEvaluation
-  , lambdaEvalTests
+  , lambdas
-  , libraryTests
+  , baseLibrary
-  , fileEvaluationTests
+  , fileEval
+  , demos
   ]
 
-lexerTests :: TestTree
+lexer :: TestTree
-lexerTests = testGroup "Lexer Tests"
+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
+parser :: TestTree
-parserTests = testGroup "Parser Tests"
+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
+simpleEvaluation :: TestTree
-evaluationTests = testGroup "Evaluation Tests"
+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
+lambdas :: TestTree
-lambdaEvalTests = testGroup "Lambda Evaluation Tests"
+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
+baseLibrary :: TestTree
-libraryTests = testGroup "Library Tests"
+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
+fileEval :: TestTree
-fileEvaluationTests = testGroup "Evaluation tests"
+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 \""
+  ]