3 Commits

Author SHA1 Message Date
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
13 changed files with 256 additions and 180 deletions

View File

@ -2,7 +2,7 @@
## Introduction ## 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)`. tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)`.

View File

@ -6,7 +6,7 @@ demo_true = t t
not_TC? = t (t (t t) (t t t)) (t t (t t t)) not_TC? = t (t (t t) (t t t)) (t t (t t t))
-- /demos/toSource.tri contains an explanation of `triage` -- /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 demo_matchBool = (\ot of : demo_triage
of of
(\_ : ot) (\_ : ot)

View File

@ -1,11 +1,9 @@
-- Level Order Traversal of a labelled binary tree -- Level Order Traversal of a labelled binary tree
-- Objective: Print each "level" of the tree on a separate line -- 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 nested lists where values act as labels. We
-- -- require explicit notation of empty nodes. Empty nodes can be represented
-- We model labelled binary trees as sublists where values act as labels. We -- with an empty list, `[]`, which evaluates to a single node `t`.
-- require explicit not?ation of empty nodes. Empty nodes can be represented
-- with an empty list, `[]`, which is equivalent to a single node `t`.
-- --
-- Example tree inputs: -- Example tree inputs:
-- [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]] -- [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]]
@ -15,11 +13,10 @@
-- 2 3 -- 2 3
-- / / \ -- / / \
-- 4 5 6 -- 4 5 6
--
label = (\node : head node) label = \node : head node
left = (\node : if (emptyList? node) left = (\node : if (emptyList? node)
[] []
(if (emptyList? (tail node)) (if (emptyList? (tail node))
[] []
@ -39,7 +36,7 @@ processLevel = y (\self queue : if (emptyList? queue)
(\node : not? (emptyList? node)) (\node : not? (emptyList? node))
(lconcat (map left queue) (map right queue)))))) (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) toLineString = y (\self levels : if (emptyList? levels)
"" ""
@ -47,11 +44,11 @@ toLineString = y (\self levels : if (emptyList? levels)
(lconcat (map (\x : lconcat x " ") (head levels)) "") (lconcat (map (\x : lconcat x " ") (head levels)) "")
(if (emptyList? (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail 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) "" 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") exampleOne = levelOrderTraversal [("1")
[("2") [("4") t t] t] [("2") [("4") t t] t]

View File

@ -1,4 +1,4 @@
compose = (\f g x : f (g x)) compose = \f g x : f (g x)
succ = y (\self : succ = y (\self :
triage triage

View File

@ -40,7 +40,7 @@ toSource_ = y (\self arg :
arg) -- The term to be inspected arg) -- The term to be inspected
-- toSource takes a single TC term and returns a String -- toSource takes a single TC term and returns a String
toSource = (\v : toSource_ v "") toSource = \v : toSource_ v ""
exampleOne = toSource true -- OUT: "(t t)" exampleOne = toSource true -- OUT: "(t t)"
exampleTwo = toSource not? -- OUT: "(t (t (t t) (t t t)) (t t (t 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 m = s i i
b = s (k s) k b = s (k s) k
c = s (s (k s) (s (k k) s)) (k k) c = s (s (k s) (s (k k) s)) (k k)
iC = (\a b c : s a (k c) b) id = \a : a
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)
pair = t 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") test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork")
matchBool = (\ot of : triage matchBool = (\ot of : triage
@ -27,17 +24,9 @@ matchBool = (\ot of : triage
(\_ _ : ot) (\_ _ : ot)
) )
matchList = (\oe oc : triage matchList = \a b : triage a _ b
oe
_
oc
)
matchPair = (\op : triage matchPair = \a : triage _ _ a
_
_
op
)
not? = matchBool false true not? = matchBool false true
and? = matchBool id (\_ : false) and? = matchBool id (\_ : false)
@ -53,20 +42,18 @@ lconcat = y (\self : matchList
lAnd = (triage lAnd = (triage
(\_ : false) (\_ : false)
(\_ x : x) (\_ x : x)
(\_ _ x : x) (\_ _ x : x))
)
lOr = (triage lOr = (triage
(\x : x) (\x : x)
(\_ _ : true) (\_ _ : true)
(\_ _ _ : true) (\_ _ _ : true))
)
map_ = y (\self : map_ = y (\self :
matchList matchList
(\_ : t) (\_ : t)
(\head tail f : pair (f head) (self tail f))) (\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 equal? = y (\self : triage
(triage (triage
@ -87,10 +74,10 @@ equal? = y (\self : triage
filter_ = y (\self : matchList filter_ = y (\self : matchList
(\_ : t) (\_ : t)
(\head tail f : matchBool (t head) i (f head) (self tail f))) (\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_ = 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_ = 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 Parser
import Research import Research
import Data.List (partition)
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
evalSingle :: Env -> TricuAST -> Env evalSingle :: Env -> TricuAST -> Env
evalSingle env term evalSingle env term
| SFunc name [] body <- term = | SDef name [] body <- term =
if if
| Map.member name env -> | Map.member name env ->
errorWithoutStackTrace $ errorWithoutStackTrace $
@ -23,18 +23,23 @@ evalSingle env term
in Map.insert "__result" res env in Map.insert "__result" res env
| SVar name <- term = | SVar name <- term =
case Map.lookup name env of case Map.lookup name env of
Just v -> Map.insert "__result" v env Just v ->
Nothing -> errorWithoutStackTrace $ "Variable `" ++ name ++ "` not defined" 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 = | otherwise =
Map.insert "__result" (evalAST env term) env Map.insert "__result" (evalAST env term) env
evalTricu :: Env -> [TricuAST] -> Env evalTricu :: Env -> [TricuAST] -> Env
evalTricu env [] = env evalTricu env x = go env (reorderDefs env x)
evalTricu env [x] = where
let updatedEnv = evalSingle env x go env [] = env
in Map.insert "__result" (result updatedEnv) updatedEnv go env [x] =
evalTricu env (x:xs) = let updatedEnv = evalSingle env x
evalTricu (evalSingle env x) xs in Map.insert "__result" (result updatedEnv) updatedEnv
go env (x:xs) =
evalTricu (evalSingle env x) xs
evalAST :: Env -> TricuAST -> T evalAST :: Env -> TricuAST -> T
evalAST env term evalAST env term
@ -54,13 +59,24 @@ evalAST env term
(errorWithoutStackTrace $ "Variable " ++ name ++ " not defined") (errorWithoutStackTrace $ "Variable " ++ name ++ " not defined")
name env 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 :: TricuAST -> TricuAST
elimLambda = go elimLambda = go
where where
-- η-reduction
go (SLambda [v] (SApp f (SVar x))) go (SLambda [v] (SApp f (SVar x)))
| v == x && not (isFree v f) = elimLambda f | 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) go (SLambda (v:vs) body)
| null vs = toSKI v (elimLambda body) | null vs = toSKI v (elimLambda body)
| otherwise = elimLambda (SLambda [v] (SLambda vs body)) | otherwise = elimLambda (SLambda [v] (SLambda vs body))
@ -75,24 +91,91 @@ elimLambda = go
| otherwise = SApp (SApp _S (toSKI x n)) (toSKI x u) | otherwise = SApp (SApp _S (toSKI x n)) (toSKI x u)
toSKI x t toSKI x t
| not (isFree x t) = SApp _K t | not (isFree x t) = SApp _K t
| otherwise = errorWithoutStackTrace "Unhandled toSKI conversion"
_S = parseSingle "t (t (t t t)) t" _S = parseSingle "t (t (t t t)) t"
_K = parseSingle "t t" _K = parseSingle "t t"
_I = parseSingle "t (t (t 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 x = Set.member x . freeVars isFree :: String -> TricuAST -> Bool
freeVars (SVar v ) = Set.singleton v isFree x = Set.member x . freeVars
freeVars (SInt _ ) = Set.empty
freeVars (SStr _ ) = Set.empty freeVars :: TricuAST -> Set.Set String
freeVars (SList s ) = foldMap freeVars s freeVars (SVar v ) = Set.singleton v
freeVars (SApp f a ) = freeVars f <> freeVars a freeVars (SInt _ ) = Set.empty
freeVars (TLeaf ) = Set.empty freeVars (SStr _ ) = Set.empty
freeVars (SFunc _ _ b) = freeVars b freeVars (SList s ) = foldMap freeVars s
freeVars (TStem t ) = freeVars t freeVars (SApp f a ) = freeVars f <> freeVars a
freeVars (TFork l r ) = freeVars l <> freeVars r freeVars (TLeaf ) = Set.empty
freeVars (SLambda v b ) = foldr Set.delete (freeVars b) v 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 :: Env -> T
result r = case Map.lookup "__result" r of result r = case Map.lookup "__result" r of
Just a -> a Just a -> a
Nothing -> errorWithoutStackTrace "No __result field found in provided environment" Nothing -> errorWithoutStackTrace "No __result field found in provided env"

View File

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

View File

@ -19,7 +19,7 @@ data TricuAST
| SInt Int | SInt Int
| SStr String | SStr String
| SList [TricuAST] | SList [TricuAST]
| SFunc String [String] TricuAST | SDef String [String] TricuAST
| SApp TricuAST TricuAST | SApp TricuAST TricuAST
| TLeaf | TLeaf
| TStem TricuAST | TStem TricuAST

View File

@ -85,7 +85,7 @@ parser = testGroup "Parser Tests"
, testCase "Parse function definitions" $ do , testCase "Parse function definitions" $ do
let input = "x = (\\a b c : a)" 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 parseSingle input @?= expect
, testCase "Parse nested Tree Calculus terms" $ do , testCase "Parse nested Tree Calculus terms" $ do
@ -105,7 +105,7 @@ parser = testGroup "Parser Tests"
, testCase "Parse function with applications" $ do , testCase "Parse function with applications" $ do
let input = "f = (\\x : t x)" 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 parseSingle input @?= expect
, testCase "Parse nested lists" $ do , testCase "Parse nested lists" $ do
@ -147,7 +147,7 @@ parser = testGroup "Parser Tests"
, testCase "Parse nested parentheses in function body" $ do , testCase "Parse nested parentheses in function body" $ do
let input = "f = (\\x : t (t (t t)))" 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 parseSingle input @?= expect
, testCase "Parse lambda abstractions" $ do , testCase "Parse lambda abstractions" $ do
@ -157,12 +157,12 @@ parser = testGroup "Parser Tests"
, testCase "Parse multiple arguments to lambda abstractions" $ do , testCase "Parse multiple arguments to lambda abstractions" $ do
let input = "x = (\\a b : a)" 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 parseSingle input @?= expect
, testCase "Grouping T terms with parentheses in function application" $ do , testCase "Grouping T terms with parentheses in function application" $ do
let input = "x = (\\a : a)\nx (t)" 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 parseTricu input @?= expect
, testCase "Comments 1" $ do , testCase "Comments 1" $ do
@ -497,7 +497,6 @@ fileEval = testGroup "File evaluation tests"
decodeResult (result res) @?= "\"String test!\"" decodeResult (result res) @?= "\"String test!\""
] ]
demos :: TestTree demos :: TestTree
demos = testGroup "Test provided demo functionality" demos = testGroup "Test provided demo functionality"
[ testCase "Structural equality demo" $ do [ testCase "Structural equality demo" $ do
@ -511,7 +510,7 @@ demos = testGroup "Test provided demo functionality"
, testCase "Determining the size of functions" $ do , testCase "Determining the size of functions" $ do
library <- liftIO $ evaluateFile "./lib/base.tri" library <- liftIO $ evaluateFile "./lib/base.tri"
res <- liftIO $ evaluateFileWithContext library "./demos/size.tri" res <- liftIO $ evaluateFileWithContext library "./demos/size.tri"
decodeResult (result res) @?= "2071" decodeResult (result res) @?= "454"
, testCase "Level Order Traversal demo" $ do , testCase "Level Order Traversal demo" $ do
library <- liftIO $ evaluateFile "./lib/base.tri" library <- liftIO $ evaluateFile "./lib/base.tri"
res <- liftIO $ evaluateFileWithContext library "./demos/levelOrderTraversal.tri" res <- liftIO $ evaluateFileWithContext library "./demos/levelOrderTraversal.tri"

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 cabal-version: 1.12
name: tricu name: tricu
version: 0.7.0 version: 0.10.0
description: A micro-language for exploring Tree Calculus description: A micro-language for exploring Tree Calculus
author: James Eversole author: James Eversole
maintainer: james@eversole.co maintainer: james@eversole.co