From 0dd14a3aeab3e011d2fba04bc4be3c5d4b01a412 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Fri, 27 Dec 2024 15:40:50 -0600 Subject: [PATCH] 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 | 39 +++++++++++++++++++++++++++++++++++++-- src/Eval.hs | 8 ++++++-- src/Lexer.hs | 2 +- src/Main.hs | 5 ++++- src/REPL.hs | 16 +++++++++++++--- src/Research.hs | 39 +++++++++++++++++++++++++-------------- 6 files changed, 86 insertions(+), 23 deletions(-) diff --git a/README.md b/README.md index 7ab22ba..e47bea8 100644 --- 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 index 07b7e85..c29954f 100644 --- 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 index 19edb05..a6614ab 100644 --- 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 index 4b76ba5..1c35eaf 100644 --- 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 index 44584dc..d9ce84d 100644 --- 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 index 7e82a28..7e52bee 100644 --- 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