From 7d1b6a741d0b63cfca273c77ee83c630ca3afee1 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Thu, 30 Jan 2025 14:19:30 -0600 Subject: [PATCH] REPL import warning; version info in CLI Adds the ability to toggle result decoding in REPL. Adds several more useful functions to the base library. --- README.md | 10 +++-- demos/levelOrderTraversal.tri | 12 +++--- demos/size.tri | 11 ------ lib/base.tri | 69 ++++++++++++++++++++++++++++++++++- src/Eval.hs | 3 -- src/FileEval.hs | 22 +++++++---- src/Main.hs | 6 ++- src/REPL.hs | 64 +++++++++++++++++++------------- test/Spec.hs | 2 +- test/map.tri | 2 +- test/string.tri | 2 +- 11 files changed, 142 insertions(+), 61 deletions(-) diff --git a/README.md b/README.md index adfef14..5ccc97e 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,9 @@ ## 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 is under active development and you can expect breaking changes with nearly every commit. +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 should expect breaking changes with every commit.* tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)`. @@ -14,7 +16,7 @@ tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2) - Lambda abstraction syntax: `id = (\a : a)` - List, Number, and String literals: `[(2) ("Hello")]` - Function application: `not (not false)` -- Higher order/first-class functions: `map (\a : lconcat a "!") [("Hello")]` +- Higher order/first-class functions: `map (\a : append a "!") [("Hello")]` - Intensionality blurs the distinction between functions and data (see REPL examples) - Simple module system for code organization @@ -23,9 +25,9 @@ tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2) ``` tricu < -- Anything after `--` on a single line is a comment tricu < id = (\a : a) -- Lambda abstraction is eliminated to tree calculus terms -tricu < head (map (\i : lconcat i " world!") [("Hello, ")]) +tricu < head (map (\i : append i " world!") [("Hello, ")]) tricu > "Hello, world!" -tricu < id (head (map (\i : lconcat i " world!") [("Hello, ")])) +tricu < id (head (map (\i : append i " world!") [("Hello, ")])) tricu > "Hello, world!" tricu < -- Intensionality! We can inspect the structure of a function or data. diff --git a/demos/levelOrderTraversal.tri b/demos/levelOrderTraversal.tri index d2b8187..2a5d4ac 100644 --- a/demos/levelOrderTraversal.tri +++ b/demos/levelOrderTraversal.tri @@ -37,21 +37,21 @@ processLevel = y (\self queue : if (emptyList? queue) [] (pair (map label queue) (self (filter (\node : not? (emptyList? node)) - (lconcat (map left queue) (map right queue)))))) + (append (map left queue) (map right queue)))))) levelOrderTraversal_ = \a : processLevel (t a t) toLineString = y (\self levels : if (emptyList? levels) "" - (lconcat - (lconcat (map (\x : lconcat x " ") (head levels)) "") - (if (emptyList? (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels)))))) + (append + (append (map (\x : append x " ") (head levels)) "") + (if (emptyList? (tail levels)) "" (append (t (t 10 t) t) (self (tail levels)))))) levelOrderToString = \s : toLineString (levelOrderTraversal_ s) -flatten = foldl (\acc x : lconcat acc x) "" +flatten = foldl (\acc x : append acc x) "" -levelOrderTraversal = \s : lconcat (t 10 t) (flatten (levelOrderToString s)) +levelOrderTraversal = \s : append (t 10 t) (flatten (levelOrderToString s)) exampleOne = levelOrderTraversal [("1") [("2") [("4") t t] t] diff --git a/demos/size.tri b/demos/size.tri index fe91119..83c8937 100644 --- a/demos/size.tri +++ b/demos/size.tri @@ -2,17 +2,6 @@ main = size size -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 diff --git a/lib/base.tri b/lib/base.tri index 13527d4..a1930ac 100644 --- a/lib/base.tri +++ b/lib/base.tri @@ -15,6 +15,8 @@ y = ((\mut wait fun : wait mut (\x : fun (wait mut x))) (\x : x x) (\a0 a1 a2 : t (t a0) (t t a2) a1)) +compose = \f g x : f (g x) + triage = \leaf stem fork : t (t leaf stem) fork test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork") @@ -35,7 +37,14 @@ emptyList? = matchList true (\_ _ : false) head = matchList t (\head _ : head) tail = matchList t (\_ tail : tail) -lconcat = y (\self : matchList +or? = (\x y : + matchBool + (matchBool (t t) (t t) y) + (matchBool (t t) 0 y) + x) +xor? = matchBool id not? + +append = y (\self : matchList (\k : k) (\h r k : pair h (self r k))) @@ -71,6 +80,10 @@ equal? = y (\self : triage (\_ : false) (\bx by : lAnd (self ax bx) (self ay by)))) +lExist? = y (\self x : matchList + false + (\h z : or? (equal? x h) (self x z))) + filter_ = y (\self : matchList (\_ : t) (\head tail f : matchBool (t head) i (f head) (self tail f))) @@ -81,3 +94,57 @@ 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 + +succ = y (\self : + triage + 1 + t + (triage + (t (t t)) + (\_ tail : t t (self tail)) + t)) + +length = y (\self : matchList + 0 + (\_ tail : succ (self tail))) + +reverse = y (\self : matchList + t + (\head tail : append (self tail) (pair head t))) + +snoc = y (\self x : matchList + (pair x t) + (\h z : pair h (self x z))) + +count = y (\self x : matchList + 0 + (\h z : matchBool + (succ (self x z)) + (self x z) + (equal? x h))) + +last = y (\self : matchList + t + (\hd tl : matchBool + hd + (self tl) + (emptyList? tl))) + +all? = y (\self pred : matchList + true + (\h z : and? (pred h) (self pred z))) + +any? = y (\self pred : matchList + false + (\h z : or? (pred h) (self pred z))) + +unique_ = y (\self seen : matchList + t + (\head rest : matchBool + (self seen rest) + (pair head (self (pair head seen) rest)) + (lExist? head seen))) +unique = \xs : unique_ t xs + +intersect = \xs ys : filter (\x : lExist? x ys) xs +union = \xs ys : unique (append xs ys) diff --git a/src/Eval.hs b/src/Eval.hs index c263fd7..202bcd7 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -74,8 +74,6 @@ elimLambda = go -- Composition optimization go (SLambda [f] (SLambda [g] (SLambda [x] body))) | body == SApp (SVar f) (SApp (SVar g) (SVar x)) = _B - go (SLambda [f] (SLambda [x] (SLambda [y] body))) - | body == SApp (SApp (SVar f) (SVar y)) (SVar x) = _C -- General elimination go (SLambda (v:vs) body) | null vs = toSKI v (elimLambda body) @@ -97,7 +95,6 @@ elimLambda = go _K = parseSingle "t t" _I = parseSingle "t (t (t t)) t" _B = parseSingle "t (t (t t (t (t (t t t)) t))) (t t)" - _C = parseSingle "t (t (t (t (t t (t (t (t t t)) t))) (t (t (t t (t t))) (t (t (t t t)) t)))) (t t (t t))" _TRIAGE = parseSingle "t (t (t t (t (t (t t t))))) t" isFree :: String -> TricuAST -> Bool diff --git a/src/FileEval.hs b/src/FileEval.hs index 151dcc6..af8ddc0 100644 --- a/src/FileEval.hs +++ b/src/FileEval.hs @@ -60,7 +60,8 @@ preprocessFile' inProgress filePath Right asts -> do let (imports, nonImports) = partition isImport asts let newInProgress = Set.insert filePath inProgress - importedASTs <- concat <$> mapM (processImport newInProgress "") imports + importedASTs <- concat <$> + mapM (processImport newInProgress "") imports pure $ importedASTs ++ nonImports where isImport :: TricuAST -> Bool @@ -116,13 +117,20 @@ nsBodyScoped moduleName args body = case body of if name `elem` args then SVar name else nsBody moduleName (SVar name) - SApp func arg -> SApp (nsBodyScoped moduleName args func) (nsBodyScoped moduleName args arg) - SLambda innerArgs innerBody -> SLambda innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody) - SList items -> SList (map (nsBodyScoped moduleName args) items) - TFork left right -> TFork (nsBodyScoped moduleName args left) (nsBodyScoped moduleName args right) - TStem subtree -> TStem (nsBodyScoped moduleName args subtree) + SApp func arg -> + SApp (nsBodyScoped moduleName args func) (nsBodyScoped moduleName args arg) + SLambda innerArgs innerBody -> + SLambda innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody) + SList items -> + SList (map (nsBodyScoped moduleName args) items) + TFork left right -> + TFork (nsBodyScoped moduleName args left) + (nsBodyScoped moduleName args right) + TStem subtree -> + TStem (nsBodyScoped moduleName args subtree) SDef name innerArgs innerBody -> - SDef (nsVariable moduleName name) innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody) + SDef (nsVariable moduleName name) innerArgs + (nsBodyScoped moduleName (args ++ innerArgs) innerBody) other -> other isPrefixed :: String -> Bool diff --git a/src/Main.hs b/src/Main.hs index fe772ee..2a52b5c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -8,7 +8,9 @@ import Research import Control.Monad (foldM) import Control.Monad.IO.Class (liftIO) +import Data.Version (showVersion) import Text.Megaparsec (runParser) +import Paths_tricu (version) import System.Console.CmdArgs import qualified Data.Map as Map @@ -52,10 +54,12 @@ decodeMode = TDecode main :: IO () main = do + let versionStr = "tricu Evaluator and REPL " ++ showVersion version args <- cmdArgs $ modes [replMode, evaluateMode, decodeMode] &= help "tricu: Exploring Tree Calculus" &= program "tricu" - &= summary "tricu Evaluator and REPL" + &= summary versionStr + &= versionArg [explicit, name "version", summary versionStr] case args of Repl -> do putStrLn "Welcome to the tricu REPL" diff --git a/src/REPL.hs b/src/REPL.hs index 26f90b5..db50b90 100644 --- a/src/REPL.hs +++ b/src/REPL.hs @@ -6,55 +6,69 @@ import Lexer import Parser import Research -import Control.Exception (SomeException, catch) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Catch (handle, MonadCatch) -import Data.Char (isSpace) -import Data.List (dropWhile, dropWhileEnd, intercalate) +import Control.Exception (SomeException, catch) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Catch (handle, MonadCatch) +import Data.Char (isSpace) +import Data.List ( dropWhile + , dropWhileEnd + , intercalate + , isPrefixOf) import System.Console.Haskeline import qualified Data.Map as Map repl :: Env -> IO () -repl env = runInputT defaultSettings (withInterrupt (loop env)) +repl env = runInputT defaultSettings (withInterrupt (loop env True)) where - loop :: Env -> InputT IO () - loop env = handle (interruptHandler env) $ do + loop :: Env -> Bool -> InputT IO () + loop env decode = handle (interruptHandler env decode) $ do minput <- getInputLine "tricu < " case minput of Nothing -> outputStrLn "Exiting tricu" Just s + | strip s == "" -> loop env decode | strip s == "!exit" -> outputStrLn "Exiting tricu" - | strip s == "" -> loop env - | strip s == "!import" -> do + | strip s == "!decode" -> do + outputStrLn $ "Decoding " ++ (if decode then "disabled" else "enabled") + loop env (not decode) + | "!import" `isPrefixOf` strip s -> do + let afterImport = dropWhile (== ' ') $ drop (length ("!import" :: String)) (strip s) + if not (null afterImport) + then outputStrLn "Warning: REPL imports are interactive; \ + \additional arguments are ignored." + else pure () path <- getInputLine "File path to load < " case path of Nothing -> do outputStrLn "No input received; stopping import." - loop env + loop env decode Just p -> do - loadedEnv <- liftIO $ evaluateFileWithContext env + loadedEnv <- liftIO $ evaluateFileWithContext env (strip p) `catch` \e -> errorHandler env e - loop $ Map.delete "!result" (Map.union loadedEnv env) - | take 2 s == "--" -> loop env + loop (Map.delete "!result" (Map.union loadedEnv env)) decode + | take 2 s == "--" -> loop env decode | otherwise -> do - newEnv <- liftIO $ processInput env s `catch` errorHandler env - loop newEnv + newEnv <- liftIO $ processInput env s decode `catch` errorHandler env + loop newEnv decode - interruptHandler :: Env -> Interrupt -> InputT IO () - interruptHandler env _ = do + interruptHandler :: Env -> Bool -> Interrupt -> InputT IO () + interruptHandler env decode _ = do outputStrLn "Interrupted with CTRL+C\n\ \You can use the !exit command or CTRL+D to exit" - loop env + loop env decode - processInput :: Env -> String -> IO Env - processInput env input = do + processInput :: Env -> String -> Bool -> IO Env + processInput env input decode = do let asts = parseTricu input newEnv = evalTricu env asts - if - | Just r <- Map.lookup "!result" newEnv -> do - putStrLn $ "tricu > " ++ decodeResult r - | otherwise -> return () + case Map.lookup "!result" newEnv of + Just r -> do + putStrLn $ "tricu > " ++ + if decode + then decodeResult r + else show r + Nothing -> pure () return newEnv errorHandler :: Env -> SomeException -> IO (Env) diff --git a/test/Spec.hs b/test/Spec.hs index 2ed06f5..d657a60 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -468,7 +468,7 @@ baseLibrary = testGroup "Library Tests" , testCase "Concatenate strings" $ do library <- evaluateFile "./lib/base.tri" - let input = "lconcat \"Hello, \" \"world!\"" + let input = "append \"Hello, \" \"world!\"" env = decodeResult $ result $ evalTricu library (parseTricu input) env @?= "\"Hello, world!\"" diff --git a/test/map.tri b/test/map.tri index b534482..95fb49f 100644 --- a/test/map.tri +++ b/test/map.tri @@ -1,2 +1,2 @@ -x = map (\i : lconcat "Successfully concatenated " i) [("two strings!")] +x = map (\i : append "Successfully concatenated " i) [("two strings!")] main = equal? x [("Successfully concatenated two strings!")] diff --git a/test/string.tri b/test/string.tri index a0c96c8..db492a2 100644 --- a/test/string.tri +++ b/test/string.tri @@ -1 +1 @@ -head (map (\i : lconcat "String " i) [("test!")]) +head (map (\i : append "String " i) [("test!")])