Stop using to/of conventions backwards

Uses # instead of text output. Adds several basic library functions.

README.md

@@ -1,16 +1,52 @@
 # sapling
 
+## Introduction
+
 sapling is a "micro-language" that I'm working on to investigate [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf) .
 
 It offers a minimal amount of syntax sugar:
 
 - `t` operator behaving by the rules of Tree Calculus
-- Variable definitions
+- Function ("variable") definitions
 - Lambda abstractions
-- List, Integer, and String literals
+- List, Number, and String literals (WIP)
 
 This is an active experimentation project by [someone who has no idea what they're doing](https://eversole.co).
 
+## What does it look like?
+
+```
+false      = t
+_          = t
+true       = t t
+id         = (\a : a)
+triage     = (\a b c : t (t a b) c) 
+match_bool = (\ot of : triage of (\_ : ot) t)
+and        = match_bool id (\_ : false)
+if         = (\cond then else : t (t else (t t then)) t cond)
+triage     = (\a b c : t (t a b) c)
+test       = triage "leaf" (\_ : "stem") (\_ _ : "fork")
+
+-- The REPL outputs the tree form results by default; they are elided here.
+sapling < test t
+DECODE -: "leaf"
+sapling < test (t t)
+DECODE -: "stem"
+sapling < test (t t t)
+DECODE -: "fork"
+sapling < map (\i : listConcat i " is super cool!") [("He") ("She") ("Everybody")]
+DECODE -: ["He is super cool!", "She is super cool!", "Everybody is super cool!"]
+```
+
+## How to use
+
+For now, you can easily build and run this project using Nix:
+
+1. Clone the repository:
+    a. `git clone ssh://git.eversole.co/sapling.git`
+    b. `git clone https://git.eversole/sapling.git`
+1. Run the REPL: `nix run`
+
 ## Acknowledgements 
 
 Tree Calculus was discovered by [Barry Jay](https://github.com/barry-jay-personal/blog). 

sapling.cabal

@@ -1,8 +1,8 @@
 cabal-version: 1.12
 
 name:           sapling
-version:        0.2.0
-description:    Tree Calculus experiment repository
+version:        0.4.0
+description:    A micro-language for exploring Tree Calculus
 author:         James Eversole
 maintainer:     james@eversole.co
 copyright:      James Eversole
@@ -29,11 +29,13 @@ executable sapling
   build-depends:
     base >=4.7
     , containers
+    , haskeline
     , megaparsec
     , mtl
   other-modules:
     Eval
     Lexer
+    Library
     Parser
     REPL
     Research
@@ -46,6 +48,7 @@ test-suite sapling-tests
   build-depends:       
     base
     , containers
+    , haskeline
     , megaparsec
     , mtl
     , tasty
@@ -55,6 +58,7 @@ test-suite sapling-tests
   other-modules:
     Eval
     Lexer
+    Library
     Parser
     REPL
     Research

src/Eval.hs

@@ -2,121 +2,95 @@ 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 $ eliminateLambda func) (evalAST env $ eliminateLambda 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)
-    SStr str -> toString str
-    SInt num -> toNumber num
-    SList elems -> toList (map (evalAST Map.empty) elems)
+    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 -> ofString str
+    SInt num -> ofNumber num
+    SList elems -> ofList (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
 
+-- This is my attempt to implement the lambda calculus elimination rules defined
+-- in "Typed Program Analysis without Encodings" by Barry Jay.
+-- https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf
 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
@@ -129,12 +103,18 @@ toAST Leaf = TLeaf
 toAST (Stem a) = TStem (toAST a)
 toAST (Fork a b) = TFork (toAST a) (toAST b)
 
+-- We need the SKI operators in an unevaluated SaplingAST tree form so that we
+-- can keep the evaluation functions straightforward
 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"

src/Lexer.hs

@@ -3,10 +3,13 @@ module Lexer where
 import Research
 import Text.Megaparsec
 import Text.Megaparsec.Char
+
+import Control.Monad (void)
 import Data.Void
 import qualified Data.Set as Set
 
 type Lexer = Parsec Void String
+
 data LToken
   = LKeywordT
   | LIdentifier String
@@ -20,6 +23,7 @@ data LToken
   | LOpenBracket
   | LCloseBracket
   | LNewline
+  | LComment String
   deriving (Show, Eq, Ord)
 
 keywordT :: Lexer LToken
@@ -44,7 +48,7 @@ stringLiteral = do
   if null content
     then fail "Empty string literals are not allowed"
     else do
-      char '"' -- "
+      char '"' --"
       return (LStringLiteral content)
 
 assign :: Lexer LToken
@@ -71,8 +75,16 @@ closeBracket = char ']' *> pure LCloseBracket
 lnewline :: Lexer LToken
 lnewline = char '\n' *> pure LNewline
 
+comment :: Lexer LToken
+comment = do
+  string "--"
+  content <- many (satisfy (/= '\n'))
+  optional (char '\n')
+  pure (LComment content)
+
+
 sc :: Lexer ()
-sc = skipMany (char ' ' <|> char '\t')
+sc = skipMany (void (char ' ') <|> void (char '\t') <|> void comment)
 
 saplingLexer :: Lexer [LToken]
 saplingLexer = many (sc *> choice
@@ -92,5 +104,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

src/Library.hs

@@ -0,0 +1,47 @@
+module Library where
+
+import Eval
+import Parser
+import Research
+
+import qualified Data.Map as Map
+
+library :: Map.Map String T
+library = evalSapling Map.empty $ parseSapling $ unlines 
+  [ "false = t" 
+  , "true = t t"
+  , "_ = t"
+  , "k = t t"
+  , "i = t (t k) t"
+  , "s = t (t (k t)) t"
+  , "m = s i i"
+  , "b = s (k s) k"
+  , "c = s (s (k s) (s (k k) s)) (k k)"
+  , "iC = (\\a b c : s a (k c) b)"
+  , "iD = b (b iC) iC"
+  , "iE = b (b iD) iC"
+  , "yi = (\\i : b m (c b (i m)))"
+  , "y = yi iC"
+  , "yC = yi iD"
+  , "yD = yi iE"
+  , "id = (\\a : a)"
+  , "triage = (\\a b c : t (t a b) c)"
+  , "pair = t"
+  , "matchBool = (\\ot of : triage of (\\_ : ot) (\\_ _ : ot))"
+  , "matchList = (\\oe oc : triage oe _ oc)"
+  , "matchPair = (\\op : triage _ _ op)"
+  , "and = matchBool id (\\z : false)"
+  , "if = (\\cond then else : t (t else (t t then)) t cond)"
+  , "test = triage \"leaf\" (\\z : \"stem\") (\\a b : \"fork\")"
+  , "emptyList = matchList true (\\y z : false)"
+  , "nonEmptyList = matchList false (\\y z : true)"
+  , "head = matchList t (\\hd tl : hd)"
+  , "tail = matchList t (\\hd tl : tl)"
+  , "isLeaf = (\\_ : triage true false false)"
+  , "listConcat = y (\\self : matchList (\\k : k) (\\h r k : pair h (self r k)))"
+  , "lAnd = triage (\\x : false) (\\_ x : x) (\\_ _ x : x)"
+  , "lOr = triage (\\x : x) (\\_ _ : true) (\\_ _ x : true)"
+  , "hmap = y (\\self : matchList (\\f : t) (\\hd tl f : pair (f hd) (self tl f)))"
+  , "map = (\\f l : hmap l f)"
+  , "equal = y (\\self : triage (triage true (\\z : false) (\\y z : false)) (\\ax : triage false (self ax) (\\y z : false)) (\\ax ay : triage false (\\z : false) (\\bx by : lAnd (self ax bx) (self ay by))))" 
+  ]

src/Main.hs

@@ -2,6 +2,7 @@ module Main where
 
 import Eval
 import Lexer
+import Library
 import Parser
 import REPL (repl)
 import Research
@@ -10,4 +11,12 @@ import qualified Data.Map as Map
 import Text.Megaparsec (runParser)
 
 main :: IO ()
-main = repl Map.empty --(Map.fromList [("__result", Leaf)])
+main = do
+  putStrLn "Welcome to the Sapling Interpreter"
+  putStrLn "You can exit at any time by typing and entering: "
+  putStrLn ":_exit"
+  repl library
+
+runSapling :: String -> T
+runSapling s = result (evalSapling Map.empty $ parseSapling s)
+runSaplingEnv env s = result (evalSapling env $ parseSapling s)

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]
@@ -33,9 +32,8 @@ parseSapling 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
+  Left err -> error $ handleParseError err
   Right ast -> ast
 
 scnParser :: Parser ()
@@ -45,6 +43,7 @@ parseExpression :: Parser SaplingAST
 parseExpression = choice
   [ try parseFunction
   , try parseLambda
+  , try parseLambdaExpression
   , try parseListLiteral
   , try parseApplication
   , try parseTreeTerm
@@ -59,13 +58,26 @@ 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)
-  param <- satisfy isIdentifier
-  rest <- many (satisfy isIdentifier)
+  param    <- satisfy isIdentifier
+  rest     <- many (satisfy isIdentifier)
   satisfy (== LColon)
-  body <- parseLambdaExpression
+  body     <- parseLambdaExpression
   let nestedLambda = foldr (\v acc -> SLambda [v] acc) body (map getIdentifier rest)
   return (SLambda [getIdentifier param] nestedLambda)
 
@@ -81,6 +93,7 @@ parseAtomicLambda = choice
   , parseTreeLeaf
   , parseLiteral
   , parseListLiteral
+  , try parseLambda
   , between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseLambdaExpression
   ]
 
@@ -92,22 +105,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 +129,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 +153,6 @@ parseAtomic = choice
   , parseLiteral
   ]
 
-
 parseGrouped :: Parser SaplingAST
 parseGrouped = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseExpression
 
@@ -190,8 +195,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 +221,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 +246,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)
+

src/REPL.hs

@@ -5,21 +5,38 @@ import Lexer
 import Parser
 import Research
 
-import Control.Monad         (void)
+import Data.List                 (intercalate)
 import qualified Data.Map as Map
-import System.IO            (hFlush, stdout)
+import System.Console.Haskeline
+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
+repl env = runInputT defaultSettings (loop env)
+  where
+    loop :: Map.Map String T -> InputT IO ()
+    loop env = do
+      minput <- getInputLine "sapling < "
+      case minput of
+        Nothing -> outputStrLn "Goodbye!"
+        Just ":_exit" -> outputStrLn "Goodbye!"
+        Just "" -> do
+          outputStrLn ""
+          loop env
+        Just input -> do
+          let clearEnv = Map.delete "__result" env
+              newEnv   = evalSingle clearEnv (parseSingle input)
+          case Map.lookup "__result" newEnv of
+            Just r -> do
+              outputStrLn $ "sapling > " ++ show r
+              outputStrLn $ "DECODE -: " ++ decodeResult r
+            Nothing -> return ()
+          loop newEnv
+
+decodeResult :: T -> String
+decodeResult tc = case toNumber tc of
+  Right num -> show num
+  Left _ -> case toString tc of
+    Right str -> "\"" ++ str ++ "\""
+    Left _ -> case toList tc of
+      Right list -> "[" ++ intercalate ", " (map decodeResult list) ++ "]"
+      Left _ -> ""

src/Research.hs

@@ -34,8 +34,11 @@ _S = Fork (Stem (Fork Leaf Leaf)) Leaf
 _K :: T
 _K = Stem Leaf
 
+-- Identity
+-- We use the "point-free" style which drops a redundant node
+-- Full _I form (SKK): Fork (Stem (Stem Leaf)) (Stem Leaf)
 _I :: T
-_I = apply (apply _S _K) _K -- Fork (Stem (Stem Leaf)) (Stem Leaf)
+_I = Fork (Stem (Stem Leaf)) Leaf 
 
 -- Booleans
 _false :: T
@@ -48,33 +51,41 @@ _not :: T
 _not = Fork (Fork _true (Fork Leaf _false)) Leaf
 
 -- Marshalling
-toString :: String -> T
-toString str = toList (map toNumber (map fromEnum str))
+ofString :: String -> T
+ofString str = ofList (map ofNumber (map fromEnum str))
 
-ofString :: T -> String
-ofString tc = map (toEnum . ofNumber) (ofList tc)
-
-toNumber :: Int -> T
-toNumber 0 = Leaf
-toNumber n =
+ofNumber :: Int -> T
+ofNumber 0 = Leaf
+ofNumber n =
   Fork
     (if odd n then Stem Leaf else Leaf)
-    (toNumber (n `div` 2))
+    (ofNumber (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"
+ofList :: [T] -> T
+ofList [] = Leaf
+ofList (x:xs) = Fork x (ofList xs)
 
-toList :: [T] -> T
-toList [] = Leaf
-toList (x:xs) = Fork x (toList xs)
+toNumber :: T -> Either String Int
+toNumber Leaf = Right 0
+toNumber (Fork Leaf rest) = case toNumber rest of
+  Right n -> Right (2 * n)
+  Left err -> Left err
+toNumber (Fork (Stem Leaf) rest) = case toNumber rest of
+  Right n -> Right (1 + 2 * n)
+  Left err -> Left err
+toNumber _ = Left "Invalid Tree Calculus number"
 
-ofList :: T -> [T]
-ofList Leaf = []
-ofList (Fork x rest) = x : ofList rest
-ofList _ = error "Invalid Tree Calculus list"
+toString :: T -> Either String String
+toString tc = case toList tc of
+  Right list -> traverse (fmap toEnum . toNumber) list
+  Left err -> Left "Invalid Tree Calculus string"
+
+toList :: T -> Either String [T]
+toList Leaf = Right []
+toList (Fork x rest) = case toList rest of
+  Right xs -> Right (x : xs)
+  Left err -> Left err
+toList _ = Left "Invalid Tree Calculus list"
 
 -- Utility
 toAscii :: T -> String

test/Spec.hs

@@ -2,240 +2,319 @@ module Main where
 
 import Eval
 import Lexer
+import Library
 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
+  , lambdaEvalTests
+  , propertyTests
+  ]
 
 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 = SFunc "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) @?= ofString "hello"
+  , testCase "Evaluate list literal" $ do
+      let input = "[t (t t)]"
+      let ast = parseSingle input
+      (result $ evalSingle Map.empty ast) @?= ofList [Leaf, Stem Leaf]
+  , testCase "Evaluate empty list" $ do
+      let input = "[]"
+      let ast = parseSingle input
+      (result $ evalSingle Map.empty ast) @?= ofList []
+  , 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 library (parseSapling input)
+      result env @?= Leaf
+   , testCase "Boolean AND_ FT" $ do
+      let input = "and (t) (t t)"
+          env = evalSapling library (parseSapling input)
+      result env @?= Leaf
+   , testCase "Boolean AND_ FF" $ do
+      let input = "and (t) (t)"
+          env = evalSapling library (parseSapling input)
+      result env @?= Leaf
+    , testCase "Boolean AND_ TT" $ do
+      let input = "and (t t) (t t)"
+          env = evalSapling library (parseSapling input)
+      result env @?= Stem Leaf
+    , testCase "Verifying Equality" $ do
+      let input = "equal (t t t) (t t t)"
+          env = evalSapling library (parseSapling input)
+      result env @?= Stem Leaf
+  ]
+
+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 @?= "Stem (Stem 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 @?= "Stem 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 "Nested lambda abstractions in the same expression" $ do
+        let input = "f = (\\x : (\\y : x y))\ng = (\\z : z)\nf g t"
+        runSapling input @?= "Leaf"
+  , testCase "Lambda with a string literal" $ do
+        let input = "f = (\\x : x)\nf \"hello\""
+        runSapling input @?= "Fork (Fork Leaf (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) 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 (Fork (Stem Leaf) (Fork Leaf (Fork (Stem 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)"
+  ]
 
 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
+  ]