Compare commits

..

No commits in common. "main" and "feat/new-outputs" have entirely different histories.

17 changed files with 210 additions and 270 deletions

17
.gitignore vendored
View File

@ -1,11 +1,14 @@
bin/
data/Purr.sqlite
data/encryptionKey
/result
/config.dhall
/Dockerfile
/docker-stack.yml
.stack-work/
*.swp
*.txt
dist*
*~
.env
.stack-work/
/Dockerfile
/config.dhall
/result
WD
bin/
dist*
*.hs.txt

View File

@ -19,21 +19,31 @@ tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)
## What does it look like?
```
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!"
-- 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 < -- 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"
-- 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!"]
```
## Installation and Use
@ -44,35 +54,33 @@ You can easily build and/or run this project using [Nix](https://nixos.org/downl
- `nix run git+https://git.eversole.co/James/tricu`
- Build executable in `./result/bin`:
- `nix build git+https://git.eversole.co/James/tricu`
`./result/bin/tricu --help`
- `./result/bin/tricu --help`
```
tricu Evaluator and REPL
tricu - compiler and repl
tricu [COMMAND] ... [OPTIONS]
tricu: Exploring Tree Calculus
Common flags:
-? --help Display help message
-V --version Print version information
-? --help Display help message
-V --version Print version information
tricu [repl] [OPTIONS]
Start interactive REPL
tricu eval [OPTIONS]
Evaluate tricu and return the result of the final expression.
tricu compile [OPTIONS]
Compile a file and return the result of the expression in the final line
-f --file=FILE Input file path(s) for evaluation.
Defaults to stdin.
-t --form=FORM Optional output form: (tree|fsl|ast|ternary|ascii).
Defaults to tricu-compatible `t` tree form.
-f --file=FILE Relative or absolute path to file input for compilation
-o --output=OUTPUT Optional output file path for resulting output
-t --form=FORM Output form: (tree|ast|ternary|ascii)
tricu decode [OPTIONS]
Decode a Tree Calculus value into a string representation.
Decode a Tree Calculus value into a string representation
-f --file=FILE Optional input file path to attempt decoding.
Defaults to stdin.
-f --input=FILE Optional file path containing a Tree Calculus value.
Defaults to stdin.
```
## Acknowledgements

View File

@ -1,34 +0,0 @@
-- Level Order Traversal of a labelled binary tree
-- Objective: Print each "level" of the tree on a separate line
--
-- NOTICE: This demo relies on tricu base library functions
--
-- We model labelled binary trees as sublists where values act as labels. We
-- require explicit notation of empty nodes. Empty nodes can be represented
-- with an empty list, `[]`, which is equivalent to a single node `t`.
--
-- Example tree inputs:
-- [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]]
-- Graph:
-- 1
-- / \
-- 2 3
-- / / \
-- 4 5 6
--
isLeaf = (\node : lOr (emptyList node) (emptyList (tail node)))
getLabel = (\node : head node)
getLeft = (\node : if (emptyList node) [] (if (emptyList (tail node)) [] (head (tail node))))
getRight = (\node : if (emptyList node) [] (if (emptyList (tail node)) [] (if (emptyList (tail (tail node))) [] (head (tail (tail node))))))
processLevel = y (\self queue : if (emptyList queue) [] (pair (map getLabel queue) (self (filter (\node : not (emptyList node)) (lconcat (map getLeft queue) (map getRight queue))))))
levelOrderTraversal = (\a : processLevel (t a t))
toLineString = y (\self levels : if (emptyList levels) "" (lconcat (lconcat (map (\x : lconcat x " ") (head levels)) "") (if (emptyList (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels))))))
levelOrderToString = (\s : toLineString (levelOrderTraversal s))
flatten = foldl (\acc x : lconcat acc x) ""
flatLOT = (\s : lconcat (t 10 t) (flatten (levelOrderToString s)))
exampleOne = flatLOT [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]]
exampleTwo = flatLOT [("1") [("2") [("4") [("8") t t] [("9") t t]] [("6") [("10") t t] [("12") t t]]] [("3") [("5") [("11") t t] t] [("7") t t]]]

View File

@ -1,41 +0,0 @@
false = t
_ = t
true = t t
k = t t
i = t (t k) t
s = t (t (k t)) t
m = s i i
b = s (k s) k
c = s (s (k s) (s (k k) s)) (k k)
iC = (\a b c : s a (k c) b)
iD = b (b iC) iC
iE = b (b iD) iC
yi = (\i : b m (c b (i m)))
y = yi iC
yC = yi iD
yD = yi iE
id = (\a : a)
triage = (\a b c : t (t a b) c)
pair = t
matchBool = (\ot of : triage of (\_ : ot) (\_ _ : ot))
matchList = (\oe oc : triage oe _ oc)
matchPair = (\op : triage _ _ op)
not = matchBool false true
and = matchBool id (\z : false)
if = (\cond then else : t (t else (t t then)) t cond)
test = triage "Leaf" (\z : "Stem") (\a b : "Fork")
emptyList = matchList true (\y z : false)
head = matchList t (\hd tl : hd)
tail = matchList t (\hd tl : tl)
lconcat = y (\self : matchList (\k : k) (\h r k : pair h (self r k)))
lAnd = triage (\x : false) (\_ x : x) (\_ _ x : x)
lOr = triage (\x : x) (\_ _ : true) (\_ _ x : true)
hmap = y (\self : matchList (\f : t) (\hd tl f : pair (f hd) (self tl f)))
map = (\f l : hmap l f)
equal = y (\self : triage (triage true (\z : false) (\y z : false)) (\ax : triage false (self ax) (\y z : false)) (\ax ay : triage false (\z : false) (\bx by : lAnd (self ax bx) (self ay by))))
hfilter = y (\self : matchList (\f : t) (\hd tl f : matchBool (t hd) i (f hd) (self tl f)))
filter = (\f l : hfilter l f)
hfoldl = y (\self f l x : matchList (\acc : acc) (\hd tl acc : self f tl (f acc hd)) l x)
foldl = (\f x l : hfoldl f l x)
hfoldr = y (\self x f l : matchList x (\hd tl : f (self x f tl) hd) l)
foldr = (\f x l : hfoldr x f l)

8
shell.nix Normal file
View File

@ -0,0 +1,8 @@
{ pkgs ? import <nixpkgs> {} }:
let x = pkgs.haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
megaparsec
]);
in
pkgs.mkShell {
buildInputs = [ x ];
}

19
src/Compiler.hs Normal file
View File

@ -0,0 +1,19 @@
module Compiler where
import Eval
import Library
import Parser
import Research
import System.IO
import qualified Data.Map as Map
evaluateFile :: FilePath -> IO T
evaluateFile filePath = do
contents <- readFile filePath
let asts = parseTricu contents
let finalEnv = evalTricu library asts
case Map.lookup "__result" finalEnv of
Just finalResult -> return finalResult
Nothing -> error "No result found in final environment"

View File

@ -13,7 +13,7 @@ evalSingle env term = case term of
SFunc name [] body ->
let lineNoLambda = eliminateLambda body
result = evalAST env lineNoLambda
in Map.insert "__result" result (Map.insert name result env)
in Map.insert name result env
SLambda _ body ->
let result = evalAST env body
in Map.insert "__result" result env
@ -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 -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
Nothing -> error $ "Variable " ++ name ++ " not defined"
_ ->
let result = evalAST env term
in Map.insert "__result" result env
@ -46,18 +46,19 @@ evalAST :: Map String T -> TricuAST -> T
evalAST env term = case term of
SVar name -> case Map.lookup name env of
Just value -> value
Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
Nothing -> error $ "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 env) elems)
SList elems -> ofList (map (evalAST Map.empty) elems)
SEmpty -> Leaf
SFunc name args body ->
errorWithoutStackTrace $ "Unexpected function definition " ++ name
SLambda {} -> errorWithoutStackTrace "Internal error: SLambda found in evalAST after elimination."
error $ "Unexpected function definition " ++ name
++ " in evalAST; define via evalSingle."
SLambda {} -> error "Internal error: SLambda found in evalAST after elimination."
eliminateLambda :: TricuAST -> TricuAST
eliminateLambda (SLambda (v:vs) body)
@ -114,4 +115,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 -> errorWithoutStackTrace "No __result field found in provided environment"
Nothing -> error "No __result field found in provided environment"

View File

@ -1,30 +0,0 @@
module FileEval where
import Eval
import Parser
import Research
import System.IO
import qualified Data.Map as Map
evaluateFileResult :: FilePath -> IO T
evaluateFileResult filePath = do
contents <- readFile filePath
let asts = parseTricu contents
let finalEnv = evalTricu Map.empty asts
case Map.lookup "__result" finalEnv of
Just finalResult -> return finalResult
Nothing -> errorWithoutStackTrace "No expressions to evaluate found"
evaluateFile :: FilePath -> IO Env
evaluateFile filePath = do
contents <- readFile filePath
let asts = parseTricu contents
pure $ evalTricu Map.empty asts
evaluateFileWithContext :: Env -> FilePath -> IO Env
evaluateFileWithContext env filePath = do
contents <- readFile filePath
let asts = parseTricu contents
pure $ evalTricu env asts

View File

@ -17,9 +17,7 @@ keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT
identifier :: Lexer LToken
identifier = do
first <- letterChar <|> char '_'
rest <- many (letterChar <|> char '_' <|> char '-' <|> digitChar)
let name = first : rest
name <- some (letterChar <|> char '_' <|> char '-')
if (name == "t" || name == "__result")
then fail "Keywords (`t`, `__result`) cannot be used as an identifier"
else return (LIdentifier name)
@ -33,8 +31,11 @@ stringLiteral :: Lexer LToken
stringLiteral = do
char '"'
content <- many (noneOf ['"'])
char '"' --"
return (LStringLiteral content)
if null content
then fail "Empty string literals are not allowed"
else do
char '"' --"
return (LStringLiteral content)
assign :: Lexer LToken
assign = char '=' *> pure LAssign
@ -90,5 +91,5 @@ tricuLexer = do
lexTricu :: String -> [LToken]
lexTricu input = case runParser tricuLexer "" input of
Left err -> errorWithoutStackTrace $ "Lexical error:\n" ++ errorBundlePretty err
Left err -> error $ "Lexical error:\n" ++ errorBundlePretty err
Right tokens -> tokens

46
src/Library.hs Normal file
View File

@ -0,0 +1,46 @@
module Library where
import Eval
import Parser
import Research
import Data.Map (empty)
library :: Env
library = evalTricu empty $ parseTricu $ unlines
[ "false = t"
, "true = t t"
, "_ = t"
, "k = t t"
, "i = t (t k) t"
, "s = t (t (k t)) t"
, "m = s i i"
, "b = s (k s) k"
, "c = s (s (k s) (s (k k) s)) (k k)"
, "iC = (\\a b c : s a (k c) b)"
, "iD = b (b iC) iC"
, "iE = b (b iD) iC"
, "yi = (\\i : b m (c b (i m)))"
, "y = yi iC"
, "yC = yi iD"
, "yD = yi iE"
, "id = (\\a : a)"
, "triage = (\\a b c : t (t a b) c)"
, "pair = t"
, "matchBool = (\\ot of : triage of (\\_ : ot) (\\_ _ : ot))"
, "matchList = (\\oe oc : triage oe _ oc)"
, "matchPair = (\\op : triage _ _ op)"
, "not = matchBool false true"
, "and = matchBool id (\\z : false)"
, "if = (\\cond then else : t (t else (t t then)) t cond)"
, "test = triage \"Leaf\" (\\z : \"Stem\") (\\a b : \"Fork\")"
, "emptyList = matchList true (\\y z : false)"
, "head = matchList t (\\hd tl : hd)"
, "tail = matchList t (\\hd tl : tl)"
, "lconcat = y (\\self : matchList (\\k : k) (\\h r k : pair h (self r k)))"
, "lAnd = triage (\\x : false) (\\_ x : x) (\\_ _ x : x)"
, "lOr = triage (\\x : x) (\\_ _ : true) (\\_ _ x : true)"
, "hmap = y (\\self : matchList (\\f : t) (\\hd tl f : pair (f hd) (self tl f)))"
, "map = (\\f l : hmap l f)"
, "equal = y (\\self : triage (triage true (\\z : false) (\\y z : false)) (\\ax : triage false (self ax) (\\y z : false)) (\\ax ay : triage false (\\z : false) (\\bx by : lAnd (self ax bx) (self ay by))))"
]

View File

@ -1,13 +1,12 @@
module Main where
import Compiler
import Eval (evalTricu, result)
import FileEval
import Library (library)
import Parser (parseTricu)
import REPL
import Research
import Control.Monad (foldM)
import Control.Monad.IO.Class (liftIO)
import Text.Megaparsec (runParser)
import System.Console.CmdArgs
@ -15,8 +14,8 @@ import qualified Data.Map as Map
data TricuArgs
= Repl
| Evaluate { file :: [FilePath], form :: EvaluatedForm }
| Decode { file :: [FilePath] }
| Compile { file :: FilePath, output :: Maybe FilePath, form :: CompiledForm }
| Decode { input :: Maybe FilePath }
deriving (Show, Data, Typeable)
replMode :: TricuArgs
@ -25,60 +24,51 @@ replMode = Repl
&= auto
&= name "repl"
evaluateMode :: TricuArgs
evaluateMode = Evaluate
{ file = def &= help "Input file path(s) for evaluation.\n \
\ Defaults to stdin."
&= name "f" &= typ "FILE"
, form = TreeCalculus &= typ "FORM"
&= help "Optional output form: (tree|fsl|ast|ternary|ascii).\n \
\ Defaults to tricu-compatible `t` tree form."
compileMode :: TricuArgs
compileMode = Compile
{ file = def &= typ "FILE"
&= help "Relative or absolute path to file input for compilation" &= name "f"
, output = def &= typ "OUTPUT"
&= help "Optional output file path for resulting output" &= name "o"
, form = FSL &= typ "FORM"
&= help "Output form: (fsl|tree|ast|ternary|ascii)"
&= name "t"
}
&= help "Evaluate tricu and return the result of the final expression."
&= help "Compile a file and return the result of the expression in the final line"
&= explicit
&= name "eval"
&= name "compile"
decodeMode :: TricuArgs
decodeMode = Decode
{ file = def
&= help "Optional input file path to attempt decoding.\n \
\ Defaults to stdin."
&= name "f" &= typ "FILE"
{ input = def &= typ "FILE"
&= help "Optional file path containing a Tree Calculus value. Defaults to stdin." &= name "f"
}
&= help "Decode a Tree Calculus value into a string representation."
&= help "Decode a Tree Calculus value into a string representation"
&= explicit
&= name "decode"
main :: IO ()
main = do
args <- cmdArgs $ modes [replMode, evaluateMode, decodeMode]
args <- cmdArgs $ modes [replMode, compileMode, decodeMode]
&= help "tricu: Exploring Tree Calculus"
&= program "tricu"
&= summary "tricu Evaluator and REPL"
&= summary "tricu - compiler and repl"
case args of
Repl -> 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 $ Map.delete "__result" library
Evaluate { file = filePaths, form = form } -> do
result <- case filePaths of
[] -> do
t <- getContents
pure $ runTricu t
(filePath:restFilePaths) -> do
initialEnv <- evaluateFile filePath
finalEnv <- foldM evaluateFileWithContext initialEnv restFilePaths
pure $ result finalEnv
repl library
Compile { file = filePath, output = maybeOutputPath, form = form } -> do
result <- evaluateFile filePath
let fRes = formatResult form result
putStr fRes
Decode { file = filePaths } -> do
value <- case filePaths of
[] -> getContents
(filePath:_) -> readFile filePath
library <- liftIO $ evaluateFile "./lib/base.tri"
case maybeOutputPath of
Just outputPath -> do
writeFile outputPath fRes
putStrLn $ "Output to: " ++ outputPath
Nothing -> putStr fRes
Decode { input = maybeInputPath } -> do
value <- case maybeInputPath of
Just inputPath -> readFile inputPath
Nothing -> getContents
putStrLn $ decodeResult $ result $ evalTricu library $ parseTricu value
runTricu :: String -> T
runTricu = result . evalTricu Map.empty . parseTricu

View File

@ -54,9 +54,16 @@ parseFunction = do
parseAtomicBase :: Parser TricuAST
parseAtomicBase = choice
[ parseTreeLeaf
[ try parseVarWithoutAssignment
, parseTreeLeaf
, parseGrouped
]
parseVarWithoutAssignment :: Parser TricuAST
parseVarWithoutAssignment = do
LIdentifier name <- satisfy isIdentifier
if (name == "t" || name == "__result")
then fail $ "Reserved keyword: " ++ name ++ " cannot be assigned."
else notFollowedBy (satisfy (== LAssign)) *> return (SVar name)
parseLambda :: Parser TricuAST
parseLambda = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) $ do

View File

@ -1,15 +1,13 @@
module REPL where
import Eval
import FileEval
import Lexer
import Parser
import Research
import Control.Exception (SomeException, catch)
import Control.Monad.IO.Class (liftIO)
import Data.Char (isSpace)
import Data.List (dropWhile, dropWhileEnd, intercalate)
import Data.List (intercalate)
import System.Console.Haskeline
import qualified Data.Map as Map
@ -21,27 +19,14 @@ repl env = runInputT defaultSettings (loop env)
loop env = do
minput <- getInputLine "tricu < "
case minput of
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
Nothing -> outputStrLn "Goodbye!"
Just ":_exit" -> outputStrLn "Goodbye!"
Just "" -> do
outputStrLn ""
loop env
Just input -> do
newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
loop newEnv
processInput :: Env -> String -> IO Env
processInput env input = do
@ -49,7 +34,8 @@ repl env = runInputT defaultSettings (loop env)
newEnv = evalTricu env asts
case Map.lookup "__result" newEnv of
Just r -> do
putStrLn $ "tricu > " ++ decodeResult r
putStrLn $ "tricu > " ++ show r
putStrLn $ "READ -: \"" ++ decodeResult r ++ "\""
Nothing -> return ()
return newEnv
@ -57,15 +43,12 @@ 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 ++ "\""
Right str -> str
Left _ -> case toList tc of
Right list -> "[" ++ intercalate ", " (map decodeResult list) ++ "]"
Left _ -> formatResult TreeCalculus tc
Left _ -> ""

View File

@ -45,7 +45,7 @@ data LToken
deriving (Show, Eq, Ord)
-- Output formats
data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii
data CompiledForm = TreeCalculus | FSL | AST | Ternary | Ascii
deriving (Show, Data, Typeable)
-- Environment containing previously evaluated TC terms
@ -122,7 +122,7 @@ toList (Fork x rest) = case toList rest of
toList _ = Left "Invalid Tree Calculus list"
-- Outputs
formatResult :: EvaluatedForm -> T -> String
formatResult :: CompiledForm -> T -> String
formatResult TreeCalculus = toSimpleT . show
formatResult FSL = show
formatResult AST = show . toAST

View File

@ -1,8 +1,9 @@
module Main where
import Compiler
import Eval
import FileEval
import Lexer
import Library
import Parser
import REPL
import Research
@ -30,7 +31,7 @@ tests = testGroup "Tricu Tests"
, evaluationTests
, lambdaEvalTests
, libraryTests
, fileEvaluationTests
, compilerTests
, propertyTests
]
@ -53,7 +54,7 @@ lexerTests = testGroup "Lexer Tests"
expect = Right [LKeywordT, LStringLiteral "string", LIntegerLiteral 42]
runParser tricuLexer "" input @?= expect
, testCase "Lex invalid token" $ do
let input = "&invalid"
let input = "$invalid"
case runParser tricuLexer "" input of
Left _ -> return ()
Right _ -> assertFailure "Expected lexer to fail on invalid token"
@ -287,132 +288,109 @@ lambdaEvalTests = testGroup "Lambda Evaluation Tests"
libraryTests :: TestTree
libraryTests = testGroup "Library Tests"
[ testCase "K combinator 1" $ do
library <- evaluateFile "./lib/base.tri"
let input = "k (t) (t t)"
env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "K combinator 2" $ do
library <- evaluateFile "./lib/base.tri"
let input = "k (t t) (t)"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "K combinator 3" $ do
library <- evaluateFile "./lib/base.tri"
let input = "k (t t t) (t)"
env = evalTricu library (parseTricu input)
result env @?= Fork Leaf Leaf
, testCase "S combinator" $ do
library <- evaluateFile "./lib/base.tri"
let input = "s (t) (t) (t)"
env = evalTricu library (parseTricu input)
result env @?= Fork Leaf (Stem Leaf)
, testCase "SKK == I (fully expanded)" $ do
library <- evaluateFile "./lib/base.tri"
let input = "s k k"
env = evalTricu library (parseTricu input)
result env @?= Fork (Stem (Stem Leaf)) (Stem Leaf)
, testCase "I combinator" $ do
library <- evaluateFile "./lib/base.tri"
let input = "i not"
env = evalTricu library (parseTricu input)
result env @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) (Fork Leaf (Fork Leaf Leaf))
, testCase "Triage test Leaf" $ do
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"
env = result $ evalTricu library (parseTricu input)
env @?= Leaf
, testCase "Boolean NOT: false" $ do
library <- evaluateFile "./lib/base.tri"
let input = "not false"
env = result $ evalTricu library (parseTricu input)
env @?= Stem Leaf
, testCase "Boolean AND TF" $ do
library <- evaluateFile "./lib/base.tri"
let input = "and (t t) (t)"
env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "Boolean AND FT" $ do
library <- evaluateFile "./lib/base.tri"
let input = "and (t) (t t)"
env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "Boolean AND FF" $ do
library <- evaluateFile "./lib/base.tri"
let input = "and (t) (t)"
env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "Boolean AND TT" $ do
library <- evaluateFile "./lib/base.tri"
let input = "and (t t) (t t)"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "List head" $ do
library <- evaluateFile "./lib/base.tri"
let input = "head [(t) (t t) (t t t)]"
env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "List tail" $ do
library <- evaluateFile "./lib/base.tri"
let input = "head (tail (tail [(t) (t t) (t t t)]))"
env = evalTricu library (parseTricu input)
result env @?= Fork Leaf Leaf
, testCase "List map" $ do
library <- evaluateFile "./lib/base.tri"
let input = "head (tail (map (\\a : (t t t)) [(t) (t) (t)]))"
env = evalTricu library (parseTricu input)
result env @?= Fork Leaf Leaf
, testCase "Empty list check" $ do
library <- evaluateFile "./lib/base.tri"
let input = "emptyList []"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "Non-empty list check" $ do
library <- evaluateFile "./lib/base.tri"
let input = "not (emptyList [(1) (2) (3)])"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "Concatenate strings" $ do
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)"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
]
fileEvaluationTests :: TestTree
fileEvaluationTests = testGroup "Evaluation tests"
compilerTests :: TestTree
compilerTests = testGroup "Compiler tests"
[ testCase "Forks" $ do
res <- liftIO $ evaluateFileResult "./test/fork.tri"
res <- liftIO $ evaluateFile "./test/fork.tri"
res @?= Fork Leaf Leaf
, testCase "File ends with comment" $ do
res <- liftIO $ evaluateFileResult "./test/comments-1.tri"
res <- liftIO $ evaluateFile "./test/comments-1.tri"
res @?= Fork (Stem Leaf) Leaf
, testCase "Mapping and Equality" $ do
res <- liftIO $ evaluateFileResult "./test/map.tri"
res <- liftIO $ evaluateFile "./test/map.tri"
res @?= Stem Leaf
, testCase "Eval and decoding string" $ do
library <- liftIO $ evaluateFile "./lib/base.tri"
res <- liftIO $ evaluateFileWithContext library "./test/string.tri"
decodeResult (result res) @?= "\"String test!\""
, testCase "Map evaluation to String -> compilation -> string decoding" $ do
res <- liftIO $ evaluateFile "./test/string.tri"
decodeResult res @?= "String test!"
]
propertyTests :: TestTree

View File

@ -1 +0,0 @@
x = t (t t) t

View File

@ -1,7 +1,7 @@
cabal-version: 1.12
name: tricu
version: 0.5.0
version: 0.4.0
description: A micro-language for exploring Tree Calculus
author: James Eversole
maintainer: james@eversole.co
@ -29,9 +29,10 @@ executable tricu
, mtl
, text
other-modules:
Compiler
Eval
FileEval
Lexer
Library
Parser
REPL
Research
@ -57,9 +58,10 @@ test-suite tricu-tests
, text
default-language: Haskell2010
other-modules:
Compiler
Eval
FileEval
Lexer
Library
Parser
REPL
Research