commit b3583c796e72cb04559b1665c73ac95e80b64960
parent 2a63942cdb6a51190cddf54b9f20e6c35d6548db
Author: James Eversole <james@eversole.co>
Date: Fri, 20 Dec 2024 11:38:09 -0600
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.
Diffstat:
8 files changed, 234 insertions(+), 136 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
]
-
