e5f3a53bcc
Implemented evaluation of tree calculus terms alongside referentially transparent variable identifiers. Implemented evaluation of defined functions into tree calculus.
142 lines
4.2 KiB
Haskell
142 lines
4.2 KiB
Haskell
module Main where
|
|
|
|
import Eval
|
|
import Lexer
|
|
import Parser
|
|
import Research
|
|
|
|
import qualified Data.Map as Map
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit
|
|
import Test.Tasty.QuickCheck
|
|
import Text.Megaparsec (runParser)
|
|
|
|
main :: IO ()
|
|
main = defaultMain tests
|
|
|
|
tests :: TestTree
|
|
tests = testGroup "Sapling Tests"
|
|
[ lexerTests
|
|
, parserTests
|
|
, integrationTests
|
|
, evaluationTests
|
|
, propertyTests
|
|
]
|
|
|
|
lexerTests :: TestTree
|
|
lexerTests = testGroup "Lexer Tests"
|
|
[ testCase "Lex simple identifiers" $ do
|
|
let input = "x a b = a"
|
|
let expected = Right [LIdentifier "x", LIdentifier "a", LIdentifier "b", LAssign, LIdentifier "a"]
|
|
runParser saplingLexer "" input @?= expected
|
|
|
|
, testCase "Lex Tree Calculus terms" $ do
|
|
let input = "t t t"
|
|
let expected = Right [LKeywordT, LKeywordT, LKeywordT]
|
|
runParser saplingLexer "" input @?= expected
|
|
|
|
, testCase "Handle invalid input" $ do
|
|
let input = "x = "
|
|
case runParser saplingLexer "" input of
|
|
Left _ -> return ()
|
|
Right _ -> assertFailure "Expected failure on invalid input"
|
|
]
|
|
|
|
parserTests :: TestTree
|
|
parserTests = testGroup "Parser Tests"
|
|
[ testCase "Parse function definitions" $ do
|
|
let input = "x a b = a"
|
|
let expected = SFunc "x" ["a", "b"] (SApp (SVar "a") [])
|
|
parseSapling input @?= expected
|
|
|
|
, testCase "Parse nested Tree Calculus terms" $ do
|
|
let input = "t (t t) t"
|
|
let expected = TFork (TStem TLeaf) TLeaf
|
|
parseSapling input @?= expected
|
|
|
|
, testCase "Parse sequential Tree Calculus terms" $ do
|
|
let input = "t t t"
|
|
let expected = TFork TLeaf TLeaf
|
|
parseSapling input @?= expected
|
|
]
|
|
|
|
integrationTests :: TestTree
|
|
integrationTests = testGroup "Integration Tests"
|
|
[ testCase "Combine lexer and parser" $ do
|
|
let input = "x = t t t"
|
|
let expected = SFunc "x" [] (TFork TLeaf TLeaf)
|
|
parseSapling input @?= expected
|
|
|
|
, testCase "Complex Tree Calculus expression" $ do
|
|
let input = "t (t t t) t"
|
|
let expected = TFork (TFork TLeaf TLeaf) TLeaf
|
|
parseSapling input @?= expected
|
|
]
|
|
|
|
evaluationTests :: TestTree
|
|
evaluationTests = testGroup "Evaluation Tests"
|
|
[ testCase "Evaluate single Leaf" $ do
|
|
let input = "t"
|
|
let ast = parseSapling input
|
|
(result $ evalSapling Map.empty ast) @?= Leaf
|
|
|
|
, testCase "Evaluate single Stem" $ do
|
|
let input = "t t"
|
|
let ast = parseSapling input
|
|
(result $ evalSapling Map.empty ast) @?= Stem Leaf
|
|
|
|
, testCase "Evaluate single Fork" $ do
|
|
let input = "t t t"
|
|
let ast = parseSapling input
|
|
(result $ evalSapling Map.empty ast) @?= Fork Leaf Leaf
|
|
|
|
, testCase "Evaluate nested Fork and Stem" $ do
|
|
let input = "t (t t) t"
|
|
let ast = parseSapling input
|
|
(result $ evalSapling Map.empty ast) @?= Fork (Stem Leaf) Leaf
|
|
|
|
, testCase "Evaluate `not` function" $ do
|
|
let input = "t (t (t t) (t t t)) t)"
|
|
let ast = parseSapling input
|
|
(result $ evalSapling Map.empty ast) @?=
|
|
Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
|
|
|
|
, testCase "Environment updates with definitions" $ do
|
|
let input = "x = t\ny = x"
|
|
let env = evalMulti Map.empty (parseMulti 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"
|
|
let env = evalMulti Map.empty (parseMulti input)
|
|
(result env) @?= Stem (Stem Leaf)
|
|
|
|
, testCase "Multiline input evaluation" $ do
|
|
let input = "x = t\ny = t t\nx"
|
|
let env = evalMulti Map.empty (parseMulti input)
|
|
(result env) @?= Leaf
|
|
|
|
, testCase "Evaluate string literal" $ do
|
|
let input = "\"hello\""
|
|
let ast = parseSapling input
|
|
(result $ evalSapling Map.empty ast) @?= toString "hello"
|
|
|
|
, testCase "Evaluate list literal" $ do
|
|
let input = "[t (t t)]"
|
|
let ast = parseSapling input
|
|
(result $ evalSapling Map.empty ast) @?= toList [Leaf, Stem Leaf]
|
|
|
|
]
|
|
|
|
propertyTests :: TestTree
|
|
propertyTests = testGroup "Property Tests"
|
|
[ testProperty "Lexing and parsing round-trip" $ \input ->
|
|
case runParser saplingLexer "" input of
|
|
Left _ -> property True
|
|
Right tokens -> case runParser parseExpression "" tokens of
|
|
Left _ -> property True
|
|
Right ast -> parseSapling input === ast
|
|
]
|
|
|