commit 1224961c62116dfebf964a536c8a9ee897305285
parent 9c1c916fc9b14bcbe4a5450e108f71aa765b38de
Author: James Eversole <james@eversole.co>
Date: Fri, 27 Dec 2024 15:40:50 -0600
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.
Diffstat:
6 files changed, 86 insertions(+), 23 deletions(-)
diff --git a/README.md b/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).
diff --git a/src/Eval.hs b/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
- lineNoLambda = eliminateLambda body
+ let 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
diff --git a/src/Lexer.hs b/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
diff --git a/src/Main.hs b/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)
diff --git a/src/REPL.hs b/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"
diff --git a/src/Research.hs b/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]
-ofList Leaf = []
-ofList (Fork x rest) = x : ofList rest
-ofList _ = error "Invalid Tree Calculus list"
+ofNumber :: T -> Either String Int
+ofNumber Leaf = Right 0
+ofNumber (Fork Leaf rest) = case ofNumber rest of
+ 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
