From c30f17367f28bd93a7ba318a2dc3a459fbbf5157 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Sun, 29 Dec 2024 08:29:25 -0600 Subject: [PATCH] Rename from sapling to tricu --- README.md | 43 ++++++++--------- flake.nix | 6 +-- src/Eval.hs | 32 ++++++------- src/Lexer.hs | 8 ++-- src/Library.hs | 2 +- src/Main.hs | 8 ++-- src/Parser.hs | 72 ++++++++++++++--------------- src/REPL.hs | 4 +- test/Spec.hs | 90 ++++++++++++++++++------------------ sapling.cabal => tricu.cabal | 6 +-- 10 files changed, 136 insertions(+), 135 deletions(-) rename sapling.cabal => tricu.cabal (94%) diff --git a/README.md b/README.md index 6432be3..26953fb 100644 --- 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 index 60a8798..938bc83 100644 --- 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/src/Eval.hs b/src/Eval.hs index 3732342..d840b28 100644 --- 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 index 3af7799..9c69420 100644 --- 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 index b2af155..57fe0a9 100644 --- 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 index e65da0c..79e6db1 100644 --- 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 index 8ee22e8..b5b404b 100644 --- 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 index 1347061..096ddf5 100644 --- 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 index 603bc7d..b59647b 100644 --- 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/sapling.cabal b/tricu.cabal similarity index 94% rename from sapling.cabal rename to tricu.cabal index c3da8e7..5f92536 100644 --- a/sapling.cabal +++ b/tricu.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 -name: sapling +name: tricu version: 0.4.0 description: A micro-language for exploring Tree Calculus author: James Eversole @@ -12,7 +12,7 @@ build-type: Simple extra-source-files: README.md -executable sapling +executable tricu main-is: Main.hs hs-source-dirs: src @@ -41,7 +41,7 @@ executable sapling Research default-language: Haskell2010 -test-suite sapling-tests +test-suite tricu-tests type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test, src