From 8c33e5ce66e9afd942bc823f61c950b6bcb58db7 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Thu, 2 Jan 2025 19:08:14 -0600 Subject: [PATCH] Fix critical list evaluation bug and REPL updates --- README.md | 38 +++++++++++++---------------------- src/Eval.hs | 13 ++++++------ src/FileEval.hs | 2 +- src/Lexer.hs | 2 +- src/Main.hs | 4 ++-- src/REPL.hs | 53 +++++++++++++++++++++++++++---------------------- test/Spec.hs | 10 +++++----- 7 files changed, 58 insertions(+), 64 deletions(-) diff --git a/README.md b/README.md index 9cec251..ebb2e9d 100644 --- 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") +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 diff --git a/src/Eval.hs b/src/Eval.hs index 5ebb9f1..0aa1d6b 100644 --- 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 index 040de83..b453eed 100644 --- 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 index 1f9dc9e..0278227 100644 --- 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 index 4ef49ab..63d4eaa 100644 --- 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 index 333fafc..7911e44 100644 --- 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 index 6702862..ffac242 100644 --- 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