Update lambda handling; better default decode out

sapling.cabal

@@ -29,6 +29,7 @@ executable sapling
   build-depends:
     base >=4.7
     , containers
+    , haskeline
     , megaparsec
     , mtl
   other-modules:
@@ -47,6 +48,7 @@ test-suite sapling-tests
   build-depends:       
     base
     , containers
+    , haskeline
     , megaparsec
     , mtl
     , tasty

src/Eval.hs

@@ -18,7 +18,7 @@ evalSingle env term = case term of
     let result = evalAST env body
     in Map.insert "__result" result env
   SApp func arg ->
-    let result = apply (evalAST env func) (evalAST env arg)
+    let result = apply (evalAST env $ eliminateLambda func) (evalAST env $ eliminateLambda arg)
     in Map.insert "__result" result env
   SVar name ->
     case Map.lookup name env of

src/Library.hs

@@ -7,40 +7,41 @@ import Research
 import qualified Data.Map as Map
 
 library :: Map.Map String T
-library = evalSapling Map.empty $ parseSapling
+library = evalSapling Map.empty $ parseSapling $ unlines 
-   "false = t\n \ 
+  [ "false = t" 
-  \ true = t t\n \
+  , "true = t t"
-  \ _ = t\n \
+  , "_ = t"
-  \ k = t t\n \
+  , "k = t t"
-  \ i = t (t k) t\n \
+  , "i = t (t k) t"
-  \ s = t (t (k t)) t\n \
+  , "s = t (t (k t)) t"
-  \ m = s i i\n \
+  , "m = s i i"
-  \ b = s (k s) k\n \
+  , "b = s (k s) k"
-  \ c = s (s (k s) (s (k k) s)) (k k)\n \
+  , "c = s (s (k s) (s (k k) s)) (k k)"
-  \ iC = (\\a b c : s a (k c) b)\n \
+  , "iC = (\\a b c : s a (k c) b)"
-  \ iD = b (b iC) iC\n \
+  , "iD = b (b iC) iC"
-  \ iE = b (b iD) iC\n \
+  , "iE = b (b iD) iC"
-  \ yi = (\\i : b m (c b (i m)))\n \
+  , "yi = (\\i : b m (c b (i m)))"
-  \ y = yi iC\n \
+  , "y = yi iC"
-  \ yC = yi iD\n \
+  , "yC = yi iD"
-  \ yD = yi iE\n \
+  , "yD = yi iE"
-  \ id = (\\a : a)\n \
+  , "id = (\\a : a)"
-  \ triage = (\\a b c : t (t a b) c)\n \
+  , "triage = (\\a b c : t (t a b) c)"
-  \ pair = t\n \
+  , "pair = t"
-  \ matchBool = (\\ot of : triage of (\\_ : ot) (\\_ _ : ot))\n \
+  , "matchBool = (\\ot of : triage of (\\_ : ot) (\\_ _ : ot))"
-  \ matchList = (\\oe oc : triage oe _ oc)\n \
+  , "matchList = (\\oe oc : triage oe _ oc)"
-  \ matchPair = (\\op : triage _ _ op)\n \
+  , "matchPair = (\\op : triage _ _ op)"
-  \ and = matchBool id (\\z : false)\n \
+  , "and = matchBool id (\\z : false)"
-  \ if = (\\cond then else : t (t else (t t then)) t cond)\n \
+  , "if = (\\cond then else : t (t else (t t then)) t cond)"
-  \ test = triage \"leaf\" (\\z : \"stem\") (\\a b : \"fork\")\n \
+  , "test = triage \"leaf\" (\\z : \"stem\") (\\a b : \"fork\")"
-  \ emptyList = matchList true (\\y z : false)\n \
+  , "emptyList = matchList true (\\y z : false)"
-  \ nonEmptyList = matchList false (\\y z : true)\n \
+  , "nonEmptyList = matchList false (\\y z : true)"
-  \ head = matchList t (\\hd tl : hd)\n \
+  , "head = matchList t (\\hd tl : hd)"
-  \ tail = matchList t (\\hd tl : tl)\n \
+  , "tail = matchList t (\\hd tl : tl)"
-  \ isLeaf = (\\_ : triage true false false)\n \
+  , "isLeaf = (\\_ : triage true false false)"
-  \ listConcat = y (\\self : matchList (\\k : k) (\\h r k : pair h (self r k)))\n \
+  , "listConcat = y (\\self : matchList (\\k : k) (\\h r k : pair h (self r k)))"
-  \ lAnd = triage (\\x : false) (\\_ x : x) (\\_ _ x : x)\n \
+  , "lAnd = triage (\\x : false) (\\_ x : x) (\\_ _ x : x)"
-  \ lOr = triage (\\x : x) (\\_ _ : true) (\\_ _ x : true)\n \
+  , "lOr = triage (\\x : x) (\\_ _ : true) (\\_ _ x : true)"
-  \ hmap = y (\\self : matchList (\\f : t) (\\hd tl f : pair (f hd) (self tl f)))\n \
+  , "hmap = y (\\self : matchList (\\f : t) (\\hd tl f : pair (f hd) (self tl f)))"
-  \ map = (\\f l : hmap l f) \n \
+  , "map = (\\f l : hmap l f)"
-  \ 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))))" 
+  ]

src/Main.hs

@@ -17,6 +17,6 @@ main = do
   putStrLn ":_exit"
   repl library
 
-runSapling :: String -> String
+runSapling :: String -> T
-runSapling s = show $ result (evalSapling Map.empty $ parseSapling s)
+runSapling s = result (evalSapling Map.empty $ parseSapling s)
-runSaplingEnv env s = show $ result (evalSapling env $ parseSapling s)
+runSaplingEnv env s = result (evalSapling env $ parseSapling s)

src/REPL.hs

@@ -7,33 +7,36 @@ import Research
 
 import Control.Monad         		 (void)
 import qualified Data.Map as Map
+import System.Console.Haskeline
 import System.IO            		 (hFlush, stdout)
 
 repl :: Map.Map String T -> IO ()
-repl env = do
+repl env = runInputT defaultSettings (loop env)
-  putStr "sapling < "
+  where
-  hFlush stdout
+    loop :: Map.Map String T -> InputT IO ()
-  input <- getLine
+    loop env = do
-  case input of
+      minput <- getInputLine "sapling < "
-    ":_exit" ->
+      case minput of
-      putStrLn "Goodbye!"
+        Nothing -> outputStrLn "Goodbye!"
-    ""       -> do
+        Just ":_exit" -> outputStrLn "Goodbye!"
-      putStrLn ""
+        Just "" -> do
-      repl env
+          outputStrLn ""
-    _ -> do
+          loop env
+        Just input -> do
           let clearEnv = Map.delete "__result" env
               newEnv   = evalSingle clearEnv (parseSingle input)
           case Map.lookup "__result" newEnv of
             Just r -> do
-          putStrLn $ "sapling > " ++ show r
+              outputStrLn $ "sapling > " ++ show r
-          putStrLn $ "DECODE -: " ++ (decodeResult r)
+              outputStrLn $ "DECODE -: " ++ decodeResult r
-        Nothing -> pure ()
+            Nothing -> return ()
-      repl newEnv
+          loop newEnv
 
 decodeResult :: T -> String
-decodeResult tc = 
+decodeResult tc = case ofNumber tc of
-  case ofString tc of
+  Right num -> show num
+  Left _ -> case ofString tc of
     Right str -> "\"" ++ str ++ "\""
-    Left _ -> case ofNumber tc of
+    Left _ -> case ofList tc of
-      Right num -> "# " ++ show num
+      Right list -> "[" ++ unlines (map decodeResult list) ++ "]"
       Left _ -> ""