James/tricu
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

0.2.0

Browse Source 
Includes better error handling, additional tests, parsing and lexing
fixes to match the desired behavior defined by the new tests, and a very
basic REPL implementation.
This commit is contained in:
James Eversole
2024-12-20 11:38:09 -06:00
committed by James Eversole
parent 2a63942cdb
commit b3583c796e
8 changed files with 234 additions and 136 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
sapling.cabal
View File

@ -1,7 +1,7 @@
cabal-version: 1.12
name: sapling
version: 0.1.0
version: 0.2.0
description: Tree Calculus experiment repository
author: James Eversole
maintainer: james@eversole.co
@ -34,6 +34,7 @@ executable sapling
Eval
Lexer
Parser
REPL
Research
default-language: Haskell2010
@ -54,4 +55,5 @@ test-suite sapling-tests
Eval
Lexer
Parser
REPL
Research

30
src/Eval.hs
View File

@ -6,31 +6,31 @@ import Research
import qualified Data.Map as Map
import Data.Map (Map)
evalSapling :: Map String T -> SaplingAST -> Map String T
evalSapling env TLeaf = Map.insert "__result" Leaf env
evalSapling env (TStem t) =
evalSingle :: Map String T -> SaplingAST -> Map String T
evalSingle env TLeaf = Map.insert "__result" Leaf env
evalSingle env (TStem t) =
let result = Stem (evalTreeCalculus env t)
in Map.insert "__result" result env
evalSapling env (TFork t1 t2) =
evalSingle env (TFork t1 t2) =
let result = Fork (evalTreeCalculus env t1) (evalTreeCalculus env t2)
in Map.insert "__result" result env
evalSapling env (SFunc name [] body) =
evalSingle env (SFunc name [] body) =
let value = evalTreeCalculus env body
in Map.insert name value env
evalSapling env (SVar name) =
evalSingle env (SVar name) =
case Map.lookup name env of
Just value -> Map.insert "__result" value env
Nothing -> error $ "Variable " ++ name ++ " not defined"
evalSapling env ast = Map.insert "__result" (evalTreeCalculus env ast) env
evalSingle env ast = Map.insert "__result" (evalTreeCalculus env ast) env
evalMulti :: Map String T -> [SaplingAST] -> Map String T
evalMulti env [] = env
evalMulti env [lastLine] =
let updatedEnv = evalSapling env lastLine
evalSapling :: Map String T -> [SaplingAST] -> Map String T
evalSapling env [] = env
evalSapling env [lastLine] =
let updatedEnv = evalSingle env lastLine
in Map.insert "__result" (result updatedEnv) updatedEnv
evalMulti env (line:rest) =
let updatedEnv = evalSapling env line
in evalMulti updatedEnv rest
evalSapling env (line:rest) =
let updatedEnv = evalSingle env line
in evalSapling updatedEnv rest
evalTreeCalculus :: Map.Map String T -> SaplingAST -> T
evalTreeCalculus _ TLeaf = Leaf
@ -51,7 +51,7 @@ evalTreeCalculus _ (SList elems) = toList (map (evalTreeCalculus Map.empty) elem
evalTreeCalculus _ (SFunc name args body) =
error $ "Unexpected function definition " ++ name ++ " in \
\ evalTreeCalculus; functions should be evaluated to Tree Calculus \
\ terms by evalSapling."
\ terms by evalSingle."
result :: Map String T -> T
result r = case (Map.lookup "__result" r) of

22
src/Lexer.hs
View File

@ -4,7 +4,9 @@ import Research
import Text.Megaparsec
import Text.Megaparsec.Char
import Data.Void
import qualified Data.Set as Set
-- Lexer type and tokens
type Lexer = Parsec Void String
data LToken
= LKeywordT
@ -19,6 +21,7 @@ data LToken
| LNewline
deriving (Show, Eq, Ord)
-- Lexical rules
keywordT :: Lexer LToken
keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT
@ -38,8 +41,11 @@ stringLiteral :: Lexer LToken
stringLiteral = do
char '"'
content <- many (noneOf ['"'])
char '"' --"
return (LStringLiteral content)
if null content
then fail "Empty string literals are not allowed"
else do
char '"' -- "
return (LStringLiteral content)
assign :: Lexer LToken
assign = char '=' *> pure LAssign
@ -59,13 +65,15 @@ closeBracket = char ']' *> pure LCloseBracket
lnewline :: Lexer LToken
lnewline = char '\n' *> pure LNewline
-- Whitespace consumer
sc :: Lexer ()
sc = skipMany (char ' ' <|> char '\t')
-- Lexer definition
saplingLexer :: Lexer [LToken]
saplingLexer = many (sc *> choice
[ try keywordT
, try identifier
[ try identifier
, try keywordT
, try integerLiteral
, try stringLiteral
, assign
@ -74,8 +82,10 @@ saplingLexer = many (sc *> choice
, openBracket
, closeBracket
, lnewline
]) <* eof
] <* sc) <* eof
-- Lexing function with enhanced error handling
lexSapling :: String -> [LToken]
lexSapling input = case runParser saplingLexer "" input of
Left err -> error "Failed to lex input"
Left err -> error $ "Lexical error:\n" ++ errorBundlePretty err
Right tokens -> tokens

7
src/Main.hs
View File

@ -3,14 +3,11 @@ module Main where
import Eval
import Lexer
import Parser
import REPL (repl)
import Research
import Data.Map as Map
import Text.Megaparsec (runParser)
main :: IO ()
main = putStr
$ show
$ result
$ evalMulti Map.empty (parseMulti
"false = t\nnot = t (t (t t) (t t t)) t\ntrue = not false\ntrue")
main = repl Map.empty --(Map.fromList [("__result", Leaf)])

89
src/Parser.hs
View File

@ -1,10 +1,15 @@
module Parser where
import Lexer
import Research
import Research hiding (toList)
import Control.Exception (throw)
import Data.List.NonEmpty (toList)
import qualified Data.Set as Set
import Data.Void
import Text.Megaparsec
import Text.Megaparsec.Char
import Data.Void
import Text.Megaparsec.Error (errorBundlePretty, ParseErrorBundle)
type Parser = Parsec Void [LToken]
data SaplingAST
@ -19,10 +24,15 @@ data SaplingAST
| TFork SaplingAST SaplingAST
deriving (Show, Eq, Ord)
parseSapling :: String -> SaplingAST
parseSapling "" = error "Empty input provided to parseSapling"
parseSapling input = case runParser parseExpression "" (lexSapling input) of
Left err -> error "Failed to parse input"
parseSapling :: String -> [SaplingAST]
parseSapling input =
let nonEmptyLines = filter (not . null) (lines 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
scnParser :: Parser ()
@ -48,7 +58,7 @@ parseFunction = do
parseApplication :: Parser SaplingAST
parseApplication = do
func <- parseAtomicBase
args <- many parseAtomic
args <- many parseAtomicApplication
case func of
TLeaf | not (null args) && all isTreeTerm args -> fail "Defer to Tree Calculus"
_ -> return (SApp func args)
@ -66,7 +76,7 @@ parseAtomicBase = choice
]
parseTreeLeaf :: Parser SaplingAST
parseTreeLeaf = satisfy isKeywordT *> pure TLeaf
parseTreeLeaf = satisfy isKeywordT *> notFollowedBy (satisfy (== LAssign)) *> pure TLeaf
getIdentifier :: LToken -> String
getIdentifier (LIdentifier name) = name
@ -86,7 +96,7 @@ parseTreeTerm = do
parseTreeLeafOrParenthesized :: Parser SaplingAST
parseTreeLeafOrParenthesized = choice
[ between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseTreeTerm
, satisfy isKeywordT *> pure TLeaf
, parseTreeLeaf
]
foldTree :: [SaplingAST] -> SaplingAST
@ -103,6 +113,22 @@ parseAtomic = choice
, between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseExpression
]
parseAtomicApplication :: Parser SaplingAST
parseAtomicApplication = do
token <- anySingle
case token of
LAssign -> fail
"Unexpected `=` character in application context. \
\ This is usually caused by an incomplete definition such as: \
\ `function a b =`"
LIdentifier name -> return (SVar name)
LKeywordT -> return TLeaf
LIntegerLiteral value -> return (SInt value)
LStringLiteral value -> return (SStr value)
LOpenBracket -> parseListLiteral
LOpenParen -> between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseExpression
_ -> fail "Invalid token while parsing attempted function application"
parseLiteral :: Parser SaplingAST
parseLiteral = choice
[ parseIntLiteral
@ -125,21 +151,21 @@ parseListLiteral = do
parseListItem :: Parser SaplingAST
parseListItem = choice
[ parseGroupedItem -- Handle expressions inside parentheses
, parseListLiteral -- Allow nested lists
, parseSingleItem -- Handle single tokens like `t` or identifiers
[ parseGroupedItem
, parseListLiteral
, parseSingleItem
]
parseGroupedItem :: Parser SaplingAST
parseGroupedItem = do
satisfy (== LOpenParen)
satisfy (== LOpenParen)
inner <- parseExpression
satisfy (== LCloseParen)
return inner
parseSingleItem :: Parser SaplingAST
parseSingleItem = do
token <- satisfy isListItem
token <- satisfy isListItem
case token of
LIdentifier name -> return (SVar name)
LKeywordT -> return TLeaf
@ -151,9 +177,11 @@ isListItem LKeywordT = True
isListItem _ = False
parseVar :: Parser SaplingAST
parseVar = do
parseVar = do
LIdentifier name <- satisfy isIdentifier
return (SVar name)
if (name == "t" || name == "__result")
then fail $ "Reserved keyword: " ++ name ++ " cannot be assigned."
else return (SVar name)
parseIntLiteral :: Parser SaplingAST
parseIntLiteral = do
@ -165,11 +193,6 @@ parseStrLiteral = do
LStringLiteral value <- satisfy isStringLiteral
return (SStr value)
parseMulti :: String -> [SaplingAST]
parseMulti input =
let nonEmptyLines = filter (not . null) (lines input)
in map parseSapling nonEmptyLines
-- Boolean Helpers
isKeywordT (LKeywordT) = True
isKeywordT _ = False
@ -183,5 +206,27 @@ isIntegerLiteral _ = False
isStringLiteral (LStringLiteral _) = True
isStringLiteral _ = False
isNewline (LNewline) = True
isLiteral (LIntegerLiteral _) = True
isLiteral (LStringLiteral _) = True
isLiteral _ = False
esNewline (LNewline) = True
isNewline _ = False
-- Error Handling
handleParseError :: ParseErrorBundle [LToken] Void -> String
handleParseError bundle =
let errors = bundleErrors bundle
errorList = toList errors
formattedErrors = map showError errorList
in unlines ("Parse error(s) encountered:" : formattedErrors)
showError :: ParseError [LToken] Void -> String
showError (TrivialError offset (Just (Tokens tokenStream)) expected) =
"Parse error at offset " ++ show offset ++ ": unexpected token "
++ show tokenStream ++ ", expected one of " ++ show (Set.toList expected)
showError (FancyError offset fancy) =
"Parse error at offset " ++ show offset ++ ":\n " ++ unlines (map show (Set.toList fancy))
showError (TrivialError offset Nothing expected) =
"Parse error at offset " ++ show offset ++ ": expected one of "
++ show (Set.toList expected)

25
src/REPL.hs Normal file
View File

@ -0,0 +1,25 @@
module REPL where
import Eval
import Lexer
import Parser
import Research
import Control.Monad (void)
import qualified Data.Map as Map
import System.IO (hFlush, stdout)
repl :: Map.Map String T -> IO ()
repl env = do
putStr "sapling > "
hFlush stdout
input <- getLine
if input == "_:exit"
then putStrLn "Goodbye!"
else do
let clearEnv = Map.delete "__result" env
let newEnv = evalSingle clearEnv (parseSingle input)
case Map.lookup "__result" newEnv of
Just r -> putStrLn $ "sapling < " ++ show r
Nothing -> pure ()
repl newEnv

18
src/Research.hs
View File

@ -24,8 +24,8 @@ reduce expr =
step :: T -> T
step (Fork left right) = reduce (apply (reduce left) (reduce right))
step (Stem inner) = Stem (reduce inner)
step t = t
step (Stem inner) = Stem (reduce inner)
step t = t
-- SKI Combinators
_S :: T
@ -54,20 +54,20 @@ toString str = toList (map toNumber (map fromEnum str))
ofString :: T -> String
ofString tc = map (toEnum . ofNumber) (ofList tc)
toNumber :: Int -> T
toNumber :: Int -> T
toNumber 0 = Leaf
toNumber n =
Fork
(if odd n then Stem Leaf else Leaf)
(toNumber (n `div` 2))
(toNumber (n `div` 2))
ofNumber :: T -> Int
ofNumber Leaf = 0
ofNumber (Fork Leaf rest) = 2 * ofNumber rest
ofNumber (Fork (Stem Leaf) rest) = 1 + 2 * ofNumber rest
ofNumber _ = error "Invalid Tree Calculus number"
ofNumber _ = error "Invalid Tree Calculus number"
toList :: [T] -> T
toList :: [T] -> T
toList [] = Leaf
toList (x:xs) = Fork x (toList xs)
@ -92,13 +92,13 @@ toAscii tree = go tree "" True
++ go right (prefix ++ (if isLast then " " else "| ")) True
rules :: IO ()
rules = putStr $ header
++ (unlines $ tcRules)
rules = putStr $ header
++ (unlines $ tcRules)
++ (unlines $ haskellRules)
++ footer
where
tcRules :: [String]
tcRules =
tcRules =
[ "| |"
, "| ┌--------- | Tree Calculus | ---------┐ |"
, "| | 1. t t a b -> a | |"

175
test/Spec.hs
View File

@ -28,195 +28,215 @@ 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
let expect = Right [LIdentifier "x", LIdentifier "a", LIdentifier "b", LAssign, LIdentifier "a"]
runParser saplingLexer "" input @?= expect
, 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"
let expect = Right [LKeywordT, LKeywordT, LKeywordT]
runParser saplingLexer "" input @?= expect
, testCase "Lex escaped characters in strings" $ do
let input = "\"hello\\nworld\""
let expected = Right [LStringLiteral "hello\\nworld"]
runParser saplingLexer "" input @?= expected
let expect = Right [LStringLiteral "hello\\nworld"]
runParser saplingLexer "" input @?= expect
, testCase "Lex mixed literals" $ do
let input = "t \"string\" 42"
let expected = Right [LKeywordT, LStringLiteral "string", LIntegerLiteral 42]
runParser saplingLexer "" input @?= expected
let expect = Right [LKeywordT, LStringLiteral "string", LIntegerLiteral 42]
runParser saplingLexer "" input @?= expect
, testCase "Lex invalid token" $ do
let input = "$invalid"
case runParser saplingLexer "" input of
Left _ -> return ()
Right _ -> assertFailure "Expected lexer to fail on invalid token"
, testCase "Drop trailing whitespace in definitions" $ do
let input = "x = 5 "
let expect = [LIdentifier "x",LAssign,LIntegerLiteral 5]
case (runParser saplingLexer "" input) of
Left _ -> assertFailure "Failed to lex input"
Right i -> i @?= expect
, testCase "Error when using invalid characters in identifiers" $ do
case (runParser saplingLexer "" "__result = 5") of
Left _ -> return ()
Right _ -> assertFailure "Expected failure when trying to assign the value of __result"
]
parserTests :: TestTree
parserTests = testGroup "Parser Tests"
[ testCase "Parse function definitions" $ 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 ()
Right _ -> assertFailure "Expected failure when trying to assign the value of T"
, testCase "Error when parsing bodyless definitions with arguments" $ do
let input = lexSapling "x a b = "
case (runParser parseExpression "" input) of
Left _ -> return ()
Right _ -> assertFailure "Expected failure on invalid input"
, testCase "Parse function definitions" $ do
let input = "x a b = a"
let expected = SFunc "x" ["a", "b"] (SApp (SVar "a") [])
parseSapling input @?= expected
let expect = SFunc "x" ["a", "b"] (SApp (SVar "a") [])
parseSingle input @?= expect
, testCase "Parse nested Tree Calculus terms" $ do
let input = "t (t t) t"
let expected = TFork (TStem TLeaf) TLeaf
parseSapling input @?= expected
let expect = TFork (TStem TLeaf) TLeaf
parseSingle input @?= expect
, testCase "Parse sequential Tree Calculus terms" $ do
let input = "t t t"
let expected = TFork TLeaf TLeaf
parseSapling input @?= expected
let expect = TFork TLeaf TLeaf
parseSingle input @?= expect
, testCase "Parse mixed list literals" $ do
-- You must put non-list literals in parentheses
let input = "[t (\"hello\") t]"
let expected = SList [TLeaf, SStr "hello", TLeaf]
parseSapling input @?= expected
let expect = SList [TLeaf, SStr "hello", TLeaf]
parseSingle input @?= expect
, testCase "Parse function with applications" $ do
let input = "f x = t x"
let expected = SFunc "f" ["x"] (SApp TLeaf [SVar "x"])
parseSapling input @?= expected
let expect = SFunc "f" ["x"] (SApp TLeaf [SVar "x"])
parseSingle input @?= expect
, testCase "Parse nested lists" $ do
let input = "[t [(t t)]]"
let expected = SList [TLeaf, SList [TStem TLeaf]]
parseSapling input @?= expected
let expect = SList [TLeaf, SList [TStem TLeaf]]
parseSingle input @?= expect
, testCase "Parse complex parentheses" $ do
let input = "t (t t (t t))"
let expected = TStem (TFork TLeaf (TStem TLeaf))
parseSapling input @?= expected
let expect = TStem (TFork TLeaf (TStem TLeaf))
parseSingle input @?= expect
, testCase "Parse empty list" $ do
let input = "[]"
let expected = SList []
parseSapling input @?= expected
let expect = SList []
parseSingle input @?= expect
, testCase "Parse multiple nested lists" $ do
let input = "[[t t] [t (t t)]]"
let expected = SList [SList [TLeaf, TLeaf], SList [TLeaf, TStem TLeaf]]
parseSapling input @?= expected
let expect = SList [SList [TLeaf, TLeaf], SList [TLeaf, TStem TLeaf]]
parseSingle input @?= expect
, testCase "Parse whitespace variance" $ do
let input1 = "[t t]"
let input2 = "[ t t ]"
let expected = SList [TLeaf, TLeaf]
parseSapling input1 @?= expected
parseSapling input2 @?= expected
let expect = SList [TLeaf, TLeaf]
parseSingle input1 @?= expect
parseSingle input2 @?= expect
, testCase "Parse string in list" $ do
let input = "[(\"hello\")]"
let expected = SList [SStr "hello"]
parseSapling input @?= expected
let expect = SList [SStr "hello"]
parseSingle input @?= expect
, testCase "Parse parentheses inside list" $ do
let input = "[t (t t)]"
let expected = SList [TLeaf, TStem TLeaf]
parseSapling input @?= expected
-- Do I want to allow multi-line indentation-sensitive syntax?
-- Probably not.
--, testCase "Parse multi-line function definition" $ do
-- let input = "f x y =\n t t"
-- let expected = SFunc "f" ["x", "y"] (TStem TLeaf)
-- parseSapling input @?= expected
let expect = SList [TLeaf, TStem TLeaf]
parseSingle input @?= expect
, testCase "Parse nested parentheses in function body" $ do
let input = "f = t (t (t t))"
let expected = SFunc "f" [] (TStem (TStem (TStem TLeaf)))
parseSapling input @?= expected
let expect = SFunc "f" [] (TStem (TStem (TStem TLeaf)))
parseSingle input @?= expect
]
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
let expect = SFunc "x" [] (TFork TLeaf TLeaf)
parseSingle input @?= expect
, testCase "Complex Tree Calculus expression" $ do
let input = "t (t t t) t"
let expected = TFork (TFork TLeaf TLeaf) TLeaf
parseSapling input @?= expected
let expect = TFork (TFork TLeaf TLeaf) TLeaf
parseSingle input @?= expect
]
evaluationTests :: TestTree
evaluationTests = testGroup "Evaluation Tests"
[ testCase "Evaluate single Leaf" $ do
let input = "t"
let ast = parseSapling input
(result $ evalSapling Map.empty ast) @?= Leaf
let ast = parseSingle input
(result $ evalSingle Map.empty ast) @?= Leaf
, testCase "Evaluate single Stem" $ do
let input = "t t"
let ast = parseSapling input
(result $ evalSapling Map.empty ast) @?= Stem Leaf
let ast = parseSingle input
(result $ evalSingle 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
let ast = parseSingle input
(result $ evalSingle 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
let ast = parseSingle input
(result $ evalSingle 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) @?=
let ast = parseSingle input
(result $ evalSingle 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)
let env = evalSapling Map.empty (parseSapling 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)
let env = evalSapling Map.empty (parseSapling 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)
let env = evalSapling Map.empty (parseSapling input)
(result env) @?= Leaf
, testCase "Evaluate string literal" $ do
let input = "\"hello\""
let ast = parseSapling input
(result $ evalSapling Map.empty ast) @?= toString "hello"
let ast = parseSingle input
(result $ evalSingle 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]
let ast = parseSingle input
(result $ evalSingle Map.empty ast) @?= toList [Leaf, Stem Leaf]
, testCase "Evaluate empty list" $ do
let input = "[]"
let ast = parseSapling input
(result $ evalSapling Map.empty ast) @?= toList []
let ast = parseSingle input
(result $ evalSingle Map.empty ast) @?= toList []
, testCase "Evaluate variable dependency chain" $ do
let input = "x = t\ny = t x\nz = t y\nz"
let env = evalMulti Map.empty (parseMulti input)
let input = "x = t\n \
\ y = t x\n \
\ z = t y\n \
\ variablewithamuchlongername = z\n \
\ variablewithamuchlongername"
let env = evalSapling Map.empty (parseSapling input)
(result env) @?= (Stem (Stem Leaf))
, testCase "Evaluate redefinition of variables" $ do
let input = "x = t t\nx = t\nx"
let env = evalMulti Map.empty (parseMulti input)
let env = evalSapling Map.empty (parseSapling input)
(result env) @?= Leaf
]
@ -227,6 +247,5 @@ propertyTests = testGroup "Property Tests"
Left _ -> property True
Right tokens -> case runParser parseExpression "" tokens of
Left _ -> property True
Right ast -> parseSapling input === ast
Right ast -> parseSingle input === ast
]