commit 04f04975f47e852b367ee531ea2dc3ccb67ff59d
parent 15d67812b400101f23bc13869a6ce93c4ff65228
Author: James Eversole <james@eversole.co>
Date: Thu, 30 Jan 2025 14:19:30 -0600
REPL import warning; version info in CLI
Diffstat:
11 files changed, 142 insertions(+), 61 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -1 +1 @@
-head (map (\i : lconcat "String " i) [("test!")])
+head (map (\i : append "String " i) [("test!")])
