Somewhat working lambdas
Architectural changes to lambda evaluation and parsing to allow for correct expression evaluation. Contains several failing AI-generated tests and we're still failing tests for erroring incomplete definitions
This commit is contained in:
James Eversole
parent
7fca4d38e8
commit
dbb5227fbc
134
src/Eval.hs
134
src/Eval.hs
@ -2,121 +2,93 @@ module Eval where
|
||||
|
||||
import Parser
|
||||
import Research
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Data.List (foldl')
|
||||
import qualified Data.Map as Map
|
||||
import Data.Map (Map)
|
||||
|
||||
evalSingle :: Map.Map String T -> SaplingAST -> Map.Map String T
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.List (foldl')
|
||||
import qualified Data.Set as Set
|
||||
|
||||
evalSingle :: Map String T -> SaplingAST -> Map String T
|
||||
evalSingle env term = case term of
|
||||
SFunc name [] body ->
|
||||
let result = evalAST env body
|
||||
in Map.insert name result env
|
||||
SApp func arg ->
|
||||
let result = apply (evalAST env func) (evalAST env arg)
|
||||
in Map.insert "__result" result env
|
||||
SVar name -> case Map.lookup name env of
|
||||
Just value -> Map.insert "__result" value env
|
||||
Nothing -> error $ "Variable " ++ name ++ " not defined"
|
||||
_ ->
|
||||
let result = evalAST env term
|
||||
in Map.insert "__result" result env
|
||||
SFunc name [] body ->
|
||||
let
|
||||
lineNoLambda = eliminateLambda body
|
||||
result = evalAST env lineNoLambda
|
||||
in Map.insert name result env
|
||||
SLambda _ body ->
|
||||
let result = evalAST env body
|
||||
in Map.insert "__result" result env
|
||||
SApp func arg ->
|
||||
let result = apply (evalAST env func) (evalAST env arg)
|
||||
in Map.insert "__result" result env
|
||||
SVar name ->
|
||||
case Map.lookup name env of
|
||||
Just value -> Map.insert "__result" value env
|
||||
Nothing -> error $ "Variable " ++ name ++ " not defined"
|
||||
_ ->
|
||||
let result = evalAST env term
|
||||
in Map.insert "__result" result env
|
||||
|
||||
evalSapling :: Map String T -> [SaplingAST] -> Map String T
|
||||
evalSapling env [] = env
|
||||
evalSapling env [lastLine] =
|
||||
let
|
||||
lastLineNoLambda = eliminateLambda lastLine
|
||||
let lastLineNoLambda = eliminateLambda lastLine
|
||||
updatedEnv = evalSingle env lastLineNoLambda
|
||||
in Map.insert "__result" (result updatedEnv) updatedEnv
|
||||
evalSapling env (line:rest) =
|
||||
let
|
||||
lineNoLambda = eliminateLambda line
|
||||
let lineNoLambda = eliminateLambda line
|
||||
updatedEnv = evalSingle env lineNoLambda
|
||||
in evalSapling updatedEnv rest
|
||||
|
||||
evalAST :: Map String T -> SaplingAST -> T
|
||||
evalAST env term = case term of
|
||||
SVar name ->
|
||||
case Map.lookup name env of
|
||||
Just value -> value
|
||||
Nothing -> error $ "Variable " ++ name ++ " not defined"
|
||||
SVar name -> case Map.lookup name env of
|
||||
Just value -> value
|
||||
Nothing -> error $ "Variable " ++ name ++ " not defined"
|
||||
TLeaf -> Leaf
|
||||
TStem t ->
|
||||
Stem (evalAST env t)
|
||||
TFork t1 t2 ->
|
||||
Fork (evalAST env t1) (evalAST env t2)
|
||||
SApp t1 t2 ->
|
||||
apply (evalAST env t1) (evalAST env t2)
|
||||
TStem t -> Stem (evalAST env t)
|
||||
TFork t1 t2 -> Fork (evalAST env t1) (evalAST env t2)
|
||||
SApp t1 t2 -> apply (evalAST env t1) (evalAST env t2)
|
||||
SStr str -> toString str
|
||||
SInt num -> toNumber num
|
||||
SList elems -> toList (map (evalAST Map.empty) elems)
|
||||
SFunc name args body ->
|
||||
error $ "Unexpected function definition " ++ name
|
||||
++ " in evalAST; define via evalSingle."
|
||||
SLambda {} ->
|
||||
error "Internal error: SLambda found in evalAST after elimination."
|
||||
|
||||
result :: Map String T -> T
|
||||
result r = case Map.lookup "__result" r of
|
||||
Just a -> a
|
||||
Nothing -> error "No __result field found in provided environment"
|
||||
|
||||
SLambda {} -> error "Internal error: SLambda found in evalAST after elimination."
|
||||
|
||||
eliminateLambda :: SaplingAST -> SaplingAST
|
||||
eliminateLambda (SLambda (v:vs) body)
|
||||
| null vs = lambdaToT v (eliminateLambda body)
|
||||
| otherwise =
|
||||
eliminateLambda (SLambda [v] (SLambda vs body))
|
||||
eliminateLambda (SApp f arg) =
|
||||
SApp (eliminateLambda f) (eliminateLambda arg)
|
||||
eliminateLambda (TStem t) =
|
||||
TStem (eliminateLambda t)
|
||||
eliminateLambda (TFork l r) =
|
||||
TFork (eliminateLambda l) (eliminateLambda r)
|
||||
eliminateLambda (SList xs) =
|
||||
SList (map eliminateLambda xs)
|
||||
eliminateLambda (SFunc n vs b) =
|
||||
SFunc n vs (eliminateLambda b)
|
||||
| null vs = lambdaToT v (eliminateLambda body)
|
||||
| otherwise = eliminateLambda (SLambda [v] (SLambda vs body))
|
||||
eliminateLambda (SApp f arg) = SApp (eliminateLambda f) (eliminateLambda arg)
|
||||
eliminateLambda (TStem t) = TStem (eliminateLambda t)
|
||||
eliminateLambda (TFork l r) = TFork (eliminateLambda l) (eliminateLambda r)
|
||||
eliminateLambda (SList xs) = SList (map eliminateLambda xs)
|
||||
eliminateLambda other = other
|
||||
|
||||
lambdaToT :: String -> SaplingAST -> SaplingAST
|
||||
lambdaToT x (SVar y)
|
||||
| x == y = tI
|
||||
| x == y = tI
|
||||
lambdaToT x (SVar y)
|
||||
| x /= y =
|
||||
SApp tK (SVar y)
|
||||
| x /= y = SApp tK (SVar y)
|
||||
lambdaToT x t
|
||||
| not (isFree x t) =
|
||||
SApp tK t
|
||||
| not (isFree x t) = SApp tK t
|
||||
lambdaToT x (SApp n u)
|
||||
| not (isFree x (SApp n u)) =
|
||||
SApp tK (SApp (eliminateLambda n) (eliminateLambda u))
|
||||
lambdaToT x (SApp n u) =
|
||||
SApp
|
||||
(SApp tS (lambdaToT x (eliminateLambda n)))
|
||||
(lambdaToT x (eliminateLambda u))
|
||||
lambdaToT x (SApp f args) = lambdaToT x f
|
||||
| not (isFree x (SApp n u)) = SApp tK (SApp (eliminateLambda n) (eliminateLambda u))
|
||||
lambdaToT x (SApp n u) = SApp (SApp tS (lambdaToT x (eliminateLambda n))) (lambdaToT x (eliminateLambda u))
|
||||
lambdaToT x body
|
||||
| not (isFree x body) =
|
||||
SApp tK body
|
||||
| otherwise =
|
||||
SApp
|
||||
(SApp tS (lambdaToT x body))
|
||||
tLeaf
|
||||
| not (isFree x body) = SApp tK body
|
||||
| otherwise = SApp (SApp tS (lambdaToT x body)) TLeaf
|
||||
|
||||
tLeaf :: SaplingAST
|
||||
tLeaf = TLeaf
|
||||
|
||||
freeVars :: SaplingAST -> Set String
|
||||
freeVars :: SaplingAST -> Set.Set String
|
||||
freeVars (SVar v) = Set.singleton v
|
||||
freeVars (SInt _) = Set.empty
|
||||
freeVars (SStr _) = Set.empty
|
||||
freeVars (SList xs) = foldMap freeVars xs
|
||||
freeVars (SFunc _ _ b) = freeVars b
|
||||
freeVars (SApp f arg) = freeVars f <> freeVars arg
|
||||
freeVars TLeaf = Set.empty
|
||||
freeVars (SFunc _ _ b) = freeVars b
|
||||
freeVars (TStem t) = freeVars t
|
||||
freeVars (TFork l r) = freeVars l <> freeVars r
|
||||
freeVars (SLambda vs b) = foldr Set.delete (freeVars b) vs
|
||||
@ -130,11 +102,15 @@ toAST (Stem a) = TStem (toAST a)
|
||||
toAST (Fork a b) = TFork (toAST a) (toAST b)
|
||||
|
||||
tI :: SaplingAST
|
||||
tI = toAST _I
|
||||
tI = SApp (SApp TLeaf (SApp TLeaf (SApp TLeaf TLeaf))) TLeaf
|
||||
|
||||
tK :: SaplingAST
|
||||
tK = toAST _K
|
||||
tK = SApp TLeaf TLeaf
|
||||
|
||||
tS :: SaplingAST
|
||||
tS = toAST _S
|
||||
tS = SApp (SApp TLeaf (SApp TLeaf (SApp (SApp TLeaf TLeaf) TLeaf))) TLeaf
|
||||
|
||||
result :: Map String T -> T
|
||||
result r = case Map.lookup "__result" r of
|
||||
Just a -> a
|
||||
Nothing -> error "No __result field found in provided environment"
|
||||
|
||||
@ -7,6 +7,7 @@ import Data.Void
|
||||
import qualified Data.Set as Set
|
||||
|
||||
type Lexer = Parsec Void String
|
||||
|
||||
data LToken
|
||||
= LKeywordT
|
||||
| LIdentifier String
|
||||
@ -44,7 +45,7 @@ stringLiteral = do
|
||||
if null content
|
||||
then fail "Empty string literals are not allowed"
|
||||
else do
|
||||
char '"' -- "
|
||||
char '"'
|
||||
return (LStringLiteral content)
|
||||
|
||||
assign :: Lexer LToken
|
||||
@ -92,5 +93,5 @@ saplingLexer = many (sc *> choice
|
||||
|
||||
lexSapling :: String -> [LToken]
|
||||
lexSapling input = case runParser saplingLexer "" input of
|
||||
Left err -> error $ "Lexical error:\n" ++ errorBundlePretty err
|
||||
Left err -> error $ "Lexical error:\n" ++ errorBundlePretty err
|
||||
Right tokens -> tokens
|
||||
|
||||
@ -11,3 +11,6 @@ import Text.Megaparsec (runParser)
|
||||
|
||||
main :: IO ()
|
||||
main = repl Map.empty --(Map.fromList [("__result", Leaf)])
|
||||
|
||||
runSapling :: String -> String
|
||||
runSapling s = show $ result (evalSapling Map.empty $ parseSapling s)
|
||||
|
||||
100
src/Parser.hs
100
src/Parser.hs
@ -1,10 +1,8 @@
|
||||
module Parser where
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
import Lexer
|
||||
import Research hiding (toList)
|
||||
|
||||
import Control.Exception (throw)
|
||||
import Data.List.NonEmpty (toList)
|
||||
import qualified Data.Set as Set
|
||||
@ -14,17 +12,18 @@ import Text.Megaparsec.Char
|
||||
import Text.Megaparsec.Error (errorBundlePretty, ParseErrorBundle)
|
||||
|
||||
type Parser = Parsec Void [LToken]
|
||||
|
||||
data SaplingAST
|
||||
= SVar String
|
||||
| SInt Int
|
||||
| SStr String
|
||||
| SList [SaplingAST]
|
||||
| SFunc String [String] SaplingAST
|
||||
| SApp SaplingAST SaplingAST
|
||||
= SVar String
|
||||
| SInt Int
|
||||
| SStr String
|
||||
| SList [SaplingAST]
|
||||
| SFunc String [String] SaplingAST
|
||||
| SApp SaplingAST SaplingAST
|
||||
| TLeaf
|
||||
| TStem SaplingAST
|
||||
| TFork SaplingAST SaplingAST
|
||||
| SLambda [String] SaplingAST
|
||||
| TStem SaplingAST
|
||||
| TFork SaplingAST SaplingAST
|
||||
| SLambda [String] SaplingAST
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
parseSapling :: String -> [SaplingAST]
|
||||
@ -35,7 +34,7 @@ parseSapling input =
|
||||
parseSingle :: String -> SaplingAST
|
||||
parseSingle "" = error "Empty input provided to parseSingle"
|
||||
parseSingle input = case runParser parseExpression "" (lexSapling input) of
|
||||
Left err -> error $ handleParseError err
|
||||
Left err -> error $ handleParseError err
|
||||
Right ast -> ast
|
||||
|
||||
scnParser :: Parser ()
|
||||
@ -45,6 +44,7 @@ parseExpression :: Parser SaplingAST
|
||||
parseExpression = choice
|
||||
[ try parseFunction
|
||||
, try parseLambda
|
||||
, try parseLambdaExpression
|
||||
, try parseListLiteral
|
||||
, try parseApplication
|
||||
, try parseTreeTerm
|
||||
@ -59,6 +59,19 @@ parseFunction = do
|
||||
body <- parseExpression
|
||||
return (SFunc name (map getIdentifier args) body)
|
||||
|
||||
parseAtomicBase :: Parser SaplingAST
|
||||
parseAtomicBase = choice
|
||||
[ try parseVarWithoutAssignment
|
||||
, parseTreeLeaf
|
||||
, parseGrouped
|
||||
]
|
||||
parseVarWithoutAssignment :: Parser SaplingAST
|
||||
parseVarWithoutAssignment = do
|
||||
LIdentifier name <- satisfy isIdentifier
|
||||
if (name == "t" || name == "__result")
|
||||
then fail $ "Reserved keyword: " ++ name ++ " cannot be assigned."
|
||||
else notFollowedBy (satisfy (== LAssign)) *> return (SVar name)
|
||||
|
||||
parseLambda :: Parser SaplingAST
|
||||
parseLambda = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) $ do
|
||||
satisfy (== LBackslash)
|
||||
@ -81,6 +94,7 @@ parseAtomicLambda = choice
|
||||
, parseTreeLeaf
|
||||
, parseLiteral
|
||||
, parseListLiteral
|
||||
, try parseLambda
|
||||
, between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseLambdaExpression
|
||||
]
|
||||
|
||||
@ -92,22 +106,15 @@ parseApplication = do
|
||||
|
||||
parseLambdaApplication :: Parser SaplingAST
|
||||
parseLambdaApplication = do
|
||||
func <- parseAtomicLambda
|
||||
args <- many parseAtomicLambda
|
||||
return $ foldl (\acc arg -> SApp acc arg) func args
|
||||
func <- parseAtomicLambda
|
||||
args <- many parseAtomicLambda
|
||||
return $ foldl (\acc arg -> SApp acc arg) func args
|
||||
|
||||
isTreeTerm :: SaplingAST -> Bool
|
||||
isTreeTerm TLeaf = True
|
||||
isTreeTerm (TStem _) = True
|
||||
isTreeTerm TLeaf = True
|
||||
isTreeTerm (TStem _) = True
|
||||
isTreeTerm (TFork _ _) = True
|
||||
isTreeTerm _ = False
|
||||
|
||||
parseAtomicBase :: Parser SaplingAST
|
||||
parseAtomicBase = choice
|
||||
[ parseVar
|
||||
, parseTreeLeaf
|
||||
, parseGrouped
|
||||
]
|
||||
isTreeTerm _ = False
|
||||
|
||||
parseTreeLeaf :: Parser SaplingAST
|
||||
parseTreeLeaf = satisfy isKeywordT *> notFollowedBy (satisfy (== LAssign)) *> pure TLeaf
|
||||
@ -123,8 +130,8 @@ parseTreeTerm = do
|
||||
pure $ foldl combine base rest
|
||||
where
|
||||
combine acc next = case acc of
|
||||
TLeaf -> TStem next
|
||||
TStem t -> TFork t next
|
||||
TLeaf -> TStem next
|
||||
TStem t -> TFork t next
|
||||
TFork _ _ -> TFork acc next
|
||||
|
||||
parseTreeLeafOrParenthesized :: Parser SaplingAST
|
||||
@ -147,7 +154,6 @@ parseAtomic = choice
|
||||
, parseLiteral
|
||||
]
|
||||
|
||||
|
||||
parseGrouped :: Parser SaplingAST
|
||||
parseGrouped = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseExpression
|
||||
|
||||
@ -190,8 +196,8 @@ parseSingleItem = do
|
||||
token <- satisfy isListItem
|
||||
case token of
|
||||
LIdentifier name -> return (SVar name)
|
||||
LKeywordT -> return TLeaf
|
||||
_ -> fail "Unexpected token in list item"
|
||||
LKeywordT -> return TLeaf
|
||||
_ -> fail "Unexpected token in list item"
|
||||
|
||||
isListItem :: LToken -> Bool
|
||||
isListItem (LIdentifier _) = True
|
||||
@ -216,24 +222,19 @@ parseStrLiteral = do
|
||||
return (SStr value)
|
||||
|
||||
-- Boolean Helpers
|
||||
isKeywordT (LKeywordT) = True
|
||||
isKeywordT _ = False
|
||||
|
||||
isIdentifier (LIdentifier _) = True
|
||||
isIdentifier _ = False
|
||||
|
||||
isKeywordT (LKeywordT) = True
|
||||
isKeywordT _ = False
|
||||
isIdentifier (LIdentifier _) = True
|
||||
isIdentifier _ = False
|
||||
isIntegerLiteral (LIntegerLiteral _) = True
|
||||
isIntegerLiteral _ = False
|
||||
|
||||
isStringLiteral (LStringLiteral _) = True
|
||||
isStringLiteral _ = False
|
||||
|
||||
isLiteral (LIntegerLiteral _) = True
|
||||
isLiteral (LStringLiteral _) = True
|
||||
isLiteral _ = False
|
||||
|
||||
esNewline (LNewline) = True
|
||||
isNewline _ = False
|
||||
isIntegerLiteral _ = False
|
||||
isStringLiteral (LStringLiteral _) = True
|
||||
isStringLiteral _ = False
|
||||
isLiteral (LIntegerLiteral _) = True
|
||||
isLiteral (LStringLiteral _) = True
|
||||
isLiteral _ = False
|
||||
isNewline (LNewline) = True
|
||||
isNewline _ = False
|
||||
|
||||
-- Error Handling
|
||||
handleParseError :: ParseErrorBundle [LToken] Void -> String
|
||||
@ -246,9 +247,10 @@ handleParseError bundle =
|
||||
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)
|
||||
++ 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)
|
||||
++ show (Set.toList expected)
|
||||
|
||||
|
||||
514
test/Spec.hs
514
test/Spec.hs
@ -5,237 +5,339 @@ import Lexer
|
||||
import Parser
|
||||
import Research
|
||||
import Control.Exception (evaluate, try, SomeException)
|
||||
import qualified Data.Map as Map
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
import Test.Tasty.QuickCheck
|
||||
import Text.Megaparsec (runParser)
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain tests
|
||||
|
||||
runSapling :: String -> String
|
||||
runSapling s = show $ result (evalSapling Map.empty $ parseSapling s)
|
||||
|
||||
tests :: TestTree
|
||||
tests = testGroup "Sapling Tests"
|
||||
[ lexerTests
|
||||
, parserTests
|
||||
, integrationTests
|
||||
, evaluationTests
|
||||
, propertyTests
|
||||
]
|
||||
[ lexerTests
|
||||
, parserTests
|
||||
, integrationTests
|
||||
, evaluationTests
|
||||
, propertyTests
|
||||
, lambdaEvalTests
|
||||
]
|
||||
|
||||
lexerTests :: TestTree
|
||||
lexerTests = testGroup "Lexer Tests"
|
||||
[ testCase "Lex simple identifiers" $ do
|
||||
let input = "x a b = a"
|
||||
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"
|
||||
expect = Right [LKeywordT, LKeywordT, LKeywordT]
|
||||
runParser saplingLexer "" input @?= expect
|
||||
, testCase "Lex escaped characters in strings" $ do
|
||||
let input = "\"hello\\nworld\""
|
||||
expect = Right [LStringLiteral "hello\\nworld"]
|
||||
runParser saplingLexer "" input @?= expect
|
||||
, testCase "Lex mixed literals" $ do
|
||||
let input = "t \"string\" 42"
|
||||
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 "
|
||||
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
|
||||
[ testCase "Lex simple identifiers" $ do
|
||||
let input = "x a b = a"
|
||||
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"
|
||||
expect = Right [LKeywordT, LKeywordT, LKeywordT]
|
||||
runParser saplingLexer "" input @?= expect
|
||||
, testCase "Lex escaped characters in strings" $ do
|
||||
let input = "\"hello\\nworld\""
|
||||
expect = Right [LStringLiteral "hello\\nworld"]
|
||||
runParser saplingLexer "" input @?= expect
|
||||
, testCase "Lex mixed literals" $ do
|
||||
let input = "t \"string\" 42"
|
||||
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 "
|
||||
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"
|
||||
]
|
||||
Left _ -> return ()
|
||||
Right _ -> assertFailure "Expected failure when trying to assign the value of __result"
|
||||
]
|
||||
|
||||
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
|
||||
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 c = a"
|
||||
let expect = SFunc "x" ["a","b","c"] (SVar "a")
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse nested Tree Calculus terms" $ do
|
||||
let input = "t (t t) t"
|
||||
let expect = SApp (SApp TLeaf (SApp TLeaf TLeaf)) TLeaf
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse sequential Tree Calculus terms" $ do
|
||||
let input = "t t t"
|
||||
let expect = SApp (SApp TLeaf TLeaf) TLeaf
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse mixed list literals" $ do
|
||||
let input = "[t (\"hello\") t]"
|
||||
let expect = SList [TLeaf, SStr "hello", TLeaf]
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse function with applications" $ do
|
||||
let input = "f x = t x"
|
||||
let expect = SFunc "f" ["x"] (SApp TLeaf (SVar "x"))
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse nested lists" $ do
|
||||
let input = "[t [(t t)]]"
|
||||
let expect = SList [TLeaf,SList [SApp TLeaf TLeaf]]
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse complex parentheses" $ do
|
||||
let input = "t (t t (t t))"
|
||||
let expect = SApp TLeaf (SApp (SApp TLeaf TLeaf) (SApp TLeaf TLeaf))
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse empty list" $ do
|
||||
let input = "[]"
|
||||
let expect = SList []
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse multiple nested lists" $ do
|
||||
let input = "[[t t] [t (t t)]]"
|
||||
let expect = SList [SList [TLeaf,TLeaf],SList [TLeaf,SApp TLeaf TLeaf]]
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse whitespace variance" $ do
|
||||
let input1 = "[t t]"
|
||||
let input2 = "[ t t ]"
|
||||
let expect = SList [TLeaf, TLeaf]
|
||||
parseSingle input1 @?= expect
|
||||
parseSingle input2 @?= expect
|
||||
, testCase "Parse string in list" $ do
|
||||
let input = "[(\"hello\")]"
|
||||
let expect = SList [SStr "hello"]
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse parentheses inside list" $ do
|
||||
let input = "[t (t t)]"
|
||||
let expect = SList [TLeaf,SApp TLeaf TLeaf]
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse nested parentheses in function body" $ do
|
||||
let input = "f = t (t (t t))"
|
||||
let expect = SFunc "f" [] (SApp TLeaf (SApp TLeaf (SApp TLeaf TLeaf)))
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse lambda abstractions" $ do
|
||||
let input = "(\\a : a)"
|
||||
let expect = (SLambda ["a"] (SVar "a"))
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse multiple arguments to lambda abstractions" $ do
|
||||
let input = "x = (\\a b : a)"
|
||||
let expect = SFunc "x" [] (SLambda ["a"] (SLambda ["b"] (SVar "a")))
|
||||
parseSingle input @?= expect
|
||||
, testCase "Grouping T terms with parentheses in function application" $ do
|
||||
let input = "x = (\\a : a)\n" <> "x (t)"
|
||||
expect = [SFunc "x" [] (SLambda ["a"] (SVar "a")),SApp (SVar "x") TLeaf]
|
||||
parseSapling input @?= expect
|
||||
]
|
||||
[ 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 "Parse function definitions" $ do
|
||||
let input = "x = (\\a b c : a)"
|
||||
expect = SFunc "x" [] (SLambda ["a"] (SLambda ["b"] (SLambda ["c"] (SVar "a"))))
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse nested Tree Calculus terms" $ do
|
||||
let input = "t (t t) t"
|
||||
expect = SApp (SApp TLeaf (SApp TLeaf TLeaf)) TLeaf
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse sequential Tree Calculus terms" $ do
|
||||
let input = "t t t"
|
||||
expect = SApp (SApp TLeaf TLeaf) TLeaf
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse mixed list literals" $ do
|
||||
let input = "[t (\"hello\") t]"
|
||||
expect = SList [TLeaf, SStr "hello", TLeaf]
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse function with applications" $ do
|
||||
let input = "f = (\\x : t x)"
|
||||
expect = SFunc "f" [] (SLambda ["x"] (SApp TLeaf (SVar "x")))
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse nested lists" $ do
|
||||
let input = "[t [(t t)]]"
|
||||
expect = SList [TLeaf,SList [SApp TLeaf TLeaf]]
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse complex parentheses" $ do
|
||||
let input = "t (t t (t t))"
|
||||
expect = SApp TLeaf (SApp (SApp TLeaf TLeaf) (SApp TLeaf TLeaf))
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse empty list" $ do
|
||||
let input = "[]"
|
||||
expect = SList []
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse multiple nested lists" $ do
|
||||
let input = "[[t t] [t (t t)]]"
|
||||
expect = SList [SList [TLeaf,TLeaf],SList [TLeaf,SApp TLeaf TLeaf]]
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse whitespace variance" $ do
|
||||
let input1 = "[t t]"
|
||||
let input2 = "[ t t ]"
|
||||
expect = SList [TLeaf, TLeaf]
|
||||
parseSingle input1 @?= expect
|
||||
parseSingle input2 @?= expect
|
||||
, testCase "Parse string in list" $ do
|
||||
let input = "[(\"hello\")]"
|
||||
expect = SList [SStr "hello"]
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse parentheses inside list" $ do
|
||||
let input = "[t (t t)]"
|
||||
expect = SList [TLeaf,SApp TLeaf TLeaf]
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse nested parentheses in function body" $ do
|
||||
let input = "f = (\\x : t (t (t t)))"
|
||||
expect = SFunc "f" [] (SLambda ["x"] (SApp TLeaf (SApp TLeaf (SApp TLeaf TLeaf))))
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse lambda abstractions" $ do
|
||||
let input = "(\\a : a)"
|
||||
expect = (SLambda ["a"] (SVar "a"))
|
||||
parseSingle input @?= expect
|
||||
, testCase "Parse multiple arguments to lambda abstractions" $ do
|
||||
let input = "x = (\\a b : a)"
|
||||
expect = SFunc "x" [] (SLambda ["a"] (SLambda ["b"] (SVar "a")))
|
||||
parseSingle input @?= expect
|
||||
, testCase "Grouping T terms with parentheses in function application" $ do
|
||||
let input = "x = (\\a : a)\nx (t)"
|
||||
expect = [SFunc "x" [] (SLambda ["a"] (SVar "a")),SApp (SVar "x") TLeaf]
|
||||
parseSapling input @?= expect
|
||||
]
|
||||
|
||||
integrationTests :: TestTree
|
||||
integrationTests = testGroup "Integration Tests"
|
||||
[ testCase "Combine lexer and parser" $ do
|
||||
let input = "x = t t t"
|
||||
let expect = SFunc "x" [] (SApp (SApp TLeaf TLeaf) TLeaf)
|
||||
parseSingle input @?= expect
|
||||
, testCase "Complex Tree Calculus expression" $ do
|
||||
let input = "t (t t t) t"
|
||||
let expect = SApp (SApp TLeaf (SApp (SApp TLeaf TLeaf) TLeaf)) TLeaf
|
||||
parseSingle input @?= expect
|
||||
]
|
||||
[ testCase "Combine lexer and parser" $ do
|
||||
let input = "x = t t t"
|
||||
expect = SApp (SVar "x") (SApp (SApp TLeaf TLeaf) TLeaf)
|
||||
parseSingle input @?= expect
|
||||
, testCase "Complex Tree Calculus expression" $ do
|
||||
let input = "t (t t t) t"
|
||||
expect = SApp (SApp TLeaf (SApp (SApp TLeaf TLeaf) TLeaf)) TLeaf
|
||||
parseSingle input @?= expect
|
||||
]
|
||||
|
||||
evaluationTests :: TestTree
|
||||
evaluationTests = testGroup "Evaluation Tests"
|
||||
[ testCase "Evaluate single Leaf" $ do
|
||||
let input = "t"
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= Leaf
|
||||
, testCase "Evaluate single Stem" $ do
|
||||
let input = "t t"
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= Stem Leaf
|
||||
, testCase "Evaluate single Fork" $ do
|
||||
let input = "t t t"
|
||||
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 = 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 = 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 = 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 = 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 = evalSapling Map.empty (parseSapling input)
|
||||
(result env) @?= Leaf
|
||||
, testCase "Evaluate string literal" $ do
|
||||
let input = "\"hello\""
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= toString "hello"
|
||||
, testCase "Evaluate list literal" $ do
|
||||
let input = "[t (t t)]"
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= toList [Leaf, Stem Leaf]
|
||||
, testCase "Evaluate empty list" $ do
|
||||
let input = "[]"
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= toList []
|
||||
, testCase "Evaluate variable dependency chain" $ do
|
||||
let input = "x = t (t t)\n \
|
||||
\ y = x\n \
|
||||
\ z = y\n \
|
||||
\ variablewithamuchlongername = z\n \
|
||||
\ variablewithamuchlongername"
|
||||
let env = evalSapling Map.empty (parseSapling input)
|
||||
(result env) @?= (Stem (Stem Leaf))
|
||||
, testCase "Evaluate variable shadowing" $ do
|
||||
let input = "x = t t\nx = t\nx"
|
||||
let env = evalSapling Map.empty (parseSapling input)
|
||||
(result env) @?= Leaf
|
||||
, testCase "Lambda identity" $ do
|
||||
let input = "(\\a : a)"
|
||||
env = evalSapling Map.empty (parseSapling input)
|
||||
result env @?= Fork (Stem (Stem Leaf)) (Stem Leaf)
|
||||
[ testCase "Evaluate single Leaf" $ do
|
||||
let input = "t"
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= Leaf
|
||||
, testCase "Evaluate single Stem" $ do
|
||||
let input = "t t"
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= Stem Leaf
|
||||
, testCase "Evaluate single Fork" $ do
|
||||
let input = "t t t"
|
||||
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 = 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 = 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"
|
||||
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"
|
||||
env = evalSapling Map.empty (parseSapling input)
|
||||
(result env) @?= Stem (Stem Leaf)
|
||||
, testCase "Multiline input evaluation" $ do
|
||||
let input = "x = t\ny = t t\nx"
|
||||
env = evalSapling Map.empty (parseSapling input)
|
||||
(result env) @?= Leaf
|
||||
, testCase "Evaluate string literal" $ do
|
||||
let input = "\"hello\""
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= toString "hello"
|
||||
, testCase "Evaluate list literal" $ do
|
||||
let input = "[t (t t)]"
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= toList [Leaf, Stem Leaf]
|
||||
, testCase "Evaluate empty list" $ do
|
||||
let input = "[]"
|
||||
let ast = parseSingle input
|
||||
(result $ evalSingle Map.empty ast) @?= toList []
|
||||
, testCase "Evaluate variable dependency chain" $ do
|
||||
let input = "x = t (t t)\n \
|
||||
\ y = x\n \
|
||||
\ z = y\n \
|
||||
\ variablewithamuchlongername = z\n \
|
||||
\ variablewithamuchlongername"
|
||||
env = evalSapling Map.empty (parseSapling input)
|
||||
(result env) @?= (Stem (Stem Leaf))
|
||||
, testCase "Evaluate variable shadowing" $ do
|
||||
let input = "x = t t\nx = t\nx"
|
||||
env = evalSapling Map.empty (parseSapling input)
|
||||
(result env) @?= Leaf
|
||||
, testCase "Apply identity to Boolean Not" $ do
|
||||
let not = "(t (t (t t) (t t t)) t)"
|
||||
input = "x = (\\a : a)\nx " ++ not
|
||||
env = evalSapling Map.empty (parseSapling input)
|
||||
result env @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
|
||||
let not = "(t (t (t t) (t t t)) t)"
|
||||
let input = "x = (\\a : a)\nx " ++ not
|
||||
env = evalSapling Map.empty (parseSapling input)
|
||||
result env @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
|
||||
, testCase "Constant function matches" $ do
|
||||
let input = "k = (\\a b : a)\nk (t t) t"
|
||||
env = evalSapling Map.empty (parseSapling input)
|
||||
result env @?= Stem Leaf
|
||||
]
|
||||
let input = "k = (\\a b : a)\nk (t t) t"
|
||||
env = evalSapling Map.empty (parseSapling input)
|
||||
result env @?= Stem Leaf
|
||||
, testCase "Boolean AND_ TF" $ do
|
||||
let input = "and (t t) (t)"
|
||||
env = evalSapling boolEnv (parseSapling input)
|
||||
result env @?= Leaf
|
||||
, testCase "Boolean AND_ FT" $ do
|
||||
let input = "and (t) (t t)"
|
||||
env = evalSapling boolEnv (parseSapling input)
|
||||
result env @?= Leaf
|
||||
, testCase "Boolean AND_ FF" $ do
|
||||
let input = "and (t) (t)"
|
||||
env = evalSapling boolEnv (parseSapling input)
|
||||
result env @?= Leaf
|
||||
, testCase "Boolean AND_ TT" $ do
|
||||
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
|
||||
]
|
||||
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 \
|
||||
\ match_bool = (\\ot of : triage of (\\z : ot) t)\n \
|
||||
\ and = match_bool id falseL\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)))))\
|
||||
\ "
|
||||
|
||||
|
||||
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 -> parseSingle input === ast
|
||||
]
|
||||
[ 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 -> 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