Further library additions and REPL updates
This commit is contained in:
parent
c820eda816
commit
44e2169cdb
@ -10,6 +10,7 @@ library :: Map.Map String T
|
|||||||
library = evalSapling Map.empty $ parseSapling
|
library = evalSapling Map.empty $ parseSapling
|
||||||
"false = t\n \
|
"false = t\n \
|
||||||
\ true = t t\n \
|
\ true = t t\n \
|
||||||
|
\ _ = t\n \
|
||||||
\ k = t t\n \
|
\ k = t t\n \
|
||||||
\ i = t (t k) t\n \
|
\ i = t (t k) t\n \
|
||||||
\ s = t (t (k t)) t\n \
|
\ s = t (t (k t)) t\n \
|
||||||
@ -26,7 +27,7 @@ library = evalSapling Map.empty $ parseSapling
|
|||||||
\ id = (\\a : a)\n \
|
\ id = (\\a : a)\n \
|
||||||
\ triage = (\\a b c : t (t a b) c)\n \
|
\ triage = (\\a b c : t (t a b) c)\n \
|
||||||
\ pair = t\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 \
|
\ matchList = (\\oe oc : triage oe _ oc)\n \
|
||||||
\ matchPair = (\\op : triage _ _ op)\n \
|
\ matchPair = (\\op : triage _ _ op)\n \
|
||||||
\ and = matchBool id (\\z : false)\n \
|
\ and = matchBool id (\\z : false)\n \
|
||||||
@ -36,8 +37,10 @@ library = evalSapling Map.empty $ parseSapling
|
|||||||
\ nonEmptyList = matchList false (\\y z : true)\n \
|
\ nonEmptyList = matchList false (\\y z : true)\n \
|
||||||
\ head = matchList t (\\hd tl : hd)\n \
|
\ head = matchList t (\\hd tl : hd)\n \
|
||||||
\ tail = matchList t (\\hd tl : tl)\n \
|
\ tail = matchList t (\\hd tl : tl)\n \
|
||||||
\ listConcat = y (\\self : matchList (\\k : k) (\\h t k : pair h (self t k)))\n \
|
\ isLeaf = (\\_ : triage true false false)\n \
|
||||||
\ listConcat \"foo\" \"bar\"\n \
|
\ listConcat = y (\\self : matchList (\\k : k) (\\h r k : pair h (self r k)))\n \
|
||||||
\ lAnd = triage (\\x : false) (\\z x : x) (\\y z x : x)\n \
|
\ lAnd = triage (\\x : false) (\\_ x : x) (\\_ _ x : x)\n \
|
||||||
\ lOr = triage (\\x : x) (\\z x : true) (\\y z x : true)\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))))"
|
\ 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))))"
|
||||||
|
@ -11,7 +11,11 @@ import qualified Data.Map as Map
|
|||||||
import Text.Megaparsec (runParser)
|
import Text.Megaparsec (runParser)
|
||||||
|
|
||||||
main :: IO ()
|
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 :: String -> String
|
||||||
runSapling s = show $ result (evalSapling Map.empty $ parseSapling s)
|
runSapling s = show $ result (evalSapling Map.empty $ parseSapling s)
|
||||||
|
14
src/REPL.hs
14
src/REPL.hs
@ -14,15 +14,15 @@ repl env = do
|
|||||||
putStr "sapling < "
|
putStr "sapling < "
|
||||||
hFlush stdout
|
hFlush stdout
|
||||||
input <- getLine
|
input <- getLine
|
||||||
if input == "_:exit"
|
case input of
|
||||||
then putStrLn "Goodbye!"
|
":_exit" ->
|
||||||
else if input == ""
|
putStrLn "Goodbye!"
|
||||||
then do
|
"" -> do
|
||||||
putStrLn ""
|
putStrLn ""
|
||||||
repl env
|
repl env
|
||||||
else do
|
_ -> do
|
||||||
let clearEnv = Map.delete "__result" env
|
let clearEnv = Map.delete "__result" env
|
||||||
let newEnv = evalSingle clearEnv (parseSingle input)
|
newEnv = evalSingle clearEnv (parseSingle input)
|
||||||
case Map.lookup "__result" newEnv of
|
case Map.lookup "__result" newEnv of
|
||||||
Just r -> do
|
Just r -> do
|
||||||
putStrLn $ "sapling > " ++ show r
|
putStrLn $ "sapling > " ++ show r
|
||||||
@ -36,4 +36,4 @@ decodeResult tc =
|
|||||||
Right str -> "\"" ++ str ++ "\""
|
Right str -> "\"" ++ str ++ "\""
|
||||||
Left _ -> case ofNumber tc of
|
Left _ -> case ofNumber tc of
|
||||||
Right num -> "# " ++ show num
|
Right num -> "# " ++ show num
|
||||||
Left _ -> "Failed to decode number from Tree"
|
Left _ -> ""
|
||||||
|
@ -78,7 +78,7 @@ ofNumber _ = Left "Invalid Tree Calculus number"
|
|||||||
ofString :: T -> Either String String
|
ofString :: T -> Either String String
|
||||||
ofString tc = case ofList tc of
|
ofString tc = case ofList tc of
|
||||||
Right list -> traverse (fmap toEnum . ofNumber) list
|
Right list -> traverse (fmap toEnum . ofNumber) list
|
||||||
Left err -> Left err
|
Left err -> Left "Invalid Tree Calculus string"
|
||||||
|
|
||||||
ofList :: T -> Either String [T]
|
ofList :: T -> Either String [T]
|
||||||
ofList Leaf = Right []
|
ofList Leaf = Right []
|
||||||
|
Loading…
x
Reference in New Issue
Block a user