commit 7a7ee6886a232c240247a8264b771165ea56b3e5
parent 1e23465bc38d6ea506fb168ee1e3f8bb5cd02bf0
Author: James Eversole <james@eversole.co>
Date: Sun, 29 Dec 2024 08:29:25 -0600
Rename from sapling to tricu
Diffstat:
11 files changed, 197 insertions(+), 196 deletions(-)
diff --git a/README.md b/README.md
@@ -1,10 +1,12 @@
-# sapling
+# tricu
## Introduction
-sapling is a "micro-language" that [I'm](https://eversole.co) working on to investigate [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf) .
+tricu (pronounced like "tree-shoe") is a "micro-language" that [I'm](https://eversole.co) working on to investigate [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf).
-It offers a minimal amount of syntax sugar yet provides a complete and intuitive programming environment. Sapling offers:
+tricu [means tree in Lojban](https://en.wiktionary.org/wiki/Appendix:Lojban/tricu). This project was named "sapling" until I discovered the name was already being used for other projects in programming language development.
+
+tricu offers a minimal amount of syntax sugar yet provides a complete and intuitive programming environment. tricu offers:
- `t` operator behaving by the rules of Tree Calculus
- Function ("variable") definitions
@@ -21,36 +23,35 @@ _ = t
true = t t
-- We can define functions as lambda expressions that are eliminated to tree
-- calculus terms.
-id = (\a : a) -- t (t (t t)) t
-triage = (\a b c : t (t a b) c)
+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 !!!
+-- Intensionality! We can inspect program structure, not just inputs/outputs:
test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork")
-- REPL
--- `sapling <` is the input prompt
--- `sapling >` is the Tree Calculus form output. Most are elided below.
--- `DECODE -:` is an attempt to interpret the TC output as strings/numbers.
-sapling < test t
-sapling > Fork (Fork Leaf (Fork ...) ... )
-DECODE -: "Leaf"
-sapling < test (t t)
-DECODE -: "Stem"
-sapling < test (t t t)
-DECODE -: "Fork"
-sapling < map (\i : listConcat i " is super cool!") [("He") ("She") ("Everybody")]
-DECODE -: ["He is super cool!", "She is super cool!", "Everybody is super cool!"]
+-- `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
You can easily build and/or run this project using [Nix](https://nixos.org/download/).
-- Build REPL binary: `nix build git+https://git.eversole.co/James/sapling`
-- Run REPL: `nix run git+https://git.eversole.co/James/sapling`
+- Build REPL binary: `nix build git+https://git.eversole.co/James/tricu`
+- Run REPL: `nix run git+https://git.eversole.co/James/tricu`
## Acknowledgements
Tree Calculus was discovered by [Barry Jay](https://github.com/barry-jay-personal/blog).
-[treecalcul.us](https://treecalcul.us) is an excellent website with an intuitive playground created by [Johannes Bader](https://johannes-bader.com/) that introduced me to Tree Calculus. If sapling sounds interesting but compiling this repo sounds like a hassle, you should check out his site.
+[treecalcul.us](https://treecalcul.us) is an excellent website with an intuitive playground created by [Johannes Bader](https://johannes-bader.com/) that introduced me to Tree Calculus. If tricu sounds interesting but compiling this repo sounds like a hassle, you should check out his site.
diff --git a/flake.nix b/flake.nix
@@ -1,5 +1,5 @@
{
- description = "sapling";
+ description = "tricu";
inputs = {
nixpkgs.url = "github:NixOS/nixpkgs";
@@ -10,7 +10,7 @@
flake-utils.lib.eachDefaultSystem (system:
let
pkgs = nixpkgs.legacyPackages.${system};
- packageName = "sapling";
+ packageName = "tricu";
containerPackageName = "${packageName}-container";
customGHC = pkgs.haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
@@ -22,7 +22,7 @@
enableSharedExecutables = false;
enableSharedLibraries = false;
- sapling = pkgs.haskell.lib.justStaticExecutables self.packages.${system}.default;
+ tricu = pkgs.haskell.lib.justStaticExecutables self.packages.${system}.default;
in {
packages.${packageName} =
diff --git a/sapling.cabal b/sapling.cabal
@@ -1,64 +0,0 @@
-cabal-version: 1.12
-
-name: sapling
-version: 0.4.0
-description: A micro-language for exploring Tree Calculus
-author: James Eversole
-maintainer: james@eversole.co
-copyright: James Eversole
-license: ISC
-license-file: LICENSE
-build-type: Simple
-extra-source-files:
- README.md
-
-executable sapling
- main-is: Main.hs
- hs-source-dirs:
- src
- default-extensions:
- ConstraintKinds
- DataKinds
- DeriveGeneric
- FlexibleContexts
- FlexibleInstances
- GeneralizedNewtypeDeriving
- OverloadedStrings
- ScopedTypeVariables
- ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
- build-depends:
- base >=4.7
- , containers
- , haskeline
- , megaparsec
- , mtl
- other-modules:
- Eval
- Lexer
- Library
- Parser
- REPL
- Research
- default-language: Haskell2010
-
-test-suite sapling-tests
- type: exitcode-stdio-1.0
- main-is: Spec.hs
- hs-source-dirs: test, src
- build-depends:
- base
- , containers
- , haskeline
- , megaparsec
- , mtl
- , tasty
- , tasty-hunit
- , tasty-quickcheck
- default-language: Haskell2010
- other-modules:
- Eval
- Lexer
- Library
- Parser
- REPL
- Research
diff --git a/src/Eval.hs b/src/Eval.hs
@@ -8,7 +8,7 @@ import qualified Data.Map as Map
import Data.List (foldl')
import qualified Data.Set as Set
-evalSingle :: Map String T -> SaplingAST -> Map String T
+evalSingle :: Map String T -> TricuAST -> Map String T
evalSingle env term = case term of
SFunc name [] body ->
let lineNoLambda = eliminateLambda body
@@ -28,18 +28,18 @@ evalSingle env term = case term of
let result = evalAST env term
in Map.insert "__result" result env
-evalSapling :: Map String T -> [SaplingAST] -> Map String T
-evalSapling env [] = env
-evalSapling env [lastLine] =
+evalTricu :: Map String T -> [TricuAST] -> Map String T
+evalTricu env [] = env
+evalTricu env [lastLine] =
let lastLineNoLambda = eliminateLambda lastLine
updatedEnv = evalSingle env lastLineNoLambda
in Map.insert "__result" (result updatedEnv) updatedEnv
-evalSapling env (line:rest) =
+evalTricu env (line:rest) =
let lineNoLambda = eliminateLambda line
updatedEnv = evalSingle env lineNoLambda
- in evalSapling updatedEnv rest
+ in evalTricu updatedEnv rest
-evalAST :: Map String T -> SaplingAST -> T
+evalAST :: Map String T -> TricuAST -> T
evalAST env term = case term of
SVar name -> case Map.lookup name env of
Just value -> value
@@ -56,7 +56,7 @@ evalAST env term = case term of
++ " in evalAST; define via evalSingle."
SLambda {} -> error "Internal error: SLambda found in evalAST after elimination."
-eliminateLambda :: SaplingAST -> SaplingAST
+eliminateLambda :: TricuAST -> TricuAST
eliminateLambda (SLambda (v:vs) body)
| null vs = lambdaToT v (eliminateLambda body)
| otherwise = eliminateLambda (SLambda [v] (SLambda vs body))
@@ -69,7 +69,7 @@ eliminateLambda other = other
-- This is my attempt to implement the lambda calculus elimination rules defined
-- in "Typed Program Analysis without Encodings" by Barry Jay.
-- https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf
-lambdaToT :: String -> SaplingAST -> SaplingAST
+lambdaToT :: String -> TricuAST -> TricuAST
lambdaToT x (SVar y)
| x == y = tI
lambdaToT x (SVar y)
@@ -83,7 +83,7 @@ lambdaToT x body
| not (isFree x body) = SApp tK body
| otherwise = SApp (SApp tS (lambdaToT x body)) TLeaf
-freeVars :: SaplingAST -> Set.Set String
+freeVars :: TricuAST -> Set.Set String
freeVars (SVar v) = Set.singleton v
freeVars (SInt _) = Set.empty
freeVars (SStr _) = Set.empty
@@ -95,23 +95,23 @@ freeVars (TStem t) = freeVars t
freeVars (TFork l r) = freeVars l <> freeVars r
freeVars (SLambda vs b) = foldr Set.delete (freeVars b) vs
-isFree :: String -> SaplingAST -> Bool
+isFree :: String -> TricuAST -> Bool
isFree x = Set.member x . freeVars
-toAST :: T -> SaplingAST
+toAST :: T -> TricuAST
toAST Leaf = TLeaf
toAST (Stem a) = TStem (toAST a)
toAST (Fork a b) = TFork (toAST a) (toAST b)
--- We need the SKI operators in an unevaluated SaplingAST tree form so that we
+-- We need the SKI operators in an unevaluated TricuAST tree form so that we
-- can keep the evaluation functions straightforward
-tI :: SaplingAST
+tI :: TricuAST
tI = SApp (SApp TLeaf (SApp TLeaf (SApp TLeaf TLeaf))) TLeaf
-tK :: SaplingAST
+tK :: TricuAST
tK = SApp TLeaf TLeaf
-tS :: SaplingAST
+tS :: TricuAST
tS = SApp (SApp TLeaf (SApp TLeaf (SApp (SApp TLeaf TLeaf) TLeaf))) TLeaf
result :: Map String T -> T
diff --git a/src/Lexer.hs b/src/Lexer.hs
@@ -86,8 +86,8 @@ comment = do
sc :: Lexer ()
sc = skipMany (void (char ' ') <|> void (char '\t') <|> void comment)
-saplingLexer :: Lexer [LToken]
-saplingLexer = many (sc *> choice
+tricuLexer :: Lexer [LToken]
+tricuLexer = many (sc *> choice
[ try identifier
, try keywordT
, try integerLiteral
@@ -102,7 +102,7 @@ saplingLexer = many (sc *> choice
, lnewline
] <* sc) <* eof
-lexSapling :: String -> [LToken]
-lexSapling input = case runParser saplingLexer "" input of
+lexTricu :: String -> [LToken]
+lexTricu input = case runParser tricuLexer "" input of
Left err -> error $ "Lexical error:\n" ++ errorBundlePretty err
Right tokens -> tokens
diff --git a/src/Library.hs b/src/Library.hs
@@ -7,7 +7,7 @@ import Research
import qualified Data.Map as Map
library :: Map.Map String T
-library = evalSapling Map.empty $ parseSapling $ unlines
+library = evalTricu Map.empty $ parseTricu $ unlines
[ "false = t"
, "true = t t"
, "_ = t"
diff --git a/src/Main.hs b/src/Main.hs
@@ -12,11 +12,11 @@ import Text.Megaparsec (runParser)
main :: IO ()
main = do
- putStrLn "Welcome to the Sapling Interpreter"
+ putStrLn "Welcome to the Tricu Interpreter"
putStrLn "You can exit at any time by typing and entering: "
putStrLn ":_exit"
repl library
-runSapling :: String -> T
-runSapling s = result (evalSapling Map.empty $ parseSapling s)
-runSaplingEnv env s = result (evalSapling env $ parseSapling s)
+runTricu :: String -> T
+runTricu s = result (evalTricu Map.empty $ parseTricu s)
+runTricuEnv env s = result (evalTricu env $ parseTricu s)
diff --git a/src/Parser.hs b/src/Parser.hs
@@ -13,33 +13,33 @@ import Text.Megaparsec.Error (errorBundlePretty, ParseErrorBundle)
type Parser = Parsec Void [LToken]
-data SaplingAST
+data TricuAST
= SVar String
| SInt Int
| SStr String
- | SList [SaplingAST]
- | SFunc String [String] SaplingAST
- | SApp SaplingAST SaplingAST
+ | SList [TricuAST]
+ | SFunc String [String] TricuAST
+ | SApp TricuAST TricuAST
| TLeaf
- | TStem SaplingAST
- | TFork SaplingAST SaplingAST
- | SLambda [String] SaplingAST
+ | TStem TricuAST
+ | TFork TricuAST TricuAST
+ | SLambda [String] TricuAST
deriving (Show, Eq, Ord)
-parseSapling :: String -> [SaplingAST]
-parseSapling input =
+parseTricu :: String -> [TricuAST]
+parseTricu input =
let nonEmptyLines = filter (not . null) (lines input)
in map parseSingle nonEmptyLines
-parseSingle :: String -> SaplingAST
-parseSingle input = case runParser parseExpression "" (lexSapling input) of
+parseSingle :: String -> TricuAST
+parseSingle input = case runParser parseExpression "" (lexTricu input) of
Left err -> error $ handleParseError err
Right ast -> ast
scnParser :: Parser ()
scnParser = skipMany (satisfy isNewline)
-parseExpression :: Parser SaplingAST
+parseExpression :: Parser TricuAST
parseExpression = choice
[ try parseFunction
, try parseLambda
@@ -50,7 +50,7 @@ parseExpression = choice
, parseLiteral
]
-parseFunction :: Parser SaplingAST
+parseFunction :: Parser TricuAST
parseFunction = do
LIdentifier name <- satisfy isIdentifier
args <- many (satisfy isIdentifier)
@@ -58,20 +58,20 @@ parseFunction = do
body <- parseExpression
return (SFunc name (map getIdentifier args) body)
-parseAtomicBase :: Parser SaplingAST
+parseAtomicBase :: Parser TricuAST
parseAtomicBase = choice
[ try parseVarWithoutAssignment
, parseTreeLeaf
, parseGrouped
]
-parseVarWithoutAssignment :: Parser SaplingAST
+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 SaplingAST
+parseLambda :: Parser TricuAST
parseLambda = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) $ do
satisfy (== LBackslash)
param <- satisfy isIdentifier
@@ -81,13 +81,13 @@ parseLambda = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) $ do
let nestedLambda = foldr (\v acc -> SLambda [v] acc) body (map getIdentifier rest)
return (SLambda [getIdentifier param] nestedLambda)
-parseLambdaExpression :: Parser SaplingAST
+parseLambdaExpression :: Parser TricuAST
parseLambdaExpression = choice
[ try parseLambdaApplication
, parseAtomicLambda
]
-parseAtomicLambda :: Parser SaplingAST
+parseAtomicLambda :: Parser TricuAST
parseAtomicLambda = choice
[ parseVar
, parseTreeLeaf
@@ -97,32 +97,32 @@ parseAtomicLambda = choice
, between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseLambdaExpression
]
-parseApplication :: Parser SaplingAST
+parseApplication :: Parser TricuAST
parseApplication = do
func <- parseAtomicBase
args <- many parseAtomic
return $ foldl (\acc arg -> SApp acc arg) func args
-parseLambdaApplication :: Parser SaplingAST
+parseLambdaApplication :: Parser TricuAST
parseLambdaApplication = do
func <- parseAtomicLambda
args <- many parseAtomicLambda
return $ foldl (\acc arg -> SApp acc arg) func args
-isTreeTerm :: SaplingAST -> Bool
+isTreeTerm :: TricuAST -> Bool
isTreeTerm TLeaf = True
isTreeTerm (TStem _) = True
isTreeTerm (TFork _ _) = True
isTreeTerm _ = False
-parseTreeLeaf :: Parser SaplingAST
+parseTreeLeaf :: Parser TricuAST
parseTreeLeaf = satisfy isKeywordT *> notFollowedBy (satisfy (== LAssign)) *> pure TLeaf
getIdentifier :: LToken -> String
getIdentifier (LIdentifier name) = name
getIdentifier _ = error "Expected identifier"
-parseTreeTerm :: Parser SaplingAST
+parseTreeTerm :: Parser TricuAST
parseTreeTerm = do
base <- parseTreeLeafOrParenthesized
rest <- many parseTreeLeafOrParenthesized
@@ -133,18 +133,18 @@ parseTreeTerm = do
TStem t -> TFork t next
TFork _ _ -> TFork acc next
-parseTreeLeafOrParenthesized :: Parser SaplingAST
+parseTreeLeafOrParenthesized :: Parser TricuAST
parseTreeLeafOrParenthesized = choice
[ between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseTreeTerm
, parseTreeLeaf
]
-foldTree :: [SaplingAST] -> SaplingAST
+foldTree :: [TricuAST] -> TricuAST
foldTree [] = TLeaf
foldTree [x] = x
foldTree (x:y:rest) = TFork x (foldTree (y:rest))
-parseAtomic :: Parser SaplingAST
+parseAtomic :: Parser TricuAST
parseAtomic = choice
[ parseVar
, parseTreeLeaf
@@ -153,44 +153,44 @@ parseAtomic = choice
, parseLiteral
]
-parseGrouped :: Parser SaplingAST
+parseGrouped :: Parser TricuAST
parseGrouped = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) parseExpression
-parseLiteral :: Parser SaplingAST
+parseLiteral :: Parser TricuAST
parseLiteral = choice
[ parseIntLiteral
, parseStrLiteral
]
-parens :: Parser SaplingAST -> Parser SaplingAST
+parens :: Parser TricuAST -> Parser TricuAST
parens p = do
satisfy (== LOpenParen)
result <- p
satisfy (== LCloseParen)
return result
-parseListLiteral :: Parser SaplingAST
+parseListLiteral :: Parser TricuAST
parseListLiteral = do
satisfy (== LOpenBracket)
elements <- many parseListItem
satisfy (== LCloseBracket)
return (SList elements)
-parseListItem :: Parser SaplingAST
+parseListItem :: Parser TricuAST
parseListItem = choice
[ parseGroupedItem
, parseListLiteral
, parseSingleItem
]
-parseGroupedItem :: Parser SaplingAST
+parseGroupedItem :: Parser TricuAST
parseGroupedItem = do
satisfy (== LOpenParen)
inner <- parseExpression
satisfy (== LCloseParen)
return inner
-parseSingleItem :: Parser SaplingAST
+parseSingleItem :: Parser TricuAST
parseSingleItem = do
token <- satisfy isListItem
case token of
@@ -203,19 +203,19 @@ isListItem (LIdentifier _) = True
isListItem LKeywordT = True
isListItem _ = False
-parseVar :: Parser SaplingAST
+parseVar :: Parser TricuAST
parseVar = do
LIdentifier name <- satisfy isIdentifier
if (name == "t" || name == "__result")
then fail $ "Reserved keyword: " ++ name ++ " cannot be assigned."
else return (SVar name)
-parseIntLiteral :: Parser SaplingAST
+parseIntLiteral :: Parser TricuAST
parseIntLiteral = do
LIntegerLiteral value <- satisfy isIntegerLiteral
return (SInt value)
-parseStrLiteral :: Parser SaplingAST
+parseStrLiteral :: Parser TricuAST
parseStrLiteral = do
LStringLiteral value <- satisfy isStringLiteral
return (SStr value)
diff --git a/src/REPL.hs b/src/REPL.hs
@@ -15,7 +15,7 @@ repl env = runInputT defaultSettings (loop env)
where
loop :: Map.Map String T -> InputT IO ()
loop env = do
- minput <- getInputLine "sapling < "
+ minput <- getInputLine "tricu < "
case minput of
Nothing -> outputStrLn "Goodbye!"
Just ":_exit" -> outputStrLn "Goodbye!"
@@ -27,7 +27,7 @@ repl env = runInputT defaultSettings (loop env)
newEnv = evalSingle clearEnv (parseSingle input)
case Map.lookup "__result" newEnv of
Just r -> do
- outputStrLn $ "sapling > " ++ show r
+ outputStrLn $ "tricu > " ++ show r
outputStrLn $ "DECODE -: " ++ decodeResult r
Nothing -> return ()
loop newEnv
diff --git a/test/Spec.hs b/test/Spec.hs
@@ -17,11 +17,11 @@ import qualified Data.Set as Set
main :: IO ()
main = defaultMain tests
-runSapling :: String -> String
-runSapling s = show $ result (evalSapling Map.empty $ parseSapling s)
+runTricu :: String -> String
+runTricu s = show $ result (evalTricu Map.empty $ parseTricu s)
tests :: TestTree
-tests = testGroup "Sapling Tests"
+tests = testGroup "Tricu Tests"
[ lexerTests
, parserTests
, integrationTests
@@ -35,32 +35,32 @@ lexerTests = testGroup "Lexer Tests"
[ testCase "Lex simple identifiers" $ do
let input = "x a b = a"
expect = Right [LIdentifier "x", LIdentifier "a", LIdentifier "b", LAssign, LIdentifier "a"]
- runParser saplingLexer "" input @?= expect
+ runParser tricuLexer "" input @?= expect
, testCase "Lex Tree Calculus terms" $ do
let input = "t t t"
expect = Right [LKeywordT, LKeywordT, LKeywordT]
- runParser saplingLexer "" input @?= expect
+ runParser tricuLexer "" input @?= expect
, testCase "Lex escaped characters in strings" $ do
let input = "\"hello\\nworld\""
expect = Right [LStringLiteral "hello\\nworld"]
- runParser saplingLexer "" input @?= expect
+ runParser tricuLexer "" input @?= expect
, testCase "Lex mixed literals" $ do
let input = "t \"string\" 42"
expect = Right [LKeywordT, LStringLiteral "string", LIntegerLiteral 42]
- runParser saplingLexer "" input @?= expect
+ runParser tricuLexer "" input @?= expect
, testCase "Lex invalid token" $ do
let input = "$invalid"
- case runParser saplingLexer "" input of
+ case runParser tricuLexer "" input of
Left _ -> return ()
Right _ -> assertFailure "Expected lexer to fail on invalid token"
, testCase "Drop trailing whitespace in definitions" $ do
let input = "x = 5 "
expect = [LIdentifier "x",LAssign,LIntegerLiteral 5]
- case (runParser saplingLexer "" input) of
+ case (runParser tricuLexer "" input) of
Left _ -> assertFailure "Failed to lex input"
Right i -> i @?= expect
, testCase "Error when using invalid characters in identifiers" $ do
- case (runParser saplingLexer "" "__result = 5") of
+ case (runParser tricuLexer "" "__result = 5") of
Left _ -> return ()
Right _ -> assertFailure "Expected failure when trying to assign the value of __result"
]
@@ -68,12 +68,12 @@ lexerTests = testGroup "Lexer Tests"
parserTests :: TestTree
parserTests = testGroup "Parser Tests"
[ --testCase "Error when parsing incomplete definitions" $ do
- -- let input = lexSapling "x = "
+ -- let input = lexTricu "x = "
-- case (runParser parseExpression "" input) of
-- Left _ -> return ()
-- Right _ -> assertFailure "Expected failure on invalid input"
testCase "Error when assigning a value to T" $ do
- let input = lexSapling "t = x"
+ let input = lexTricu "t = x"
case (runParser parseExpression "" input) of
Left _ -> return ()
Right _ -> assertFailure "Expected failure when trying to assign the value of T"
@@ -142,7 +142,7 @@ parserTests = testGroup "Parser Tests"
, 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]
- parseSapling input @?= expect
+ parseTricu input @?= expect
]
integrationTests :: TestTree
@@ -182,16 +182,16 @@ evaluationTests = testGroup "Evaluation Tests"
Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
, testCase "Environment updates with definitions" $ do
let input = "x = t\ny = x"
- env = evalSapling Map.empty (parseSapling input)
+ env = evalTricu Map.empty (parseTricu input)
Map.lookup "x" env @?= Just Leaf
Map.lookup "y" env @?= Just Leaf
, testCase "Variable substitution" $ do
let input = "x = t t\ny = t x\ny"
- env = evalSapling Map.empty (parseSapling input)
+ env = evalTricu Map.empty (parseTricu input)
(result env) @?= Stem (Stem Leaf)
, testCase "Multiline input evaluation" $ do
let input = "x = t\ny = t t\nx"
- env = evalSapling Map.empty (parseSapling input)
+ env = evalTricu Map.empty (parseTricu input)
(result env) @?= Leaf
, testCase "Evaluate string literal" $ do
let input = "\"hello\""
@@ -211,40 +211,40 @@ evaluationTests = testGroup "Evaluation Tests"
\ z = y\n \
\ variablewithamuchlongername = z\n \
\ variablewithamuchlongername"
- env = evalSapling Map.empty (parseSapling input)
+ env = evalTricu Map.empty (parseTricu input)
(result env) @?= (Stem (Stem Leaf))
, testCase "Evaluate variable shadowing" $ do
let input = "x = t t\nx = t\nx"
- env = evalSapling Map.empty (parseSapling input)
+ env = evalTricu Map.empty (parseTricu input)
(result env) @?= Leaf
, testCase "Apply identity to Boolean Not" $ do
let not = "(t (t (t t) (t t t)) t)"
let input = "x = (\\a : a)\nx " ++ not
- env = evalSapling Map.empty (parseSapling input)
+ env = evalTricu Map.empty (parseTricu input)
result env @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) Leaf
, testCase "Constant function matches" $ do
let input = "k = (\\a b : a)\nk (t t) t"
- env = evalSapling Map.empty (parseSapling input)
+ env = evalTricu Map.empty (parseTricu input)
result env @?= Stem Leaf
, testCase "Boolean AND_ TF" $ do
let input = "and (t t) (t)"
- env = evalSapling library (parseSapling input)
+ env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "Boolean AND_ FT" $ do
let input = "and (t) (t t)"
- env = evalSapling library (parseSapling input)
+ env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "Boolean AND_ FF" $ do
let input = "and (t) (t)"
- env = evalSapling library (parseSapling input)
+ env = evalTricu library (parseTricu input)
result env @?= Leaf
, testCase "Boolean AND_ TT" $ do
let input = "and (t t) (t t)"
- env = evalSapling library (parseSapling input)
+ env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "Verifying Equality" $ do
let input = "equal (t t t) (t t t)"
- env = evalSapling library (parseSapling input)
+ env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
]
@@ -252,67 +252,67 @@ lambdaEvalTests :: TestTree
lambdaEvalTests = testGroup "Lambda Evaluation Tests"
[ testCase "Lambda Identity Function" $ do
let input = "id = (\\x : x)\nid t"
- runSapling input @?= "Leaf"
+ runTricu input @?= "Leaf"
, testCase "Lambda Constant Function (K combinator)" $ do
let input = "k = (\\x y : x)\nk t (t t)"
- runSapling input @?= "Leaf"
+ runTricu input @?= "Leaf"
, testCase "Lambda Application with Variable" $ do
let input = "id = (\\x : x)\nval = t t\nid val"
- runSapling input @?= "Stem Leaf"
+ runTricu input @?= "Stem Leaf"
, testCase "Lambda Application with Multiple Arguments" $ do
let input = "apply = (\\f x y : f x y)\nk = (\\a b : a)\napply k t (t t)"
- runSapling input @?= "Leaf"
+ runTricu input @?= "Leaf"
, testCase "Nested Lambda Application" $ do
let input = "apply = (\\f x y : f x y)\nid = (\\x : x)\napply (\\f x : f x) id t"
- runSapling input @?= "Leaf"
+ runTricu input @?= "Leaf"
, testCase "Lambda with a complex body" $ do
let input = "f = (\\x : t (t x))\nf t"
- runSapling input @?= "Stem (Stem Leaf)"
+ runTricu input @?= "Stem (Stem Leaf)"
, testCase "Lambda returning a function" $ do
let input = "f = (\\x : (\\y : x))\ng = f t\ng (t t)"
- runSapling input @?= "Leaf"
+ runTricu input @?= "Leaf"
, testCase "Lambda with Shadowing" $ do
let input = "f = (\\x : (\\x : x))\nf t (t t)"
- runSapling input @?= "Stem Leaf"
+ runTricu input @?= "Stem Leaf"
, testCase "Lambda returning another lambda" $ do
let input = "k = (\\x : (\\y : x))\nk_app = k t\nk_app (t t)"
- runSapling input @?= "Leaf"
+ runTricu input @?= "Leaf"
, testCase "Lambda with free variables" $ do
let input = "y = t t\nf = (\\x : y)\nf t"
- runSapling input @?= "Stem Leaf"
+ runTricu input @?= "Stem Leaf"
, testCase "SKI Composition" $ do
let input = "s = (\\x y z : x z (y z))\nk = (\\x y : x)\ni = (\\x : x)\ncomp = s k i\ncomp t (t t)"
- runSapling input @?= "Stem (Stem Leaf)"
+ runTricu input @?= "Stem (Stem Leaf)"
, testCase "Lambda with multiple parameters and application" $ do
let input = "f = (\\a b c : t a b c)\nf t (t t) (t t t)"
- runSapling input @?= "Stem Leaf"
+ runTricu input @?= "Stem Leaf"
, testCase "Lambda with nested application in the body" $ do
let input = "f = (\\x : t (t (t x)))\nf t"
- runSapling input @?= "Stem (Stem (Stem Leaf))"
+ runTricu input @?= "Stem (Stem (Stem Leaf))"
, testCase "Lambda returning a function and applying it" $ do
let input = "f = (\\x : (\\y : t x y))\ng = f t\ng (t t)"
- runSapling input @?= "Fork Leaf (Stem Leaf)"
+ runTricu input @?= "Fork Leaf (Stem Leaf)"
, testCase "Lambda applying a variable" $ do
let input = "id = (\\x : x)\na = t t\nid a"
- runSapling input @?= "Stem Leaf"
+ runTricu input @?= "Stem Leaf"
, testCase "Nested lambda abstractions in the same expression" $ do
let input = "f = (\\x : (\\y : x y))\ng = (\\z : z)\nf g t"
- runSapling input @?= "Leaf"
+ runTricu input @?= "Leaf"
, testCase "Lambda with a string literal" $ do
let input = "f = (\\x : x)\nf \"hello\""
- runSapling input @?= "Fork (Fork Leaf (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) Leaf))))"
+ runTricu input @?= "Fork (Fork Leaf (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) Leaf))))"
, testCase "Lambda with an integer literal" $ do
let input = "f = (\\x : x)\nf 42"
- runSapling input @?= "Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) Leaf)))))"
+ runTricu input @?= "Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) Leaf)))))"
, testCase "Lambda with a list literal" $ do
let input = "f = (\\x : x)\nf [t (t t)]"
- runSapling input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
+ runTricu input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
]
propertyTests :: TestTree
propertyTests = testGroup "Property Tests"
[ testProperty "Lexing and parsing round-trip" $ \input ->
- case runParser saplingLexer "" input of
+ case runParser tricuLexer "" input of
Left _ -> property True
Right tokens -> case runParser parseExpression "" tokens of
Left _ -> property True
diff --git a/tricu.cabal b/tricu.cabal
@@ -0,0 +1,64 @@
+cabal-version: 1.12
+
+name: tricu
+version: 0.4.0
+description: A micro-language for exploring Tree Calculus
+author: James Eversole
+maintainer: james@eversole.co
+copyright: James Eversole
+license: ISC
+license-file: LICENSE
+build-type: Simple
+extra-source-files:
+ README.md
+
+executable tricu
+ main-is: Main.hs
+ hs-source-dirs:
+ src
+ default-extensions:
+ ConstraintKinds
+ DataKinds
+ DeriveGeneric
+ FlexibleContexts
+ FlexibleInstances
+ GeneralizedNewtypeDeriving
+ OverloadedStrings
+ ScopedTypeVariables
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
+ build-depends:
+ base >=4.7
+ , containers
+ , haskeline
+ , megaparsec
+ , mtl
+ other-modules:
+ Eval
+ Lexer
+ Library
+ Parser
+ REPL
+ Research
+ default-language: Haskell2010
+
+test-suite tricu-tests
+ type: exitcode-stdio-1.0
+ main-is: Spec.hs
+ hs-source-dirs: test, src
+ build-depends:
+ base
+ , containers
+ , haskeline
+ , megaparsec
+ , mtl
+ , tasty
+ , tasty-hunit
+ , tasty-quickcheck
+ default-language: Haskell2010
+ other-modules:
+ Eval
+ Lexer
+ Library
+ Parser
+ REPL
+ Research
