From c16c48b22c4a93d4930290401eb12780bd6743bf Mon Sep 17 00:00:00 2001 From: James Eversole Date: Fri, 20 Dec 2024 11:38:09 -0600 Subject: [PATCH] 0.2.0 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. --- sapling.cabal | 4 +- src/Eval.hs | 30 ++++----- src/Lexer.hs | 22 ++++-- src/Main.hs | 7 +- src/Parser.hs | 89 ++++++++++++++++++------ src/REPL.hs | 25 +++++++ src/Research.hs | 18 ++--- test/Spec.hs | 175 +++++++++++++++++++++++++++--------------------- 8 files changed, 234 insertions(+), 136 deletions(-) create mode 100644 src/REPL.hs diff --git a/sapling.cabal b/sapling.cabal index 3072066..7159d0e 100644 --- a/sapling.cabal +++ b/sapling.cabal @@ -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 diff --git a/src/Eval.hs b/src/Eval.hs index 33b8e22..4476f53 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -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 diff --git a/src/Lexer.hs b/src/Lexer.hs index f5bdbea..114c6cb 100644 --- a/src/Lexer.hs +++ b/src/Lexer.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs index e1af0ce..cff286f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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)]) diff --git a/src/Parser.hs b/src/Parser.hs index 49bac82..633aff9 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -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) diff --git a/src/REPL.hs b/src/REPL.hs new file mode 100644 index 0000000..a95430c --- /dev/null +++ b/src/REPL.hs @@ -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 diff --git a/src/Research.hs b/src/Research.hs index 3580eac..7e82a28 100644 --- a/src/Research.hs +++ b/src/Research.hs @@ -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 | |" diff --git a/test/Spec.hs b/test/Spec.hs index 299a823..56d3d7e 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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 ] -