README.md

@@ -41,21 +41,13 @@ tricu > "(t (t (t t) (t t t)) (t t (t t t)))"
 tricu < -- or calculate its size (/demos/size.tri)
 tricu < size not?
 tricu > 12
-
-tricu < -- REPL Commands:
-tricu < !definitions  -- Lists all available definitions
-tricu < !output       -- Change output format (Tree, FSL, AST, etc.)
-tricu < !import       -- Import definitions from a file
-tricu < !exit         -- Exit the REPL
-tricu < !clear        -- ANSI screen clear
-tricu < !save         -- Save all REPL definitions to a file that you can !import
-tricu < !reset        -- Clear all REPL definitions
-tricu < !version      -- Print tricu version
 ```
 
 ## Installation and Use
 
-You can easily build and run this project using [Nix](https://nixos.org/download/).
+[Releases are available for Linux.](https://git.eversole.co/James/tricu/releases)
+
+Or you can easily build and run this project using [Nix](https://nixos.org/download/).
 
 - Quick Start (REPL): 
   - `nix run git+https://git.eversole.co/James/tricu`
@@ -92,12 +84,6 @@ tricu decode [OPTIONS]
                     Defaults to stdin.
 ```
 
-## Collaborating
-
-I am happy to accept issue reports, pull requests, or questions about tricu [via email](mailto:james@eversole.co).
-
-If you want to collaborate but don't want to email back-and-forth, please reach out via email once to let me know and I will provision a git.eversole.co account for you.
-
 ## Acknowledgements 
 
 Tree Calculus was discovered by [Barry Jay](https://github.com/barry-jay-personal/blog). 

lib/list.tri

@@ -65,4 +65,13 @@ 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)

lib/patterns.tri

@@ -22,15 +22,14 @@ match = (\value patterns :
 
 otherwise = const (t t)
 
-matchExample = (\x : match x
-  [[(equal? 1)  (\_ : "one")]
-  [(equal? 2)  (\_ : "two")]
-  [(equal? 3)  (\_ : "three")]
-  [(equal? 4)  (\_ : "four")]
-  [(equal? 5)  (\_ : "five")]
-  [(equal? 6)  (\_ : "six")]
-  [(equal? 7)  (\_ : "seven")]
-  [(equal? 8)  (\_ : "eight")]
-  [(equal? 9)  (\_ : "nine")]
-  [(equal? 10) (\_ : "ten")]
-  [ otherwise  (\_ : "I ran out of fingers!")]])
+-- matchExample = (\x : match x [[(equal? 1)  (\_ : "one")]
+--                               [(equal? 2)  (\_ : "two")]
+--                               [(equal? 3)  (\_ : "three")]
+--                               [(equal? 4)  (\_ : "four")]
+--                               [(equal? 5)  (\_ : "five")]
+--                               [(equal? 6)  (\_ : "six")]
+--                               [(equal? 7)  (\_ : "seven")]
+--                               [(equal? 8)  (\_ : "eight")]
+--                               [(equal? 9)  (\_ : "nine")]
+--                               [(equal? 10) (\_ : "ten")]
+--                               [ otherwise  (\_ : "I ran out of fingers!")]])

src/Lexer.hs

@@ -3,7 +3,6 @@ module Lexer where
 import Research
 
 import Control.Monad               (void)
-import Data.Functor                (($>))
 import Data.Void
 import Text.Megaparsec
 import Text.Megaparsec.Char hiding (space)
@@ -55,7 +54,7 @@ lexTricu input = case runParser tricuLexer "" input of
 
 
 keywordT :: Lexer LToken
-keywordT = string "t" *> notFollowedBy alphaNumChar $> LKeywordT
+keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT
 
 identifier :: Lexer LToken
 identifier = do
@@ -64,7 +63,7 @@ identifier = do
               <|> digitChar <|> char '_' <|> char '-' <|> char '?'
               <|> char '$'  <|> char '#' <|> char '@' <|> char '%'
   let name = first : rest
-  if name == "t" || name == "!result"
+  if (name == "t" || name == "!result")
     then fail "Keywords (`t`, `!result`) cannot be used as an identifier"
     else return (LIdentifier name)
 
@@ -77,7 +76,7 @@ namespace = do
   return (LNamespace name)
 
 dot :: Lexer LToken
-dot = char '.' $> LDot
+dot = char '.' *> pure LDot
 
 lImport :: Lexer LToken
 lImport = do
@@ -89,28 +88,28 @@ lImport = do
   return (LImport path name)
 
 assign :: Lexer LToken
-assign = char '=' $> LAssign
+assign = char '=' *> pure LAssign
 
 colon :: Lexer LToken
-colon = char ':' $> LColon
+colon = char ':' *> pure LColon
 
 backslash :: Lexer LToken
-backslash = char '\\' $> LBackslash
+backslash = char '\\' *> pure LBackslash
 
 openParen :: Lexer LToken
-openParen = char '(' $> LOpenParen
+openParen = char '(' *> pure LOpenParen
 
 closeParen :: Lexer LToken
-closeParen = char ')' $> LCloseParen
+closeParen = char ')' *> pure LCloseParen
 
 openBracket :: Lexer LToken
-openBracket = char '[' $> LOpenBracket
+openBracket = char '[' *> pure LOpenBracket
 
 closeBracket :: Lexer LToken
-closeBracket = char ']' $> LCloseBracket
+closeBracket = char ']' *> pure LCloseBracket
 
 lnewline :: Lexer LToken
-lnewline = char '\n' $> LNewline
+lnewline = char '\n' *> pure LNewline
 
 sc :: Lexer ()
 sc = space

src/Parser.hs

@@ -3,12 +3,12 @@ module Parser where
 import Lexer
 import Research
 
-import Control.Monad             (void)
+import Control.Monad (void)
 import Control.Monad.State
-import Data.List.NonEmpty        (toList)
-import Data.Void                 (Void)
+import Data.List.NonEmpty (toList)
+import Data.Void (Void)
 import Text.Megaparsec
-import Text.Megaparsec.Error     (ParseErrorBundle, errorBundlePretty)
+import Text.Megaparsec.Error (ParseErrorBundle, errorBundlePretty)
 import qualified Data.Set as Set
 
 data PState = PState

src/REPL.hs

@@ -6,30 +6,26 @@ import Lexer
 import Parser
 import Research
 
-import Control.Exception         (IOException, SomeException, catch
-                                 , displayException)
-import Control.Monad             (forM_)
-import Control.Monad.Catch       (handle, MonadCatch)
+import Control.Exception         (SomeException, catch)
 import Control.Monad.IO.Class    (liftIO)
+import Control.Monad.Catch       (handle, MonadCatch)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
-import Data.Char                 (isSpace, isUpper)
-import Data.List                 (dropWhile, dropWhileEnd, isPrefixOf)
-import Data.Version (showVersion)
-import Paths_tricu (version)
+import Data.Char                 (isSpace)
+import Data.List                 ( dropWhile
+                                 , dropWhileEnd
+                                 , isPrefixOf)
 import System.Console.Haskeline
 
 import qualified Data.Map as Map
-import qualified Data.Text as T
-import qualified Data.Text.IO as T
 
 repl :: Env -> IO ()
-repl env = runInputT settings (withInterrupt (loop env Decode))
+repl env = runInputT settings (withInterrupt (loop env True))
   where
     settings :: Settings IO
     settings = Settings
       { complete = completeWord Nothing " \t" completeCommands
-      , historyFile = Just "~/.local/state/tricu/history"
+      , historyFile = Just ".tricu_history"
       , autoAddHistory = True
       }
 
@@ -37,35 +33,19 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
     completeCommands str = return $ map simpleCompletion $
       filter (str `isPrefixOf`) commands
       where
-        commands = [ "!exit"
-                   , "!output"
-                   , "!definitions"
-                   , "!import"
-                   , "!clear"
-                   , "!save"
-                   , "!reset"
-                   , "!version"
-                   ]
+        commands = ["!exit", "!decode", "!definitions", "!import"]
 
-    loop :: Env -> EvaluatedForm -> InputT IO ()
-    loop env form = handle (interruptHandler env form) $ 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 form
+          | strip s == "" -> loop env decode
           | strip s == "!exit" -> outputStrLn "Exiting tricu"
-          | strip s == "!clear" -> do
-              liftIO $ putStr "\ESC[2J\ESC[H"
-              loop env form
-          | strip s == "!reset" -> do
-              outputStrLn "Environment reset to initial state"
-              loop Map.empty form
-          | strip s == "!version" -> do
-              outputStrLn $ "tricu version " ++ showVersion version
-              loop env form
-          | "!save" `isPrefixOf` strip s -> handleSave env form
-          | strip s == "!output" -> handleOutput env form
+          | strip s == "!decode" -> do
+              outputStrLn $ "Decoding " ++ (if decode then "disabled" else "enabled")
+              loop env (not decode)
           | strip s == "!definitions" -> do
               let defs = Map.keys $ Map.delete "!result" env
               if null defs
@@ -73,86 +53,57 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
                 else do
                   outputStrLn "Available definitions:"
                   mapM_ outputStrLn defs
-              loop env form
-          | "!import" `isPrefixOf` strip s -> handleImport env form
-          | take 2 s == "--" -> loop env form
+              loop env decode
+          | "!import" `isPrefixOf` strip s -> handleImport env decode
+          | take 2 s == "--" -> loop env decode
           | otherwise -> do
-              newEnv <- liftIO $ processInput env s form `catch` errorHandler env
-              loop newEnv form
-
-    handleOutput :: Env -> EvaluatedForm -> InputT IO ()
-    handleOutput env currentForm = do
-      let formats = [Decode, TreeCalculus, FSL, AST, Ternary, Ascii]
-      outputStrLn "Available output formats:"
-      mapM_ (\(i, f) -> outputStrLn $ show i ++ ". " ++ show f)
-        (zip [1..] formats)
+              newEnv <- liftIO $ processInput env s decode `catch` errorHandler env
+              loop newEnv decode
 
+    handleImport :: Env -> Bool -> InputT IO ()
+    handleImport env decode = do
       result <- runMaybeT $ do
-        input <- MaybeT $ getInputLine "Select output format (1-6) < "
-        case reads input of
-          [(n, "")] | n >= 1 && n <= 6 ->
-            return $ formats !! (n-1)
-          _ -> MaybeT $ return Nothing
-
-      case result of
-        Nothing -> do
-          outputStrLn "Invalid selection. Keeping current output format."
-          loop env currentForm
-        Just newForm -> do
-          outputStrLn $ "Output format changed to: " ++ show newForm
-          loop env newForm
-
-    handleImport :: Env -> EvaluatedForm -> InputT IO ()
-    handleImport env form = do
-      res <- runMaybeT $ do
-        let fset = setComplete completeFilename defaultSettings
-        path <- MaybeT $ runInputT fset $
+        let fileSettings = setComplete completeFilename defaultSettings
+        path <- MaybeT $ runInputT fileSettings $
           getInputLineWithInitial "File path to load < " ("", "")
 
-        text <- MaybeT $ liftIO $ handle (\e -> do
-            putStrLn $ "Error reading file: " ++ displayException (e :: IOException)
-            return Nothing
-          ) $ Just <$> readFile (strip path)
+        contents <- liftIO $ readFile (strip path)
 
-        case parseProgram (lexTricu text) of
-          Left err -> do
-            lift $ outputStrLn $ "Parse error: " ++ handleParseError err
-            MaybeT $ return Nothing
-          Right ast -> do
-            ns <- MaybeT $ runInputT defaultSettings $
-              getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
+        if | Left err <- parseProgram (lexTricu contents) -> do
+               lift $ outputStrLn $ "Parse error: " ++ handleParseError err
+               MaybeT $ return Nothing
+           | Right ast <- parseProgram (lexTricu contents) -> do
+               ns <- MaybeT $ runInputT defaultSettings $
+                 getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
 
-            let name = strip ns
-            if (name /= "!Local" && (null name || not (isUpper (head name)))) then do
-                lift $ outputStrLn "Namespace must start with an uppercase letter"
-                MaybeT $ return Nothing
-            else do
-                prog <- liftIO $ preprocessFile (strip path)
-                let code = case name of
-                      "!Local" -> prog
-                      _ -> nsDefinitions name prog
-                    env' = evalTricu env code
-                return env'
-      case res of
-        Nothing -> do
-          outputStrLn "Import cancelled"
-          loop env form
-        Just env' ->
-          loop (Map.delete "!result" env') form
+               processedAst <- liftIO $ preprocessFile (strip path)
+               let namespacedAst | strip ns == "!Local" = processedAst
+                                | otherwise = nsDefinitions (strip ns) processedAst
+                   loadedEnv = evalTricu env namespacedAst
+               return loadedEnv
 
-    interruptHandler :: Env -> EvaluatedForm -> Interrupt -> InputT IO ()
-    interruptHandler env form _ = do
+      if | Nothing <- result -> do
+             outputStrLn "Import cancelled."
+             loop env decode
+         | Just loadedEnv <- result ->
+             loop (Map.delete "!result" loadedEnv) decode
+
+    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 form
+      loop env decode
 
-    processInput :: Env -> String -> EvaluatedForm -> IO Env
-    processInput env input form = do
+    processInput :: Env -> String -> Bool -> IO Env
+    processInput env input decode = do
       let asts   = parseTricu input
           newEnv = evalTricu env asts
       case Map.lookup "!result" newEnv of
         Just r -> do
-          putStrLn $ "tricu > " ++ formatResult form r
+          putStrLn $ "tricu > " ++
+            if decode
+              then decodeResult r
+              else show r
         Nothing -> pure ()
       return newEnv
 
@@ -163,28 +114,3 @@ repl env = runInputT settings (withInterrupt (loop env Decode))
 
     strip :: String -> String
     strip = dropWhileEnd isSpace . dropWhile isSpace
-
-    handleSave :: Env -> EvaluatedForm -> InputT IO ()
-    handleSave env form = do
-      let fset = setComplete completeFilename defaultSettings
-      path <- runInputT fset $
-        getInputLineWithInitial "File to save < " ("", "")
-
-      case path of
-        Nothing -> do
-          outputStrLn "Save cancelled"
-          loop env form
-        Just p -> do
-          let definitions = Map.toList $ Map.delete "!result" env
-              filepath = strip p
-
-          outputStrLn "Starting save..."
-          liftIO $ writeFile filepath ""
-          outputStrLn "File created..."
-          forM_ definitions $ \(name, value) -> do
-            let content = name ++ " = " ++ formatResult TreeCalculus value ++ "\n"
-            outputStrLn $ "Writing definition: " ++ name ++ " with length " ++ show (length content)
-            liftIO $ appendFile filepath content
-          outputStrLn $ "Saved " ++ show (length definitions) ++ " definitions to " ++ p
-
-          loop env form

src/Research.hs

@@ -1,5 +1,6 @@
 module Research where
 
+import Control.Monad.State
 import Data.List                 (intercalate)
 import Data.Map                  (Map)
 import Data.Text                 (Text, replace)
@@ -54,24 +55,15 @@ data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii | Decode
 -- Environment containing previously evaluated TC terms
 type Env = Map.Map String T
 
--- Tree Calculus Reduction Rules
-{- 
-  The t operator is left associative.
-  1.  t  t      a b       -> a
-  2.  t (t a)   b c       -> a c (b c)
-  3a. t (t a b) c t       -> a
-  3b. t (t a b) c (t u)   -> b u
-  3c. t (t a b) c (t u v) -> c u v
--}
+-- Tree Calculus Reduction
 apply :: T -> T -> T
-apply (Fork Leaf a)         _         = a
-apply (Fork (Stem a) b) c             = apply (apply a c) (apply b c)
-apply (Fork (Fork a  b) c)  Leaf      = a
-apply (Fork (Fork a  b) c) (Stem u)   = apply b u
-apply (Fork (Fork a  b) c) (Fork u v) = apply (apply c u) v
--- Left associative `t`
-apply  Leaf b                         = Stem b
-apply (Stem a) b                      = Fork a b
+apply Leaf b                            = Stem b
+apply (Stem a) b                        = Fork a b
+apply (Fork Leaf a) _                   = a
+apply (Fork (Stem a1) a2) b             = apply (apply a1 b) (apply a2 b)
+apply (Fork (Fork a1 a2) a3) Leaf       = a1
+apply (Fork (Fork a1 a2) a3) (Stem u)   = apply a2 u
+apply (Fork (Fork a1 a2) a3) (Fork u v) = apply (apply a3 u) v
 
 -- Booleans
 _false :: T
@@ -85,7 +77,7 @@ _not = Fork (Fork _true (Fork Leaf _false)) Leaf
 
 -- Marshalling
 ofString :: String -> T
-ofString str = ofList $ map (ofNumber . fromEnum) str
+ofString str = ofList (map ofNumber (map fromEnum str))
 
 ofNumber :: Int -> T
 ofNumber 0 = Leaf
@@ -95,7 +87,8 @@ ofNumber n =
     (ofNumber (n `div` 2))
 
 ofList :: [T] -> T
-ofList = foldr Fork Leaf
+ofList [] = Leaf
+ofList (x:xs) = Fork x (ofList xs)
 
 toNumber :: T -> Either String Int
 toNumber Leaf = Right 0
@@ -133,7 +126,7 @@ toSimpleT s = T.unpack
   $ replace "Fork" "t"
   $ replace "Stem" "t"
   $ replace "Leaf" "t"
-  $ T.pack s
+  $ (T.pack s)
 
 toTernaryString :: T -> String
 toTernaryString Leaf = "0"
@@ -160,18 +153,8 @@ toAscii tree = go tree "" True
         ++ go right (prefix ++ (if isLast then "    " else "|   ")) True
 
 decodeResult :: T -> String
-decodeResult Leaf = "t"
-decodeResult tc =
-  case (toString tc, toList tc, toNumber tc) of
-    (Right s, _, _) | all isCommonChar s -> "\"" ++ s ++ "\""
-    (_, _, Right n) -> show n
-    (_, Right xs@(_:_), _) -> "[" ++ intercalate ", " (map decodeResult xs) ++ "]"
-    (_, Right [], _) -> "[]"
-    _ -> formatResult TreeCalculus tc
-  where
-    isCommonChar c =
-      let n = fromEnum c
-      in (n >= 32 && n <= 126)
-         || n == 9
-         || n == 10
-         || n == 13
+decodeResult tc
+  | Right num  <- toNumber tc = show num
+  | Right str  <- toString tc = "\"" ++ str ++ "\""
+  | Right list <- toList tc   = "[" ++ intercalate ", " (map decodeResult list) ++ "]"
+  | otherwise                 = formatResult TreeCalculus tc

test/Spec.hs

@@ -34,7 +34,6 @@ tests = testGroup "Tricu Tests"
   , fileEval
   , modules
   , demos
-  , decoding
   ]
 
 lexer :: TestTree
@@ -330,20 +329,20 @@ lambdas = testGroup "Lambda Evaluation Tests"
         let input = "f = (\\x : (\\y : x y))\ng = (\\z : z)\nf g t"
         runTricu input @?= "Leaf"
 
-  , testCase "Lambda applied to string literal" $ do
+  , testCase "Lambda with a string literal" $ do
         let input = "f = (\\x : x)\nf \"hello\""
         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 applied to integer literal" $ do
+   , testCase "Lambda with an integer literal" $ do
         let input = "f = (\\x : x)\nf 42"
         runTricu input @?= "Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) Leaf)))))"
 
-   , testCase "Lambda applied to list literal" $ do
+   , testCase "Lambda with a list literal" $ do
         let input = "f = (\\x : x)\nf [t (t t)]"
         runTricu input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
 
-  , testCase "Lambda containing list literal" $ do
+  , testCase "Lambda with list literal" $ do
       let input = "(\\a : [(a)]) 1"
       runTricu input @?= "Fork (Fork (Stem Leaf) Leaf) Leaf"
   ]
@@ -523,35 +522,3 @@ demos = testGroup "Test provided demo functionality"
       res     <- liftIO $ evaluateFileResult "./demos/levelOrderTraversal.tri"
       decodeResult res @?= "\"\n1 \n2 3 \n4 5 6 7 \n8 11 10 9 12 \""
   ]
-
-decoding :: TestTree
-decoding = testGroup "Decoding Tests"
-  [ testCase "Decode Leaf" $ do
-      decodeResult Leaf @?= "t"
-
-  , testCase "Decode list of non-ASCII numbers" $ do
-      let input = ofList [ofNumber 1, ofNumber 14, ofNumber 6]
-      decodeResult input @?= "[1, 14, 6]"
-
-  , testCase "Decode list of ASCII numbers as a string" $ do
-      let input = ofList [ofNumber 97, ofNumber 98, ofNumber 99]
-      decodeResult input @?= "\"abc\""
-
-  , testCase "Decode small number" $ do
-      decodeResult (ofNumber 42) @?= "42"
-
-  , testCase "Decode large number" $ do
-      decodeResult (ofNumber 9999) @?= "9999"
-
-  , testCase "Decode string in list" $ do
-      let input = ofList [ofString "hello", ofString "world"]
-      decodeResult input @?= "[\"hello\", \"world\"]"
-
-  , testCase "Decode mixed list with strings" $ do
-      let input = ofList [ofString "hello", ofNumber 42, ofString "world"]
-      decodeResult input @?= "[\"hello\", 42, \"world\"]"
-
-  , testCase "Decode nested lists with strings" $ do
-      let input = ofList [ofList [ofString "nested"], ofString "string"]
-      decodeResult input @?= "[[\"nested\"], \"string\"]"
-  ]

tricu.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           tricu
-version:        0.18.1
+version:        0.16.0
 description:    A micro-language for exploring Tree Calculus
 author:         James Eversole
 maintainer:     james@eversole.co