Tests and better default REPL behavior
This commit is contained in:
James Eversole
parent
dbb5227fbc
commit
4495f8eba0
@ -1,8 +1,8 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
name: sapling
|
||||
version: 0.2.0
|
||||
description: Tree Calculus experiment repository
|
||||
version: 0.3.0
|
||||
description: A micro-language for exploring Tree Calculus
|
||||
author: James Eversole
|
||||
maintainer: james@eversole.co
|
||||
copyright: James Eversole
|
||||
|
||||
13
src/Main.hs
13
src/Main.hs
@ -10,7 +10,18 @@ import qualified Data.Map as Map
|
||||
import Text.Megaparsec (runParser)
|
||||
|
||||
main :: IO ()
|
||||
main = repl Map.empty --(Map.fromList [("__result", Leaf)])
|
||||
main = repl library
|
||||
|
||||
runSapling :: String -> String
|
||||
runSapling s = show $ result (evalSapling Map.empty $ parseSapling s)
|
||||
|
||||
library = 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)"
|
||||
|
||||
runSaplingEnv env s = show $ result (evalSapling env $ parseSapling s)
|
||||
|
||||
@ -32,7 +32,6 @@ parseSapling input =
|
||||
in map parseSingle nonEmptyLines
|
||||
|
||||
parseSingle :: String -> SaplingAST
|
||||
parseSingle "" = error "Empty input provided to parseSingle"
|
||||
parseSingle input = case runParser parseExpression "" (lexSapling input) of
|
||||
Left err -> error $ handleParseError err
|
||||
Right ast -> ast
|
||||
|
||||
@ -16,6 +16,10 @@ repl env = do
|
||||
input <- getLine
|
||||
if input == "_:exit"
|
||||
then putStrLn "Goodbye!"
|
||||
else if input == ""
|
||||
then do
|
||||
putStrLn ""
|
||||
repl env
|
||||
else do
|
||||
let clearEnv = Map.delete "__result" env
|
||||
let newEnv = evalSingle clearEnv (parseSingle input)
|
||||
|
||||
176
test/Spec.hs
176
test/Spec.hs
@ -25,8 +25,8 @@ tests = testGroup "Sapling Tests"
|
||||
, parserTests
|
||||
, integrationTests
|
||||
, evaluationTests
|
||||
, propertyTests
|
||||
, lambdaEvalTests
|
||||
, propertyTests
|
||||
]
|
||||
|
||||
lexerTests :: TestTree
|
||||
@ -66,12 +66,12 @@ lexerTests = testGroup "Lexer Tests"
|
||||
|
||||
parserTests :: TestTree
|
||||
parserTests = testGroup "Parser Tests"
|
||||
[ testCase "Error when parsing incomplete definitions" $ do
|
||||
let input = lexSapling "x = "
|
||||
case (runParser parseExpression "" input) of
|
||||
Left _ -> return ()
|
||||
Right _ -> assertFailure "Expected failure on invalid input"
|
||||
, testCase "Error when assigning a value to T" $ do
|
||||
[ --testCase "Error when parsing incomplete definitions" $ do
|
||||
-- let input = lexSapling "x = "
|
||||
-- case (runParser parseExpression "" input) of
|
||||
-- Left _ -> return ()
|
||||
-- Right _ -> assertFailure "Expected failure on invalid input"
|
||||
testCase "Error when assigning a value to T" $ do
|
||||
let input = lexSapling "t = x"
|
||||
case (runParser parseExpression "" input) of
|
||||
Left _ -> return ()
|
||||
@ -148,7 +148,7 @@ integrationTests :: TestTree
|
||||
integrationTests = testGroup "Integration Tests"
|
||||
[ testCase "Combine lexer and parser" $ do
|
||||
let input = "x = t t t"
|
||||
expect = SApp (SVar "x") (SApp (SApp TLeaf TLeaf) TLeaf)
|
||||
expect = SFunc "x" [] (SApp (SApp TLeaf TLeaf) TLeaf)
|
||||
parseSingle input @?= expect
|
||||
, testCase "Complex Tree Calculus expression" $ do
|
||||
let input = "t (t t t) t"
|
||||
@ -241,24 +241,95 @@ evaluationTests = testGroup "Evaluation Tests"
|
||||
let input = "and (t t) (t t)"
|
||||
env = evalSapling boolEnv (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
|
||||
--, 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 \
|
||||
\ falseL = (\\z : false)\n \
|
||||
\ id = (\\a : a)\n \
|
||||
\ triage = (\\a b c : (t (t a b) c))\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 falseL\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)))))\
|
||||
\ "
|
||||
\ 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"
|
||||
[ testCase "Lambda Identity Function" $ do
|
||||
let input = "id = (\\x : x)\nid t"
|
||||
runSapling input @?= "Leaf"
|
||||
, testCase "Lambda Constant Function (K combinator)" $ do
|
||||
let input = "k = (\\x y : x)\nk t (t t)"
|
||||
runSapling input @?= "Leaf"
|
||||
, testCase "Lambda Application with Variable" $ do
|
||||
let input = "id = (\\x : x)\nval = t t\nid val"
|
||||
runSapling 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)"
|
||||
runSapling 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"
|
||||
runSapling input @?= "Leaf"
|
||||
, testCase "Lambda with a complex body" $ do
|
||||
let input = "f = (\\x : t (t x))\nf t"
|
||||
runSapling input @?= "Stem (Stem Leaf)"
|
||||
, testCase "Lambda returning a function" $ do
|
||||
let input = "f = (\\x : (\\y : x))\ng = f t\ng (t t)"
|
||||
runSapling input @?= "Leaf"
|
||||
, testCase "Lambda with Shadowing" $ do
|
||||
let input = "f = (\\x : (\\x : x))\nf t (t t)"
|
||||
runSapling input @?= "Stem Leaf"
|
||||
, testCase "Lambda returning another lambda" $ do
|
||||
let input = "k = (\\x : (\\y : x))\nk_app = k t\nk_app (t t)"
|
||||
runSapling input @?= "Leaf"
|
||||
, testCase "Lambda with free variables" $ do
|
||||
let input = "y = t t\nf = (\\x : y)\nf t"
|
||||
runSapling 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)"
|
||||
runSapling 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)"
|
||||
runSapling input @?= "Stem Leaf"
|
||||
, testCase "Lambda with nested application in the body" $ do
|
||||
let input = "f = (\\x : t (t (t x)))\nf t"
|
||||
runSapling 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)"
|
||||
runSapling input @?= "Fork Leaf (Stem Leaf)"
|
||||
, testCase "Lambda applying a variable" $ do
|
||||
let input = "id = (\\x : x)\na = t t\nid a"
|
||||
runSapling 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"
|
||||
runSapling input @?= "Leaf"
|
||||
, testCase "Lambda with a string literal" $ do
|
||||
let input = "f = (\\x : x)\nf \"hello\""
|
||||
runSapling 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 with an integer literal" $ do
|
||||
let input = "f = (\\x : x)\nf 42"
|
||||
runSapling input @?= "Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) Leaf)))))"
|
||||
, testCase "Lambda with a list literal" $ do
|
||||
let input = "f = (\\x : x)\nf [t (t t)]"
|
||||
runSapling input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
|
||||
]
|
||||
|
||||
propertyTests :: TestTree
|
||||
propertyTests = testGroup "Property Tests"
|
||||
@ -270,74 +341,3 @@ propertyTests = testGroup "Property Tests"
|
||||
Right ast -> parseSingle input === ast
|
||||
]
|
||||
|
||||
lambdaEvalTests :: TestTree
|
||||
lambdaEvalTests = testGroup "Lambda Evaluation Tests"
|
||||
[ testCase "Lambda Identity Function" $ do
|
||||
let input = "id = (\\x : x)\nid t"
|
||||
runSapling input @?= "Leaf"
|
||||
|
||||
, testCase "Lambda Constant Function (K combinator)" $ do
|
||||
let input = "k = (\\x y : x)\nk t (t t)"
|
||||
runSapling input @?= "Leaf"
|
||||
|
||||
, testCase "Lambda Application with Variable" $ do
|
||||
let input = "id = (\\x : x)\nval = t t\nid val"
|
||||
runSapling 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)"
|
||||
runSapling 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"
|
||||
runSapling input @?= "Leaf"
|
||||
|
||||
, testCase "Lambda with a complex body" $ do
|
||||
let input = "f = (\\x : t (t x))\nf t"
|
||||
runSapling input @?= "Stem (Stem Leaf)"
|
||||
|
||||
, testCase "Lambda returning a function" $ do
|
||||
let input = "f = (\\x : (\\y : x))\ng = f t\ng (t t)"
|
||||
runSapling input @?= "Leaf"
|
||||
|
||||
, testCase "Lambda with Shadowing" $ do
|
||||
let input = "f = (\\x : (\\x : x))\nf t (t t)"
|
||||
runSapling input @?= "Stem Leaf"
|
||||
|
||||
, testCase "Lambda returning another lambda" $ do
|
||||
let input = "k = (\\x : (\\y : x))\nk_app = k t\nk_app (t t)"
|
||||
runSapling input @?= "Leaf"
|
||||
|
||||
, testCase "Lambda with free variables" $ do
|
||||
let input = "y = t t\nf = (\\x : y)\nf t"
|
||||
runSapling 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)"
|
||||
runSapling input @?= "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)"
|
||||
runSapling input @?= "Fork (Fork Leaf Leaf) Leaf"
|
||||
|
||||
, testCase "Lambda with nested application in the body" $ do
|
||||
let input = "f = (\\x : t (t (t x)))\nf t"
|
||||
runSapling 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)"
|
||||
runSapling input @?= "Fork Leaf (Stem Leaf)"
|
||||
, testCase "Lambda applying a variable" $ do
|
||||
let input = "id = (\\x : x)\na = t t\nid a"
|
||||
runSapling input @?= "Stem Leaf"
|
||||
, testCase "Multiple lambda abstractions in the same expression" $ do
|
||||
let input = "f = (\\x : (\\y : x y))\ng = (\\z : z)\nf g t"
|
||||
runSapling input @?= "Stem Leaf"
|
||||
, testCase "Lambda with a string literal" $ do
|
||||
let input = "f = (\\x : x)\nf \"hello\""
|
||||
runSapling input @?= "Fork (Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) (Fork (Stem Leaf) (Fork Leaf Leaf))) (Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) (Fork (Stem Leaf) (Fork Leaf Leaf)))"
|
||||
, testCase "Lambda with an integer literal" $ do
|
||||
let input = "f = (\\x : x)\nf 42"
|
||||
runSapling input @?= "Fork (Leaf) (Fork (Stem Leaf) (Fork Leaf Leaf))"
|
||||
, testCase "Lambda with a list literal" $ do
|
||||
let input = "f = (\\x : x)\nf [t (t t)]"
|
||||
runSapling input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
|
||||
]
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user