tricu

commit 8c1243580f1f9d26f06ff10b1151755b88bd9709
parent c718684963dc92b3611089bd387b372af59c1cea
Author: James Eversole <james@eversole.co>
Date:   Fri, 27 Dec 2024 19:27:04 -0600

Further library additions and REPL updates

Diffstat:
M
src/Library.hs
 | 
13
++++++++-----
M
src/Main.hs
 | 
6
+++++-
M
src/REPL.hs
 | 
14
+++++++-------
M
src/Research.hs
 | 
2
+-

4 files changed, 21 insertions(+), 14 deletions(-)
diff --git a/src/Library.hs b/src/Library.hs
@@ -10,6 +10,7 @@ library :: Map.Map String T
 library = evalSapling Map.empty $ parseSapling
    "false = t\n \ 
   \ true = t t\n \
+  \ _ = t\n \
   \ k = t t\n \
   \ i = t (t k) t\n \
   \ s = t (t (k t)) t\n \
@@ -26,7 +27,7 @@ library = evalSapling Map.empty $ parseSapling
   \ id = (\\a : a)\n \
   \ triage = (\\a b c : t (t a b) c)\n \
   \ pair = t\n \
-  \ matchBool = (\\ot of : triage of (\\z : ot) t)\n \
+  \ matchBool = (\\ot of : triage of (\\_ : ot) (\\_ _ : ot))\n \
   \ matchList = (\\oe oc : triage oe _ oc)\n \
   \ matchPair = (\\op : triage _ _ op)\n \
   \ and = matchBool id (\\z : false)\n \
@@ -36,8 +37,10 @@ library = evalSapling Map.empty $ parseSapling
   \ nonEmptyList = matchList false (\\y z : true)\n \
   \ head = matchList t (\\hd tl : hd)\n \
   \ tail = matchList t (\\hd tl : tl)\n \
-  \ listConcat = y (\\self : matchList (\\k : k) (\\h t k : pair h (self t k)))\n \
-  \ listConcat \"foo\" \"bar\"\n \
-  \ lAnd = triage (\\x : false) (\\z x : x) (\\y z x : x)\n \
-  \ lOr = triage (\\x : x) (\\z x : true) (\\y z x : true)\n \
+  \ isLeaf = (\\_ : triage true false false)\n \
+  \ listConcat = y (\\self : matchList (\\k : k) (\\h r k : pair h (self r k)))\n \
+  \ lAnd = triage (\\x : false) (\\_ x : x) (\\_ _ x : x)\n \
+  \ lOr = triage (\\x : x) (\\_ _ : true) (\\_ _ x : true)\n \
+  \ hmap = y (\\self : matchList (\\f : t) (\\hd tl f : pair (f hd) (self tl f)))\n \
+  \ map = (\\f l : hmap l f) \n \
   \ 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))))"
diff --git a/src/Main.hs b/src/Main.hs
@@ -11,7 +11,11 @@ import qualified Data.Map as Map
 import Text.Megaparsec (runParser)
 
 main :: IO ()
-main = repl library
+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 -> String
 runSapling s = show $ result (evalSapling Map.empty $ parseSapling s)
diff --git a/src/REPL.hs b/src/REPL.hs
@@ -14,15 +14,15 @@ repl env = do
   putStr "sapling < "
   hFlush stdout
   input <- getLine
-  if input == "_:exit"
-    then putStrLn "Goodbye!"
-  else if input == ""
-    then do
+  case input of
+    ":_exit" ->
+      putStrLn "Goodbye!"
+    ""       -> do
       putStrLn ""
       repl env
-    else do
+    _ -> 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  -> do
           putStrLn $ "sapling > " ++ show r
@@ -36,4 +36,4 @@ decodeResult tc =
     Right str -> "\"" ++ str ++ "\""
     Left _ -> case ofNumber tc of
       Right num -> "# " ++ show num
-      Left _ -> "Failed to decode number from Tree"
+      Left _ -> ""
diff --git a/src/Research.hs b/src/Research.hs
@@ -78,7 +78,7 @@ 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
+  Left err -> Left "Invalid Tree Calculus string"
 
 ofList :: T -> Either String [T]
 ofList Leaf = Right []