commit 7d97b85f7456e60a4e99181c16dc6c12ad8e58b9
parent 5523d5acdeec0896871d35bbdc1a181d819469f3
Author: James Eversole <james@eversole.co>
Date: Thu, 2 Jan 2025 19:08:14 -0600
Fix critical list evaluation bug and REPL updates
Diffstat:
7 files changed, 59 insertions(+), 65 deletions(-)
diff --git a/README.md b/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")
-
--- 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 < -- 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!"
+
+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
diff --git a/src/Eval.hs b/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"
diff --git a/src/FileEval.hs b/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
diff --git a/src/Lexer.hs b/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
diff --git a/src/Main.hs b/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
diff --git a/src/REPL.hs b/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
diff --git a/test/Spec.hs b/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
