Revert flake.nix

Also removes some broken list library functions

README.md

@@ -41,13 +41,21 @@ 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
 
-[Releases are available for Linux.](https://git.eversole.co/James/tricu/releases)
+You can easily build and run this project using [Nix](https://nixos.org/download/).
-
-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`
@@ -84,6 +92,12 @@ 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,13 +65,4 @@ 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,14 +22,15 @@ match = (\value patterns :
 
 otherwise = const (t t)
 
--- matchExample = (\x : match x [[(equal? 1)  (\_ : "one")]
+matchExample = (\x : match x
---                               [(equal? 2)  (\_ : "two")]
+  [[(equal? 1)  (\_ : "one")]
---                               [(equal? 3)  (\_ : "three")]
+  [(equal? 2)  (\_ : "two")]
---                               [(equal? 4)  (\_ : "four")]
+  [(equal? 3)  (\_ : "three")]
---                               [(equal? 5)  (\_ : "five")]
+  [(equal? 4)  (\_ : "four")]
---                               [(equal? 6)  (\_ : "six")]
+  [(equal? 5)  (\_ : "five")]
---                               [(equal? 7)  (\_ : "seven")]
+  [(equal? 6)  (\_ : "six")]
---                               [(equal? 8)  (\_ : "eight")]
+  [(equal? 7)  (\_ : "seven")]
---                               [(equal? 9)  (\_ : "nine")]
+  [(equal? 8)  (\_ : "eight")]
---                               [(equal? 10) (\_ : "ten")]
+  [(equal? 9)  (\_ : "nine")]
---                               [ otherwise  (\_ : "I ran out of fingers!")]])
+  [(equal? 10) (\_ : "ten")]
+  [ otherwise  (\_ : "I ran out of fingers!")]])

src/Lexer.hs

@@ -3,6 +3,7 @@ module Lexer where
 import Research
 
 import Control.Monad               (void)
+import Data.Functor                (($>))
 import Data.Void
 import Text.Megaparsec
 import Text.Megaparsec.Char hiding (space)
@@ -54,7 +55,7 @@ lexTricu input = case runParser tricuLexer "" input of
 
 
 keywordT :: Lexer LToken
-keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT
+keywordT = string "t" *> notFollowedBy alphaNumChar $> LKeywordT
 
 identifier :: Lexer LToken
 identifier = do
@@ -63,7 +64,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)
 
@@ -76,7 +77,7 @@ namespace = do
   return (LNamespace name)
 
 dot :: Lexer LToken
-dot = char '.' *> pure LDot
+dot = char '.' $> LDot
 
 lImport :: Lexer LToken
 lImport = do
@@ -88,28 +89,28 @@ lImport = do
   return (LImport path name)
 
 assign :: Lexer LToken
-assign = char '=' *> pure LAssign
+assign = char '=' $> LAssign
 
 colon :: Lexer LToken
-colon = char ':' *> pure LColon
+colon = char ':' $> LColon
 
 backslash :: Lexer LToken
-backslash = char '\\' *> pure LBackslash
+backslash = char '\\' $> LBackslash
 
 openParen :: Lexer LToken
-openParen = char '(' *> pure LOpenParen
+openParen = char '(' $> LOpenParen
 
 closeParen :: Lexer LToken
-closeParen = char ')' *> pure LCloseParen
+closeParen = char ')' $> LCloseParen
 
 openBracket :: Lexer LToken
-openBracket = char '[' *> pure LOpenBracket
+openBracket = char '[' $> LOpenBracket
 
 closeBracket :: Lexer LToken
-closeBracket = char ']' *> pure LCloseBracket
+closeBracket = char ']' $> LCloseBracket
 
 lnewline :: Lexer LToken
-lnewline = char '\n' *> pure LNewline
+lnewline = char '\n' $> 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.List.NonEmpty        (toList)
-import Data.Void (Void)
+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,26 +6,30 @@ import Lexer
 import Parser
 import Research
 
-import Control.Exception         (SomeException, catch)
+import Control.Exception         (IOException, SomeException, catch
-import Control.Monad.IO.Class    (liftIO)
+                                 , displayException)
+import Control.Monad             (forM_)
 import Control.Monad.Catch       (handle, MonadCatch)
+import Control.Monad.IO.Class    (liftIO)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
-import Data.Char                 (isSpace)
+import Data.Char                 (isSpace, isUpper)
-import Data.List                 ( dropWhile
+import Data.List                 (dropWhile, dropWhileEnd, isPrefixOf)
-                                 , dropWhileEnd
+import Data.Version (showVersion)
-                                 , isPrefixOf)
+import Paths_tricu (version)
 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 True))
+repl env = runInputT settings (withInterrupt (loop env Decode))
   where
     settings :: Settings IO
     settings = Settings
       { complete = completeWord Nothing " \t" completeCommands
-      , historyFile = Just ".tricu_history"
+      , historyFile = Just "~/.local/state/tricu/history"
       , autoAddHistory = True
       }
 
@@ -33,19 +37,35 @@ repl env = runInputT settings (withInterrupt (loop env True))
     completeCommands str = return $ map simpleCompletion $
       filter (str `isPrefixOf`) commands
       where
-        commands = ["!exit", "!decode", "!definitions", "!import"]
+        commands = [ "!exit"
+                   , "!output"
+                   , "!definitions"
+                   , "!import"
+                   , "!clear"
+                   , "!save"
+                   , "!reset"
+                   , "!version"
+                   ]
 
-    loop :: Env -> Bool -> InputT IO ()
+    loop :: Env -> EvaluatedForm -> InputT IO ()
-    loop env decode = handle (interruptHandler env decode) $ do
+    loop env form = handle (interruptHandler env form) $ do
       minput <- getInputLine "tricu < "
       case minput of
         Nothing -> outputStrLn "Exiting tricu"
         Just s
-          | strip s == "" -> loop env decode
+          | strip s == "" -> loop env form
           | strip s == "!exit" -> outputStrLn "Exiting tricu"
-          | strip s == "!decode" -> do
+          | strip s == "!clear" -> do
-              outputStrLn $ "Decoding " ++ (if decode then "disabled" else "enabled")
+              liftIO $ putStr "\ESC[2J\ESC[H"
-              loop env (not decode)
+              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 == "!definitions" -> do
               let defs = Map.keys $ Map.delete "!result" env
               if null defs
@@ -53,57 +73,86 @@ repl env = runInputT settings (withInterrupt (loop env True))
                 else do
                   outputStrLn "Available definitions:"
                   mapM_ outputStrLn defs
-              loop env decode
+              loop env form
-          | "!import" `isPrefixOf` strip s -> handleImport env decode
+          | "!import" `isPrefixOf` strip s -> handleImport env form
-          | take 2 s == "--" -> loop env decode
+          | take 2 s == "--" -> loop env form
           | otherwise -> do
-              newEnv <- liftIO $ processInput env s decode `catch` errorHandler env
+              newEnv <- liftIO $ processInput env s form `catch` errorHandler env
-              loop newEnv decode
+              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)
 
-    handleImport :: Env -> Bool -> InputT IO ()
-    handleImport env decode = do
       result <- runMaybeT $ do
-        let fileSettings = setComplete completeFilename defaultSettings
+        input <- MaybeT $ getInputLine "Select output format (1-6) < "
-        path <- MaybeT $ runInputT fileSettings $
+        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 $
           getInputLineWithInitial "File path to load < " ("", "")
 
-        contents <- liftIO $ readFile (strip path)
+        text <- MaybeT $ liftIO $ handle (\e -> do
+            putStrLn $ "Error reading file: " ++ displayException (e :: IOException)
+            return Nothing
+          ) $ Just <$> readFile (strip path)
 
-        if | Left err <- parseProgram (lexTricu contents) -> do
+        case parseProgram (lexTricu text) of
-               lift $ outputStrLn $ "Parse error: " ++ handleParseError err
+          Left err -> do
-               MaybeT $ return Nothing
+            lift $ outputStrLn $ "Parse error: " ++ handleParseError err
-           | Right ast <- parseProgram (lexTricu contents) -> do
+            MaybeT $ return Nothing
-               ns <- MaybeT $ runInputT defaultSettings $
+          Right ast -> do
-                 getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
+            ns <- MaybeT $ runInputT defaultSettings $
+              getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
 
-               processedAst <- liftIO $ preprocessFile (strip path)
+            let name = strip ns
-               let namespacedAst | strip ns == "!Local" = processedAst
+            if (name /= "!Local" && (null name || not (isUpper (head name)))) then do
-                                | otherwise = nsDefinitions (strip ns) processedAst
+                lift $ outputStrLn "Namespace must start with an uppercase letter"
-                   loadedEnv = evalTricu env namespacedAst
+                MaybeT $ return Nothing
-               return loadedEnv
+            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
 
-      if | Nothing <- result -> do
+    interruptHandler :: Env -> EvaluatedForm -> Interrupt -> InputT IO ()
-             outputStrLn "Import cancelled."
+    interruptHandler env form _ = do
-             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 decode
+      loop env form
 
-    processInput :: Env -> String -> Bool -> IO Env
+    processInput :: Env -> String -> EvaluatedForm -> IO Env
-    processInput env input decode = do
+    processInput env input form = do
       let asts   = parseTricu input
           newEnv = evalTricu env asts
       case Map.lookup "!result" newEnv of
         Just r -> do
-          putStrLn $ "tricu > " ++
+          putStrLn $ "tricu > " ++ formatResult form r
-            if decode
-              then decodeResult r
-              else show r
         Nothing -> pure ()
       return newEnv
 
@@ -114,3 +163,28 @@ repl env = runInputT settings (withInterrupt (loop env True))
 
     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,6 +1,5 @@
 module Research where
 
-import Control.Monad.State
 import Data.List                 (intercalate)
 import Data.Map                  (Map)
 import Data.Text                 (Text, replace)
@@ -55,15 +54,24 @@ data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii | Decode
 -- Environment containing previously evaluated TC terms
 type Env = Map.Map String T
 
--- Tree Calculus Reduction
+-- 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
+-}
 apply :: T -> T -> T
-apply Leaf b                            = Stem b
+apply (Fork Leaf a)         _         = a
-apply (Stem a) b                        = Fork a b
+apply (Fork (Stem a) b) c             = apply (apply a c) (apply b c)
-apply (Fork Leaf a) _                   = a
+apply (Fork (Fork a  b) c)  Leaf      = a
-apply (Fork (Stem a1) a2) b             = apply (apply a1 b) (apply a2 b)
+apply (Fork (Fork a  b) c) (Stem u)   = apply b u
-apply (Fork (Fork a1 a2) a3) Leaf       = a1
+apply (Fork (Fork a  b) c) (Fork u v) = apply (apply c u) v
-apply (Fork (Fork a1 a2) a3) (Stem u)   = apply a2 u
+-- Left associative `t`
-apply (Fork (Fork a1 a2) a3) (Fork u v) = apply (apply a3 u) v
+apply  Leaf b                         = Stem b
+apply (Stem a) b                      = Fork a b
 
 -- Booleans
 _false :: T
@@ -77,7 +85,7 @@ _not = Fork (Fork _true (Fork Leaf _false)) Leaf
 
 -- Marshalling
 ofString :: String -> T
-ofString str = ofList (map ofNumber (map fromEnum str))
+ofString str = ofList $ map (ofNumber . fromEnum) str
 
 ofNumber :: Int -> T
 ofNumber 0 = Leaf
@@ -87,8 +95,7 @@ ofNumber n =
     (ofNumber (n `div` 2))
 
 ofList :: [T] -> T
-ofList [] = Leaf
+ofList = foldr Fork Leaf
-ofList (x:xs) = Fork x (ofList xs)
 
 toNumber :: T -> Either String Int
 toNumber Leaf = Right 0
@@ -126,7 +133,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"
@@ -153,8 +160,18 @@ toAscii tree = go tree "" True
         ++ go right (prefix ++ (if isLast then "    " else "|   ")) True
 
 decodeResult :: T -> String
-decodeResult tc
+decodeResult Leaf = "t"
-  | Right num  <- toNumber tc = show num
+decodeResult tc =
-  | Right str  <- toString tc = "\"" ++ str ++ "\""
+  case (toString tc, toList tc, toNumber tc) of
-  | Right list <- toList tc   = "[" ++ intercalate ", " (map decodeResult list) ++ "]"
+    (Right s, _, _) | all isCommonChar s -> "\"" ++ s ++ "\""
-  | otherwise                 = formatResult TreeCalculus tc
+    (_, _, 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

test/Spec.hs

@@ -34,6 +34,7 @@ tests = testGroup "Tricu Tests"
   , fileEval
   , modules
   , demos
+  , decoding
   ]
 
 lexer :: TestTree
@@ -329,20 +330,20 @@ lambdas = testGroup "Lambda Evaluation Tests"
         let input = "f = (\\x : (\\y : x y))\ng = (\\z : z)\nf g t"
         runTricu input @?= "Leaf"
 
-  , testCase "Lambda with a string literal" $ do
+  , testCase "Lambda applied to 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 with an integer literal" $ do
+   , testCase "Lambda applied to 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 with a list literal" $ do
+   , testCase "Lambda applied to list literal" $ do
         let input = "f = (\\x : x)\nf [t (t t)]"
         runTricu input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
 
-  , testCase "Lambda with list literal" $ do
+  , testCase "Lambda containing list literal" $ do
       let input = "(\\a : [(a)]) 1"
       runTricu input @?= "Fork (Fork (Stem Leaf) Leaf) Leaf"
   ]
@@ -522,3 +523,35 @@ 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.16.0
+version:        0.18.1
 description:    A micro-language for exploring Tree Calculus
 author:         James Eversole
 maintainer:     james@eversole.co