diff --git a/src/Library.hs b/src/Library.hs index 780243a..093d4b9 100644 --- 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 index 22e4a77..54df9f7 100644 --- 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 index b1859ac..480ff63 100644 --- 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 index 7e52bee..dcecd14 100644 --- 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 []