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,21 +2,26 @@ 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
+    let lineNoLambda = eliminateLambda body
+        result = evalAST env lineNoLambda
     in Map.insert name result env
-    SApp func arg ->
-        let result = apply (evalAST env func) (evalAST env arg)
+  SLambda _ body ->
+    let result = evalAST env body
     in Map.insert "__result" result env
-    SVar name -> case Map.lookup name env of
+  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"
   _ ->
@@ -26,97 +31,66 @@ evalSingle env term = case term of
 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
+    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)
+  | 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
 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

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,6 +12,7 @@ import Text.Megaparsec.Char
 import Text.Megaparsec.Error (errorBundlePretty, ParseErrorBundle)
 
 type Parser = Parsec Void [LToken]
+
 data SaplingAST
   = SVar String
   | SInt Int
@@ -33,7 +32,6 @@ 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
   Right ast -> ast
@@ -45,6 +43,7 @@ parseExpression :: Parser SaplingAST
 parseExpression = choice
   [ try parseFunction
   , try parseLambda
+  , try parseLambdaExpression
   , try parseListLiteral
   , try parseApplication
   , try parseTreeTerm
@@ -59,6 +58,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 +93,7 @@ parseAtomicLambda = choice
   , parseTreeLeaf
   , parseLiteral
   , parseListLiteral
+  , try parseLambda
   , between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseLambdaExpression
   ]
 
@@ -102,13 +115,6 @@ isTreeTerm (TStem _)   = True
 isTreeTerm (TFork _ _) = True
 isTreeTerm _ = False
 
-parseAtomicBase :: Parser SaplingAST
-parseAtomicBase = choice
-  [ parseVar
-  , parseTreeLeaf
-  , parseGrouped
-  ]
-
 parseTreeLeaf :: Parser SaplingAST
 parseTreeLeaf = satisfy isKeywordT *> notFollowedBy (satisfy (== LAssign)) *> pure TLeaf
 
@@ -147,7 +153,6 @@ parseAtomic = choice
   , parseLiteral
   ]
 
-
 parseGrouped :: Parser SaplingAST
 parseGrouped = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseExpression
 
@@ -218,21 +223,16 @@ parseStrLiteral = do
 -- Boolean Helpers
 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 (LNewline) = True
 isNewline _ = False
 
 -- Error Handling
@@ -252,3 +252,4 @@ showError (FancyError offset fancy) =
 showError (TrivialError offset Nothing expected) =
   "Parse error at offset " ++ show offset ++ ": expected one of "
   ++ 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.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
+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
-      let newEnv   = evalSingle clearEnv (parseSingle input)
+              newEnv   = evalSingle clearEnv (parseSingle input)
           case Map.lookup "__result" newEnv of
-        Just r  -> putStrLn $ "sapling < " ++ show r
-        Nothing -> pure ()
-      repl newEnv
+            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,24 +2,31 @@ 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
+  , lambdaEvalTests
   , propertyTests
   ]
 
@@ -60,85 +67,80 @@ lexerTests = testGroup "Lexer Tests"
 
 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
+  [ --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")
+      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"
-        let expect = SApp (SApp TLeaf (SApp TLeaf TLeaf)) TLeaf
+          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
+          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]
+          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"))
+      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)]]"
-        let expect = SList [TLeaf,SList [SApp TLeaf TLeaf]]
+          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))
+          expect = SApp TLeaf (SApp (SApp TLeaf TLeaf) (SApp TLeaf TLeaf))
       parseSingle input @?= expect
   , testCase "Parse empty list" $ do
       let input  = "[]"
-        let expect = SList []
+          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]]
+          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]
+          expect = SList [TLeaf, TLeaf]
       parseSingle input1 @?= expect
       parseSingle input2 @?= expect
   , testCase "Parse string in list" $ do
       let input  = "[(\"hello\")]"
-        let expect = SList [SStr "hello"]
+          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]
+          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)))
+      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)"
-        let expect = (SLambda ["a"] (SVar "a"))
+          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")))
+          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)"
+      let input  = "x = (\\a : a)\nx (t)"
           expect = [SFunc "x" [] (SLambda ["a"] (SVar "a")),SApp (SVar "x") TLeaf]
       parseSapling input @?= expect
   ]
@@ -147,11 +149,11 @@ 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)
+          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
+          expect = SApp (SApp TLeaf (SApp (SApp TLeaf TLeaf) TLeaf)) TLeaf
       parseSingle input @?= expect
   ]
 
@@ -180,54 +182,131 @@ evaluationTests = testGroup "Evaluation Tests"
         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)
+          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)
+          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)
+          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"
+      (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) @?= toList [Leaf, Stem Leaf]
+      (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) @?= toList []
+      (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"
-        let env = evalSapling Map.empty (parseSapling input)
+          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)
+      (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
+      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
+   , 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