James/tricu
1
1
Fork 0
Code Issues 3 Pull Requests Actions Packages Projects Releases 1 Wiki Activity

Fix critical list evaluation bug and REPL updates

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
README.md
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?
```
-- 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

13
src/Eval.hs
View File

@ -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"

2
src/FileEval.hs
View File

@ -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

2
src/Lexer.hs
View File

@ -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

4
src/Main.hs
View File

@ -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

53
src/REPL.hs
View File

@ -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
@ -54,11 +58,12 @@ repl env = runInputT defaultSettings (loop env)
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

10
test/Spec.hs
View File

@ -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