Automatic decoding of supported literals in REPL

Automatic decoding & display of string, number, and list types in REPL.
General updates to README, style, and comments.

README.md

@@ -1,16 +1,51 @@
 # 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
+true = t t
+id = (\\a : a)
+triage = (\\a b c : t (t a b) c) 
+match_bool = (\\ot of : triage of (\\z : ot) t)
+and = match_bool id (\\z : 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\" (\\z : \"stem\") (\\a b : \"fork\")
+
+sapling < test t
+sapling > Fork (...)
+DECODE -: "leaf"
+sapling < test (t t)
+sapling > Fork (...)
+DECODE -: "stem"
+sapling < test (t t t)
+sapling > Fork (...)
+DECODE -: "fork"
+```
+
+## 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). 

src/Eval.hs

@@ -11,8 +11,7 @@ import qualified Data.Set as Set
 evalSingle :: Map String T -> SaplingAST -> Map String T
 evalSingle env term = case term of
   SFunc name [] body ->
-    let
+    let lineNoLambda = eliminateLambda body
-        lineNoLambda = eliminateLambda body
         result = evalAST env lineNoLambda
     in Map.insert name result env
   SLambda _ body ->
@@ -67,6 +66,9 @@ 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
@@ -101,6 +103,8 @@ 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 = SApp (SApp TLeaf (SApp TLeaf (SApp TLeaf TLeaf))) TLeaf
 

src/Lexer.hs

@@ -45,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

src/Main.hs

@@ -15,6 +15,7 @@ main = repl library
 runSapling :: String -> String
 runSapling s = show $ result (evalSapling Map.empty $ parseSapling s)
 
+library :: Map.Map String T
 library = evalSapling Map.empty $ parseSapling
       "false = t\n \ 
      \ true = t t\n \
@@ -22,6 +23,8 @@ library = evalSapling Map.empty $ parseSapling
      \ triage = (\\a b c : t (t a b) c)\n \
      \ match_bool = (\\ot of : triage of (\\z : ot) t)\n \
      \ and = match_bool id (\\z : false)\n \
-     \ if = (\\cond then else : t (t else (t t then)) t cond)"
+     \ if = (\\cond then else : t (t else (t t then)) t cond)\n \
+     \ triage = (\\a b c : t (t a b) c)\n \
+     \ test = triage \"leaf\" (\\z : \"stem\") (\\a b : \"fork\")"
 
 runSaplingEnv env s = show $ result (evalSapling env $ parseSapling s)

src/REPL.hs

@@ -11,19 +11,29 @@ import System.IO            (hFlush, stdout)
 
 repl :: Map.Map String T -> IO ()
 repl env = do
-  putStr "sapling > "
+  putStr "sapling < "
   hFlush stdout
   input <- getLine
   if input == "_:exit"
     then putStrLn "Goodbye!"
   else if input == ""
-    then do 
+    then do
       putStrLn ""
       repl env
     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
+        Just r  -> do
+          putStrLn $ "sapling > " ++ show r
+          putStrLn $ "DECODE -: " ++ (decodeResult r)
         Nothing -> pure ()
       repl newEnv
+
+decodeResult :: T -> String
+decodeResult tc = 
+  case ofString tc of
+    Right str -> "\"" ++ str ++ "\""
+    Left _ -> case ofNumber tc of
+      Right num -> "Number: " ++ show num
+      Left _ -> "Failed to decode number from Tree"

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
@@ -51,9 +54,6 @@ _not = Fork (Fork _true (Fork Leaf _false)) Leaf
 toString :: String -> T
 toString str = toList (map toNumber (map fromEnum str))
 
-ofString :: T -> String
-ofString tc = map (toEnum . ofNumber) (ofList tc)
-
 toNumber :: Int -> T
 toNumber 0 = Leaf
 toNumber n =
@@ -61,20 +61,31 @@ toNumber n =
     (if odd n then Stem Leaf else Leaf)
     (toNumber (n `div` 2))
 
-ofNumber :: T -> Int
-ofNumber Leaf = 0
-ofNumber (Fork Leaf rest) = 2 * ofNumber rest
-ofNumber (Fork (Stem Leaf) rest) = 1 + 2 * ofNumber rest
-ofNumber _ = error "Invalid Tree Calculus number"
-
 toList :: [T] -> T
 toList [] = Leaf
 toList (x:xs) = Fork x (toList xs)
 
-ofList :: T -> [T]
+ofNumber :: T -> Either String Int
-ofList Leaf = []
+ofNumber Leaf = Right 0
-ofList (Fork x rest) = x : ofList rest
+ofNumber (Fork Leaf rest) = case ofNumber rest of
-ofList _ = error "Invalid Tree Calculus list"
+  Right n -> Right (2 * n)
+  Left err -> Left err
+ofNumber (Fork (Stem Leaf) rest) = case ofNumber rest of
+  Right n -> Right (1 + 2 * n)
+  Left err -> Left err
+ofNumber _ = Left "Invalid Tree Calculus number"
+
+ofString :: T -> Either String String
+ofString tc = case ofList tc of
+  Right list -> traverse (fmap toEnum . ofNumber) list
+  Left err -> Left err
+
+ofList :: T -> Either String [T]
+ofList Leaf = Right []
+ofList (Fork x rest) = case ofList rest of
+  Right xs -> Right (x : xs)
+  Left err -> Left err
+ofList _ = Left "Invalid Tree Calculus list"
 
 -- Utility
 toAscii :: T -> String