Include equality testing in basic library

This commit is contained in:
James Eversole
2024-12-27 16:30:32 -06:00
parent e835caabbc
commit c820eda816
4 changed files with 56 additions and 67 deletions

View File

@ -2,6 +2,7 @@ module Main where
import Eval
import Lexer
import Library
import Parser
import Research
import Control.Exception (evaluate, try, SomeException)
@ -227,48 +228,25 @@ evaluationTests = testGroup "Evaluation Tests"
result env @?= Stem Leaf
, testCase "Boolean AND_ TF" $ do
let input = "and (t t) (t)"
env = evalSapling boolEnv (parseSapling input)
env = evalSapling library (parseSapling input)
result env @?= Leaf
, testCase "Boolean AND_ FT" $ do
let input = "and (t) (t t)"
env = evalSapling boolEnv (parseSapling input)
env = evalSapling library (parseSapling input)
result env @?= Leaf
, testCase "Boolean AND_ FF" $ do
let input = "and (t) (t)"
env = evalSapling boolEnv (parseSapling input)
env = evalSapling library (parseSapling input)
result env @?= Leaf
, testCase "Boolean AND_ TT" $ do
let input = "and (t t) (t t)"
env = evalSapling boolEnv (parseSapling input)
env = evalSapling library (parseSapling input)
result env @?= Stem Leaf
, testCase "Verifying Equality" $ do
let input = "equal (t t t) (t t t)"
env = evalSapling library (parseSapling input)
result env @?= Stem Leaf
--, testCase "Verifying Equality" $ do
-- let input = "equal (t t t) (t t t)"
-- env = evalSapling boolEnv (parseSapling input)
-- result env @?= Stem Leaf
]
where
boolEnv = evalSapling Map.empty $ parseSapling
"false = t\n \
\ true = t t\n \
\ id = (\\a : a)\n \
\ triage = (\\a b c : t (t a b) c)\n \
\ match_bool = (\\ot of : triage of (\\z : ot) t)\n \
\ and = match_bool id (\\z : false)\n \
\ if = (\\cond then else : t (t else (t t then)) t cond)\n \
\ fix = (\\m wait f : wait m (\\x : f (wait m x))) (\\x : x x) (\\a b c : (t (t a) (t t c) b))\n \
\ equal = fix ((\\self : triage (triage true (\\z : false) (\\z x : false)) (\\ax : triage false (self ax) (\\z x : false)) (\\ax ay : triage false (\\z : false) (\\bx by : and (self ax bx) (self ay by)))))"
-- false = t
-- true = t t
-- id = \x x
-- fix = (\m \wait2 \f wait2 m (\x f (wait2 m x))) (\x x x) (\a \b \c t (t a) (t t c) b)
-- triage = \a \b \c t (t a b) c
-- match_bool = \ot \of triage of (\_ ot) t
-- and = match_bool id (\_ false)
-- equal = fix $ \self triage
-- (triage true (\_ false) (\_ \_ false))
-- (\ax triage false (self ax) (\_ \_ false))
-- (\ax \ay triage false (\_ false) (\bx \by and (self ax bx) (self ay by)))
lambdaEvalTests :: TestTree
lambdaEvalTests = testGroup "Lambda Evaluation Tests"
@ -340,4 +318,3 @@ propertyTests = testGroup "Property Tests"
Left _ -> property True
Right ast -> parseSingle input === ast
]