Fix critical list evaluation bug and REPL updates

README.md

@@ -19,31 +19,21 @@ tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)
 ## What does it look like?
 
 ```
--- Anything after `--` on a single line is a comment
--- We can define functions or "variables" as Tree Calculus values
-false = t 
-_ = t
-true = t t
--- We can define functions as lambda expressions that are eliminated to Tree
--- Calculus terms.
-id = (\a : a) -- `id` evaluates to the TC form of: t (t (t t)) t
-triage = (\a b c : t (t a b) c)
--- Intensionality! We can inspect program structure, not just inputs/outputs:
-test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork")
+tricu < -- Anything after `--` on a single line is a comment
+tricu < id = (\a : a) -- Lambda abstraction is eliminated to tree calculus terms
+tricu < head (map (\i : lconcat i " world!") [("Hello, ")])
+tricu > "Hello,  world!"
+tricu < id (head (map (\i : lconcat i " world!") [("Hello, ")]))
+tricu > "Hello,  world!"
 
--- REPL
--- `tricu <` is the input prompt
--- `tricu >` is the Tree Calculus form output. Most are elided below.
--- `READ -:` is an attempt to interpret the TC output as strings/numbers.
-tricu < test t
-tricu > Fork (Fork Leaf (Fork ...) ... ) 
-READ -: "Leaf"
-tricu < test (t t)
-READ -: "Stem"
-tricu < test (t t t)
-READ -: "Fork"
-tricu < map (\i : listConcat i " is super cool!") [("Tree Calculus") ("Intensionality") ("tricu")]
-READ -: ["Tree Calculus is super cool!", "Intensionality is super cool!", "tricu is super cool!"]
+tricu < -- Intensionality! We can inspect the structure of a function.
+tricu < triage = (\a b c : t (t a b) c)
+tricu < test = triage "Leaf" (\z : "Stem") (\a b : "Fork")
+tricu < test t t
+tricu > "Stem"
+tricu < -- We can even write a function to convert a function to source code
+tricu < toTString id
+tricu > "t (t (t t)) t"
 ```
 
 ## Installation and Use

src/Eval.hs

@@ -23,7 +23,7 @@ evalSingle env term = case term of
   SVar name ->
     case Map.lookup name env of
       Just value -> Map.insert "__result" value env
-      Nothing -> error $ "Variable " ++ name ++ " not defined"
+      Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
   _ ->
     let result = evalAST env term
     in Map.insert "__result" result env
@@ -46,19 +46,18 @@ evalAST :: Map String T -> TricuAST -> T
 evalAST env term = case term of
   SVar name -> case Map.lookup name env of
     Just value -> value
-    Nothing -> error $ "Variable " ++ name ++ " not defined"
+    Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
   TLeaf -> Leaf
   TStem t -> Stem (evalAST env t)
   TFork t1 t2 -> Fork (evalAST env t1) (evalAST env t2)
   SApp t1 t2 -> apply (evalAST env t1) (evalAST env t2)
   SStr str -> ofString str
   SInt num -> ofNumber num
-  SList elems -> ofList (map (evalAST Map.empty) elems)
+  SList elems -> ofList (map (evalAST env) elems)
   SEmpty -> Leaf
   SFunc name args body ->
-    error $ "Unexpected function definition " ++ name
-    ++ " in evalAST; define via evalSingle."
-  SLambda {} -> error "Internal error: SLambda found in evalAST after elimination."
+    errorWithoutStackTrace $ "Unexpected function definition " ++ name
+  SLambda {} -> errorWithoutStackTrace "Internal error: SLambda found in evalAST after elimination."
 
 eliminateLambda :: TricuAST -> TricuAST
 eliminateLambda (SLambda (v:vs) body)
@@ -115,4 +114,4 @@ tS = SApp (SApp TLeaf (SApp TLeaf (SApp (SApp TLeaf TLeaf) TLeaf))) TLeaf
 result :: Map String T -> T
 result r = case Map.lookup "__result" r of
   Just a -> a
-  Nothing -> error "No __result field found in provided environment"
+  Nothing -> errorWithoutStackTrace "No __result field found in provided environment"

src/FileEval.hs

@@ -15,7 +15,7 @@ evaluateFileResult filePath = do
   let finalEnv = evalTricu Map.empty asts
   case Map.lookup "__result" finalEnv of
     Just finalResult -> return finalResult
-    Nothing -> error "No result found in final environment"
+    Nothing -> errorWithoutStackTrace "No expressions to evaluate found"
 
 evaluateFile :: FilePath -> IO Env
 evaluateFile filePath = do

src/Lexer.hs

@@ -90,5 +90,5 @@ tricuLexer = do
 
 lexTricu :: String -> [LToken]
 lexTricu input = case runParser tricuLexer "" input of
-  Left err -> error $ "Lexical error:\n" ++ errorBundlePretty err
+  Left err -> errorWithoutStackTrace $ "Lexical error:\n" ++ errorBundlePretty err
   Right tokens -> tokens

src/Main.hs

@@ -6,7 +6,7 @@ import Parser                 (parseTricu)
 import REPL
 import Research
 
-import Control.Monad 					(foldM)
+import Control.Monad          (foldM)
 import Control.Monad.IO.Class (liftIO)
 import Text.Megaparsec        (runParser)
 import System.Console.CmdArgs
@@ -61,7 +61,7 @@ main = do
       putStrLn "Welcome to the tricu REPL"
       putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`"
       library <- liftIO $ evaluateFile "./lib/base.tri"
-      repl library
+      repl $ Map.delete "__result" library
     Evaluate { file = filePaths, form = form } -> do
       result <- case filePaths of
         [] -> do

src/REPL.hs

@@ -8,7 +8,8 @@ import Research
 
 import Control.Exception         (SomeException, catch)
 import Control.Monad.IO.Class    (liftIO)
-import Data.List                 (intercalate)
+import Data.Char                 (isSpace)
+import Data.List                 (dropWhile, dropWhileEnd, intercalate)
 import System.Console.Haskeline
 
 import qualified Data.Map as Map
@@ -20,23 +21,27 @@ repl env = runInputT defaultSettings (loop env)
     loop env = do
       minput <- getInputLine "tricu < "
       case minput of
-        Nothing -> outputStrLn "Goodbye!"
-        Just ":_exit" -> outputStrLn "Goodbye!"
-        Just ":_load" -> do
-          path <- getInputLine "File path to load < "
-          case path of
-            Nothing -> do
-              outputStrLn "No input received; stopping import."
-              loop env
-            Just path -> do
-              loadedEnv <- liftIO $ evaluateFile path
-              loop $ Map.union loadedEnv env
-        Just "" -> do
-          outputStrLn ""
-          loop env
-        Just input -> do
-          newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
-          loop newEnv
+        Nothing -> outputStrLn "Exiting tricu"
+        Just s -> case strip s of 
+          "!exit" -> outputStrLn "Exiting tricu"
+          "!load" -> do
+            path <- getInputLine "File path to load < "
+            case path of
+              Nothing -> do
+                outputStrLn "No input received; stopping import."
+                loop env
+              Just path -> do
+                loadedEnv <- liftIO $ evaluateFileWithContext env (strip path)
+                loop $ Map.delete "__result" (Map.union loadedEnv env)
+          "" -> do
+            outputStrLn ""
+            loop env
+          input -> do
+            case (take 2 input) of 
+              "--" -> loop env
+              _ -> do
+                newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
+                loop newEnv
   
     processInput :: Env -> String -> IO Env
     processInput env input = do
@@ -44,8 +49,7 @@ repl env = runInputT defaultSettings (loop env)
           newEnv = evalTricu env asts
       case Map.lookup "__result" newEnv of
         Just r -> do
-          putStrLn $ "tricu > " ++ show r
-          putStrLn $ "READ -: \"" ++ decodeResult r ++ "\""
+          putStrLn $ "tricu > " ++ decodeResult r
         Nothing -> return ()
       return newEnv
     
@@ -53,12 +57,13 @@ repl env = runInputT defaultSettings (loop env)
     errorHandler env e = do
       putStrLn $ "Error: " ++ show e
       return env
+    
+    strip :: String -> String
+    strip = dropWhileEnd isSpace . dropWhile isSpace
 
 decodeResult :: T -> String
 decodeResult tc = case toNumber tc of
   Right num -> show num
   Left _ -> case toString tc of
-    Right str -> str
-    Left _ -> case toList tc of
-      Right list -> "[" ++ intercalate ", " (map decodeResult list) ++ "]"
-      Left _ -> ""
+    Right str -> "\"" ++ str ++ "\""
+    Left _ -> formatResult TreeCalculus tc

test/Spec.hs

@@ -320,17 +320,17 @@ libraryTests = testGroup "Library Tests"
       library <- evaluateFile "./lib/base.tri"
       let input = "test t"
           env = decodeResult $ result $ evalTricu library (parseTricu input)
-      env @?= "Leaf"
+      env @?= "\"Leaf\""
   , testCase "Triage test (Stem Leaf)" $ do
       library <- evaluateFile "./lib/base.tri"
       let input = "test (t t)"
           env = decodeResult $ result $ evalTricu library (parseTricu input)
-      env @?= "Stem"
+      env @?= "\"Stem\""
   , testCase "Triage test (Fork Leaf Leaf)" $ do
       library <- evaluateFile "./lib/base.tri"
       let input = "test (t t t)"
           env = decodeResult $ result $ evalTricu library (parseTricu input)
-      env @?= "Fork"
+      env @?= "\"Fork\""
   , testCase "Boolean NOT: true" $ do
       library <- evaluateFile "./lib/base.tri"
       let input = "not true"
@@ -390,7 +390,7 @@ libraryTests = testGroup "Library Tests"
       library <- evaluateFile "./lib/base.tri"
       let input = "lconcat \"Hello, \" \"world!\""
           env = decodeResult $ result $ evalTricu library (parseTricu input)
-      env @?= "Hello, world!"
+      env @?= "\"Hello, world!\""
   , testCase "Verifying Equality" $ do
       library <- evaluateFile "./lib/base.tri"
       let input = "equal (t t t) (t t t)"
@@ -412,7 +412,7 @@ fileEvaluationTests = testGroup "Evaluation tests"
   , testCase "Eval and decoding string" $ do
       library <- liftIO $ evaluateFile "./lib/base.tri"
       res <- liftIO $ evaluateFileWithContext library "./test/string.tri"
-      decodeResult (result res) @?= "String test!"
+      decodeResult (result res) @?= "\"String test!\""
   ]
 
 propertyTests :: TestTree