4 Commits

Author SHA1 Message Date
918d929c09 # File eval mode now relies on main function
All checks were successful
Test, Build, and Release / test (push) Successful in 1m26s
Test, Build, and Release / build (push) Successful in 1m15s
To encourage organizing code in a way that helps in understanding, I
have implemented the common idiom of requiring a `main` function. In
tricu and other functional languages, it is usually placed near the top
of the module. The evaluator gracefully handles the situation of passing
multiple files where the intermediary "library" files do not have main functions.
2025-01-26 15:33:12 -06:00
a64b3f0829 Definition dependency analysis
All checks were successful
Test, Build, and Release / test (push) Successful in 1m34s
Test, Build, and Release / build (push) Successful in 1m21s
tricu now allows defining terms in any order and will resolve
dependencies to ensure that they're evaluated in the right order.
Undefined terms are detected and throw errors during dependency
ordering.
For now we can't define top-level mutually recursive terms.
2025-01-26 14:50:39 -06:00
e2621bc09d Allow lambda expressions without explicit paren
All checks were successful
Test, Build, and Release / test (push) Successful in 1m41s
Test, Build, and Release / build (push) Successful in 1m19s
2025-01-26 08:52:28 -06:00
ea128929da Add optimization cases for triage and composition 2025-01-25 15:12:28 -06:00
20 changed files with 294 additions and 237 deletions

View File

@ -55,15 +55,11 @@ jobs:
chmod 755 ./tricu
nix develop --command upx ./tricu
- name: Setup go for release action
uses: actions/setup-go@v5
with:
go-version: '>=1.20.1'
- name: Release binary
uses: https://gitea.com/actions/release-action@main
uses: akkuman/gitea-release-action@v1
with:
files: |-
./tricu
api_key: '${{ secrets.RELEASE_TOKEN }}'
token: '${{ secrets.RELEASE_TOKEN }}'
body: '${{ gitea.event.head_commit.message }}'
pre_release: true

View File

@ -2,7 +2,7 @@
## Introduction
tricu (pronounced "tree-shoe") is a purely functional interpreted language implemented in Haskell. It is fundamentally based on the application of [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf) terms, but minimal syntax sugar is included to provide a useful programming tool.
tricu (pronounced "tree-shoe") is a purely functional interpreted language implemented in Haskell. It is fundamentally based on the application of [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf) terms, but minimal syntax sugar is included to provide a useful programming tool. tricu is under active development and you can expect breaking changes with nearly every commit.
tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)`.
@ -71,7 +71,7 @@ tricu eval [OPTIONS]
-f --file=FILE Input file path(s) for evaluation.
Defaults to stdin.
-t --form=FORM Optional output form: (tree|fsl|ast|ternary|ascii).
-t --form=FORM Optional output form: (tree|fsl|ast|ternary|ascii|decode).
Defaults to tricu-compatible `t` tree form.
tricu decode [OPTIONS]

View File

@ -1,3 +1,5 @@
main = lambdaEqualsTC
-- We represent `false` with a Leaf and `true` with a Stem Leaf
demo_false = t
demo_true = t t
@ -6,7 +8,7 @@ demo_true = t t
not_TC? = t (t (t t) (t t t)) (t t (t t t))
-- /demos/toSource.tri contains an explanation of `triage`
demo_triage = (\a b c : t (t a b) c)
demo_triage = \a b c : t (t a b) c
demo_matchBool = (\ot of : demo_triage
of
(\_ : ot)

View File

@ -1,11 +1,10 @@
main = exampleTwo
-- 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 not?ation of empty nodes. Empty nodes can be represented
-- with an empty list, `[]`, which is equivalent to a single node `t`.
-- We model labelled binary trees as nested lists where values act as labels. We
-- require explicit notation of empty nodes. Empty nodes can be represented
-- with an empty list, `[]`, which evaluates to a single node `t`.
--
-- Example tree inputs:
-- [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]]
@ -15,9 +14,8 @@
-- 2 3
-- / / \
-- 4 5 6
--
label = (\node : head node)
label = \node : head node
left = (\node : if (emptyList? node)
[]
@ -39,7 +37,7 @@ processLevel = y (\self queue : if (emptyList? queue)
(\node : not? (emptyList? node))
(lconcat (map left queue) (map right queue))))))
levelOrderTraversal_ = (\a : processLevel (t a t))
levelOrderTraversal_ = \a : processLevel (t a t)
toLineString = y (\self levels : if (emptyList? levels)
""
@ -47,11 +45,11 @@ toLineString = y (\self levels : if (emptyList? levels)
(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))
levelOrderToString = \s : toLineString (levelOrderTraversal_ s)
flatten = foldl (\acc x : lconcat acc x) ""
levelOrderTraversal = (\s : lconcat (t 10 t) (flatten (levelOrderToString s)))
levelOrderTraversal = \s : lconcat (t 10 t) (flatten (levelOrderToString s))
exampleOne = levelOrderTraversal [("1")
[("2") [("4") t t] t]
@ -61,5 +59,3 @@ exampleTwo = levelOrderTraversal [("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]]]
exampleTwo

View File

@ -1,4 +1,6 @@
compose = (\f g x : f (g x))
main = size size
compose = \f g x : f (g x)
succ = y (\self :
triage
@ -17,5 +19,3 @@ size = (\x :
self
(\x y : compose (self x) (self y))
x)) x 0))
size size

View File

@ -1,3 +1,4 @@
main = toSource not?
-- Thanks to intensionality, we can inspect the structure of a given value
-- even if it's a function. This includes lambdas which are eliminated to
-- Tree Calculus (TC) terms during evaluation.
@ -40,7 +41,7 @@ toSource_ = y (\self arg :
arg) -- The term to be inspected
-- toSource takes a single TC term and returns a String
toSource = (\v : toSource_ v "")
toSource = \v : toSource_ v ""
exampleOne = toSource true -- OUT: "(t t)"
exampleTwo = toSource not? -- OUT: "(t (t (t t) (t t t)) (t t (t t t)))"

View File

@ -7,18 +7,15 @@ 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)
id = \a : a
pair = t
if = (\cond then else : t (t else (t t then)) t cond)
if = \cond then else : t (t else (t t then)) t cond
triage = (\leaf stem fork : t (t leaf stem) fork)
y = ((\mut wait fun : wait mut (\x : fun (wait mut x)))
(\x : x x)
(\a0 a1 a2 : t (t a0) (t t a2) a1))
triage = \leaf stem fork : t (t leaf stem) fork
test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork")
matchBool = (\ot of : triage
@ -27,17 +24,9 @@ matchBool = (\ot of : triage
(\_ _ : ot)
)
matchList = (\oe oc : triage
oe
_
oc
)
matchList = \a b : triage a _ b
matchPair = (\op : triage
_
_
op
)
matchPair = \a : triage _ _ a
not? = matchBool false true
and? = matchBool id (\_ : false)
@ -53,20 +42,18 @@ lconcat = y (\self : matchList
lAnd = (triage
(\_ : false)
(\_ x : x)
(\_ _ x : x)
)
(\_ _ x : x))
lOr = (triage
(\x : x)
(\_ _ : true)
(\_ _ _ : true)
)
(\_ _ _ : true))
map_ = y (\self :
matchList
(\_ : t)
(\head tail f : pair (f head) (self tail f)))
map = (\f l : map_ l f)
map = \f l : map_ l f
equal? = y (\self : triage
(triage
@ -87,10 +74,10 @@ equal? = y (\self : triage
filter_ = y (\self : matchList
(\_ : t)
(\head tail f : matchBool (t head) i (f head) (self tail f)))
filter = (\f l : filter_ l f)
filter = \f l : filter_ l f
foldl_ = y (\self f l x : matchList (\acc : acc) (\head tail acc : self f tail (f acc head)) l x)
foldl = (\f x l : foldl_ f l x)
foldl = \f x l : foldl_ f l x
foldr_ = y (\self x f l : matchList x (\head tail : f (self x f tail) head) l)
foldr = (\f x l : foldr_ x f l)
foldr = \f x l : foldr_ x f l

View File

@ -3,14 +3,14 @@ module Eval where
import Parser
import Research
import Data.List (partition)
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set
evalSingle :: Env -> TricuAST -> Env
evalSingle env term
| SFunc name [] body <- term =
| SDef name [] body <- term =
if
| Map.member name env ->
errorWithoutStackTrace $
@ -23,17 +23,22 @@ evalSingle env term
in Map.insert "__result" res env
| SVar name <- term =
case Map.lookup name env of
Just v -> Map.insert "__result" v env
Nothing -> errorWithoutStackTrace $ "Variable `" ++ name ++ "` not defined"
Just v ->
Map.insert "__result" v env
Nothing ->
errorWithoutStackTrace $ "Variable `" ++ name ++ "` not defined\n\
\This error should never occur here. Please report this as an issue."
| otherwise =
Map.insert "__result" (evalAST env term) env
evalTricu :: Env -> [TricuAST] -> Env
evalTricu env [] = env
evalTricu env [x] =
evalTricu env x = go env (reorderDefs env x)
where
go env [] = env
go env [x] =
let updatedEnv = evalSingle env x
in Map.insert "__result" (result updatedEnv) updatedEnv
evalTricu env (x:xs) =
go env (x:xs) =
evalTricu (evalSingle env x) xs
evalAST :: Env -> TricuAST -> T
@ -54,13 +59,24 @@ evalAST env term
(errorWithoutStackTrace $ "Variable " ++ name ++ " not defined")
name env
-- https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf
-- Chapter 4: Lambda-Abstraction
elimLambda :: TricuAST -> TricuAST
elimLambda = go
where
-- η-reduction
go (SLambda [v] (SApp f (SVar x)))
| v == x && not (isFree v f) = elimLambda f
-- Triage optimization
go (SLambda [a] (SLambda [b] (SLambda [c] body)))
| body == triageBody = _TRIAGE
where
triageBody =
(SApp (SApp TLeaf (SApp (SApp TLeaf (SVar a)) (SVar b))) (SVar c))
-- Composition optimization
go (SLambda [f] (SLambda [g] (SLambda [x] body)))
| body == composeBody = _COMPOSE
where
composeBody = SApp (SVar f) (SApp (SVar g) (SVar x))
-- General elimination
go (SLambda (v:vs) body)
| null vs = toSKI v (elimLambda body)
| otherwise = elimLambda (SLambda [v] (SLambda vs body))
@ -75,24 +91,96 @@ elimLambda = go
| otherwise = SApp (SApp _S (toSKI x n)) (toSKI x u)
toSKI x t
| not (isFree x t) = SApp _K t
| otherwise = errorWithoutStackTrace "Unhandled toSKI conversion"
_S = parseSingle "t (t (t t t)) t"
_K = parseSingle "t t"
_I = parseSingle "t (t (t t)) t"
_TRIAGE = parseSingle "t (t (t t (t (t (t t t))))) t"
_COMPOSE = parseSingle "t (t (t t (t (t (t t t)) t))) (t t)"
isFree :: String -> TricuAST -> Bool
isFree x = Set.member x . freeVars
freeVars :: TricuAST -> Set.Set String
freeVars (SVar v ) = Set.singleton v
freeVars (SInt _ ) = Set.empty
freeVars (SStr _ ) = Set.empty
freeVars (SList s ) = foldMap freeVars s
freeVars (SApp f a ) = freeVars f <> freeVars a
freeVars (TLeaf ) = Set.empty
freeVars (SFunc _ _ b) = freeVars b
freeVars (SDef _ _ b) = freeVars b
freeVars (TStem t ) = freeVars t
freeVars (TFork l r ) = freeVars l <> freeVars r
freeVars (SLambda v b ) = foldr Set.delete (freeVars b) v
reorderDefs :: Env -> [TricuAST] -> [TricuAST]
reorderDefs env defs
| not (null missingDeps) =
errorWithoutStackTrace $
"Missing dependencies detected: " ++ show missingDeps
| otherwise = orderedDefs ++ others
where
(defsOnly, others) = partition isDef defs
graph = buildDepGraph defsOnly
sortedDefs = sortDeps graph
defMap = Map.fromList [(name, def) | def@(SDef name _ _) <- defsOnly]
orderedDefs = map (\name -> defMap Map.! name) sortedDefs
topDefNames = Set.fromList (Map.keys defMap)
envNames = Set.fromList (Map.keys env)
freeVarsDefs = foldMap (\(SDef _ _ body) -> freeVars body) defsOnly
freeVarsOthers = foldMap freeVars others
allFreeVars = freeVarsDefs <> freeVarsOthers
validNames = topDefNames `Set.union` envNames
missingDeps = Set.toList (allFreeVars `Set.difference` validNames)
isDef (SDef _ _ _) = True
isDef _ = False
buildDepGraph :: [TricuAST] -> Map.Map String (Set.Set String)
buildDepGraph topDefs
| not (null duplicateNames) =
errorWithoutStackTrace $
"Duplicate definitions detected: " ++ show duplicateNames
| otherwise =
Map.fromList
[ (name, depends topDefs (SDef name [] body))
| SDef name _ body <- topDefs]
where
names = [name | SDef name _ _ <- topDefs]
duplicateNames =
[ name | (name, count) <- Map.toList (countOccurrences names) , count > 1]
countOccurrences = foldr (\x -> Map.insertWith (+) x 1) Map.empty
sortDeps :: Map.Map String (Set.Set String) -> [String]
sortDeps graph = go [] (Map.keys graph)
where
go sorted [] = sorted
go sorted remaining
| null ready =
errorWithoutStackTrace
"ERROR: Top-level cyclic dependency detected and prohibited\n\
\RESOLVE: Use nested lambdas"
| otherwise = go (sorted ++ ready) notReady
where
ready = [ name | name <- remaining
, all (`elem` sorted) (Set.toList (graph Map.! name))]
notReady =
[ name | name <- remaining , name `notElem` ready]
depends :: [TricuAST] -> TricuAST -> Set.Set String
depends topDefs (SDef _ _ body) =
Set.intersection
(Set.fromList [n | SDef n _ _ <- topDefs])
(freeVars body)
depends _ _ = Set.empty
result :: Env -> T
result r = case Map.lookup "__result" r of
Just a -> a
Nothing -> errorWithoutStackTrace "No __result field found in provided environment"
Nothing -> errorWithoutStackTrace "No __result field found in provided env"
mainResult :: Env -> T
mainResult r = case Map.lookup "main" r of
Just a -> a
Nothing -> errorWithoutStackTrace "No valid definition for `main` found."

View File

@ -13,9 +13,9 @@ evaluateFileResult filePath = do
contents <- readFile filePath
let asts = parseTricu contents
let finalEnv = evalTricu Map.empty asts
case Map.lookup "__result" finalEnv of
case Map.lookup "main" finalEnv of
Just finalResult -> return finalResult
Nothing -> errorWithoutStackTrace "No expressions to evaluate found"
Nothing -> errorWithoutStackTrace "No `main` function detected"
evaluateFile :: FilePath -> IO Env
evaluateFile filePath = do

View File

@ -1,6 +1,6 @@
module Main where
import Eval (evalTricu, result)
import Eval (evalTricu, mainResult, result)
import FileEval
import Parser (parseTricu)
import REPL
@ -16,7 +16,7 @@ import qualified Data.Map as Map
data TricuArgs
= Repl
| Evaluate { file :: [FilePath], form :: EvaluatedForm }
| Decode { file :: [FilePath] }
| TDecode { file :: [FilePath] }
deriving (Show, Data, Typeable)
replMode :: TricuArgs
@ -31,7 +31,7 @@ evaluateMode = Evaluate
\ Defaults to stdin."
&= name "f" &= typ "FILE"
, form = TreeCalculus &= typ "FORM"
&= help "Optional output form: (tree|fsl|ast|ternary|ascii).\n \
&= help "Optional output form: (tree|fsl|ast|ternary|ascii|decode).\n \
\ Defaults to tricu-compatible `t` tree form."
&= name "t"
}
@ -40,7 +40,7 @@ evaluateMode = Evaluate
&= name "eval"
decodeMode :: TricuArgs
decodeMode = Decode
decodeMode = TDecode
{ file = def
&= help "Optional input file path to attempt decoding.\n \
\ Defaults to stdin."
@ -70,10 +70,10 @@ main = do
(filePath:restFilePaths) -> do
initialEnv <- evaluateFile filePath
finalEnv <- foldM evaluateFileWithContext initialEnv restFilePaths
pure $ result finalEnv
pure $ mainResult finalEnv
let fRes = formatResult form result
putStr fRes
Decode { file = filePaths } -> do
TDecode { file = filePaths } -> do
value <- case filePaths of
[] -> getContents
(filePath:_) -> readFile filePath

View File

@ -85,13 +85,10 @@ scnParserM :: ParserM ()
scnParserM = skipMany $ do
t <- lookAhead anySingle
st <- get
if | (parenDepth st > 0 || bracketDepth st > 0) && case t of
LNewline -> True
_ -> False -> void $ satisfyM $ \case
LNewline -> True
_ -> False
| otherwise -> fail "In nested context or no space token" <|> empty
if | (parenDepth st > 0 || bracketDepth st > 0) && (t == LNewline) ->
void $ satisfyM (== LNewline)
| otherwise ->
fail "In nested context or no space token" <|> empty
eofM :: ParserM ()
eofM = lift eof
@ -109,32 +106,23 @@ parseExpressionM = choice
parseFunctionM :: ParserM TricuAST
parseFunctionM = do
LIdentifier name <- satisfyM $ \case
LIdentifier _ -> True
_ -> False
args <- many $ satisfyM $ \case
LIdentifier _ -> True
_ -> False
let ident = (\case LIdentifier _ -> True; _ -> False)
LIdentifier name <- satisfyM ident
args <- many $ satisfyM ident
_ <- satisfyM (== LAssign)
scnParserM
body <- parseExpressionM
pure (SFunc name (map getIdentifier args) body)
pure (SDef name (map getIdentifier args) body)
parseLambdaM :: ParserM TricuAST
parseLambdaM =
between (satisfyM (== LOpenParen)) (satisfyM (== LCloseParen)) $ do
parseLambdaM = do
let ident = (\case LIdentifier _ -> True; _ -> False)
_ <- satisfyM (== LBackslash)
param <- satisfyM $ \case
LIdentifier _ -> True
_ -> False
rest <- many $ satisfyM $ \case
LIdentifier _ -> True
_ -> False
params <- some (satisfyM ident)
_ <- satisfyM (== LColon)
scnParserM
body <- parseLambdaExpressionM
let nested = foldr (\v acc -> SLambda [getIdentifier v] acc) body rest
pure (SLambda [getIdentifier param] nested)
pure $ foldr (\param acc -> SLambda [getIdentifier param] acc) body params
parseLambdaExpressionM :: ParserM TricuAST
parseLambdaExpressionM = choice
@ -180,9 +168,8 @@ parseAtomicBaseM = choice
parseTreeLeafM :: ParserM TricuAST
parseTreeLeafM = do
_ <- satisfyM $ \case
LKeywordT -> True
_ -> False
let keyword = (\case LKeywordT -> True; _ -> False)
_ <- satisfyM keyword
notFollowedBy $ lift $ satisfy (== LAssign)
pure TLeaf
@ -248,37 +235,38 @@ parseGroupedItemM = do
parseSingleItemM :: ParserM TricuAST
parseSingleItemM = do
token <- satisfyM $ \case
LIdentifier _ -> True
LKeywordT -> True
_ -> False
case token of
LIdentifier name -> pure (SVar name)
LKeywordT -> pure TLeaf
_ -> fail "Unexpected token in list item"
token <- satisfyM (\case LIdentifier _ -> True; LKeywordT -> True; _ -> False)
if | LIdentifier name <- token -> pure (SVar name)
| token == LKeywordT -> pure TLeaf
| otherwise -> fail "Unexpected token in list item"
parseVarM :: ParserM TricuAST
parseVarM = do
LIdentifier name <- satisfyM $ \case
LIdentifier _ -> True
_ -> False
if name == "t" || name == "__result"
then fail ("Reserved keyword: " ++ name ++ " cannot be assigned.")
else pure (SVar name)
satisfyM (\case LIdentifier _ -> True; _ -> False) >>= \case
LIdentifier name
| name == "t" || name == "__result" ->
fail ("Reserved keyword: " ++ name ++ " cannot be assigned.")
| otherwise ->
pure (SVar name)
_ -> fail "Unexpected token while parsing variable"
parseIntLiteralM :: ParserM TricuAST
parseIntLiteralM = do
LIntegerLiteral value <- satisfyM $ \case
LIntegerLiteral _ -> True
_ -> False
let intL = (\case LIntegerLiteral _ -> True; _ -> False)
token <- satisfyM intL
if | LIntegerLiteral value <- token ->
pure (SInt value)
| otherwise ->
fail "Unexpected token while parsing integer literal"
parseStrLiteralM :: ParserM TricuAST
parseStrLiteralM = do
LStringLiteral value <- satisfyM $ \case
LStringLiteral _ -> True
_ -> False
let strL = (\case LStringLiteral _ -> True; _ -> False)
token <- satisfyM strL
if | LStringLiteral value <- token ->
pure (SStr value)
| otherwise ->
fail "Unexpected token while parsing string literal"
getIdentifier :: LToken -> String
getIdentifier (LIdentifier name) = name

View File

@ -59,10 +59,3 @@ repl env = runInputT defaultSettings (loop env)
strip :: String -> String
strip = dropWhileEnd isSpace . dropWhile isSpace
decodeResult :: T -> String
decodeResult tc
| Right num <- toNumber tc = show num
| Right str <- toString tc = "\"" ++ str ++ "\""
| Right list <- toList tc = "[" ++ intercalate ", " (map decodeResult list) ++ "]"
| otherwise = formatResult TreeCalculus tc

View File

@ -19,7 +19,7 @@ data TricuAST
| SInt Int
| SStr String
| SList [TricuAST]
| SFunc String [String] TricuAST
| SDef String [String] TricuAST
| SApp TricuAST TricuAST
| TLeaf
| TStem TricuAST
@ -45,7 +45,7 @@ data LToken
deriving (Show, Eq, Ord)
-- Output formats
data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii
data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii | Decode
deriving (Show, Data, Typeable)
-- Environment containing previously evaluated TC terms
@ -115,6 +115,7 @@ formatResult FSL = show
formatResult AST = show . toAST
formatResult Ternary = toTernaryString
formatResult Ascii = toAscii
formatResult Decode = decodeResult
toSimpleT :: String -> String
toSimpleT s = T.unpack
@ -147,4 +148,9 @@ toAscii tree = go tree "" True
++ go left (prefix ++ (if isLast then " " else "| ")) False
++ go right (prefix ++ (if isLast then " " else "| ")) True
-- Utility
decodeResult :: T -> String
decodeResult tc
| Right num <- toNumber tc = show num
| Right str <- toString tc = "\"" ++ str ++ "\""
| Right list <- toList tc = "[" ++ intercalate ", " (map decodeResult list) ++ "]"
| otherwise = formatResult TreeCalculus tc

View File

@ -85,7 +85,7 @@ parser = testGroup "Parser Tests"
, testCase "Parse function definitions" $ do
let input = "x = (\\a b c : a)"
expect = SFunc "x" [] (SLambda ["a"] (SLambda ["b"] (SLambda ["c"] (SVar "a"))))
expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SLambda ["c"] (SVar "a"))))
parseSingle input @?= expect
, testCase "Parse nested Tree Calculus terms" $ do
@ -105,7 +105,7 @@ parser = testGroup "Parser Tests"
, testCase "Parse function with applications" $ do
let input = "f = (\\x : t x)"
expect = SFunc "f" [] (SLambda ["x"] (SApp TLeaf (SVar "x")))
expect = SDef "f" [] (SLambda ["x"] (SApp TLeaf (SVar "x")))
parseSingle input @?= expect
, testCase "Parse nested lists" $ do
@ -147,7 +147,7 @@ parser = testGroup "Parser Tests"
, testCase "Parse nested parentheses in function body" $ do
let input = "f = (\\x : t (t (t t)))"
expect = SFunc "f" [] (SLambda ["x"] (SApp TLeaf (SApp TLeaf (SApp TLeaf TLeaf))))
expect = SDef "f" [] (SLambda ["x"] (SApp TLeaf (SApp TLeaf (SApp TLeaf TLeaf))))
parseSingle input @?= expect
, testCase "Parse lambda abstractions" $ do
@ -157,12 +157,12 @@ parser = testGroup "Parser Tests"
, testCase "Parse multiple arguments to lambda abstractions" $ do
let input = "x = (\\a b : a)"
expect = SFunc "x" [] (SLambda ["a"] (SLambda ["b"] (SVar "a")))
expect = SDef "x" [] (SLambda ["a"] (SLambda ["b"] (SVar "a")))
parseSingle input @?= expect
, testCase "Grouping T terms with parentheses in function application" $ do
let input = "x = (\\a : a)\nx (t)"
expect = [SFunc "x" [] (SLambda ["a"] (SVar "a")),SApp (SVar "x") TLeaf]
expect = [SDef "x" [] (SLambda ["a"] (SVar "a")),SApp (SVar "x") TLeaf]
parseTricu input @?= expect
, testCase "Comments 1" $ do
@ -488,8 +488,9 @@ fileEval = testGroup "File evaluation tests"
res @?= Fork (Stem Leaf) Leaf
, testCase "Mapping and Equality" $ do
res <- liftIO $ evaluateFileResult "./test/map.tri"
res @?= Stem Leaf
library <- liftIO $ evaluateFile "./lib/base.tri"
fEnv <- liftIO $ evaluateFileWithContext library "./test/map.tri"
(mainResult fEnv) @?= Stem Leaf
, testCase "Eval and decoding string" $ do
library <- liftIO $ evaluateFile "./lib/base.tri"
@ -497,7 +498,6 @@ fileEval = testGroup "File evaluation tests"
decodeResult (result res) @?= "\"String test!\""
]
demos :: TestTree
demos = testGroup "Test provided demo functionality"
[ testCase "Structural equality demo" $ do
@ -511,7 +511,7 @@ demos = testGroup "Test provided demo functionality"
, testCase "Determining the size of functions" $ do
library <- liftIO $ evaluateFile "./lib/base.tri"
res <- liftIO $ evaluateFileWithContext library "./demos/size.tri"
decodeResult (result res) @?= "2071"
decodeResult (result res) @?= "454"
, testCase "Level Order Traversal demo" $ do
library <- liftIO $ evaluateFile "./lib/base.tri"
res <- liftIO $ evaluateFileWithContext library "./demos/levelOrderTraversal.tri"

View File

@ -2,7 +2,7 @@
-- t (t t) (t (t t t))
-- t (t t t) (t t)
-- x = (\a : a)
t (t t) t -- Fork (Stem Leaf) Leaf
main = t (t t) t -- Fork (Stem Leaf) Leaf
-- t t
-- x
-- x = (\a : a)

View File

@ -1 +1 @@
t t t
main = t t t

View File

@ -1,24 +1,2 @@
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)
yi = (\i : b m (c b (i m)))
y = yi iC
triage = (\a b c : t (t a b) c)
pair = t
matchList = (\oe oc : triage oe _ oc)
lconcat = y (\self : matchList (\k : k) (\h r k : pair h (self r k)))
hmap = y (\self : matchList (\f : t) (\hd tl f : pair (f hd) (self tl f)))
map = (\f l : hmap l f)
lAnd = triage (\x : false) (\_ x : x) (\_ _ x : x)
lOr = triage (\x : x) (\_ _ : true) (\_ _ x : true)
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))))
x = map (\i : lconcat "Successfully concatenated " i) [("two strings!")]
equal x [("Successfully concatenated two strings!")]
main = equal? x [("Successfully concatenated two strings!")]

21
test/size.tri Normal file
View File

@ -0,0 +1,21 @@
compose = \f g x : f (g x)
succ = y (\self :
triage
1
t
(triage
(t (t t))
(\_ tail : t t (self tail))
t))
size = (\x :
(y (\self x :
compose succ
(triage
(\x : x)
self
(\x y : compose (self x) (self y))
x)) x 0))
size size

1
test/undefined.tri Normal file
View File

@ -0,0 +1 @@
namedTerm = undefinedForTesting

View File

@ -1,7 +1,7 @@
cabal-version: 1.12
name: tricu
version: 0.7.0
version: 0.11.0
description: A micro-language for exploring Tree Calculus
author: James Eversole
maintainer: james@eversole.co