Fix critical list evaluation bug and REPL updates

This commit is contained in:
James Eversole 2025-01-02 19:08:14 -06:00
parent 76487b15f9
commit 8c33e5ce66
7 changed files with 58 additions and 64 deletions

View File

@ -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? ## What does it look like?
``` ```
-- Anything after `--` on a single line is a comment tricu < -- Anything after `--` on a single line is a comment
-- We can define functions or "variables" as Tree Calculus values tricu < id = (\a : a) -- Lambda abstraction is eliminated to tree calculus terms
false = t tricu < head (map (\i : lconcat i " world!") [("Hello, ")])
_ = t tricu > "Hello, world!"
true = t t tricu < id (head (map (\i : lconcat i " world!") [("Hello, ")]))
-- We can define functions as lambda expressions that are eliminated to Tree tricu > "Hello, world!"
-- 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 < -- Intensionality! We can inspect the structure of a function.
-- `tricu <` is the input prompt tricu < triage = (\a b c : t (t a b) c)
-- `tricu >` is the Tree Calculus form output. Most are elided below. tricu < test = triage "Leaf" (\z : "Stem") (\a b : "Fork")
-- `READ -:` is an attempt to interpret the TC output as strings/numbers. tricu < test t t
tricu < test t tricu > "Stem"
tricu > Fork (Fork Leaf (Fork ...) ... ) tricu < -- We can even write a function to convert a function to source code
READ -: "Leaf" tricu < toTString id
tricu < test (t t) tricu > "t (t (t 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!"]
``` ```
## Installation and Use ## Installation and Use

View File

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

View File

@ -15,7 +15,7 @@ evaluateFileResult filePath = do
let finalEnv = evalTricu Map.empty asts let finalEnv = evalTricu Map.empty asts
case Map.lookup "__result" finalEnv of case Map.lookup "__result" finalEnv of
Just finalResult -> return finalResult 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 -> IO Env
evaluateFile filePath = do evaluateFile filePath = do

View File

@ -90,5 +90,5 @@ tricuLexer = do
lexTricu :: String -> [LToken] lexTricu :: String -> [LToken]
lexTricu input = case runParser tricuLexer "" input of 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 Right tokens -> tokens

View File

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

View File

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

View File

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