0.5.0 release commit

Additionally sorts gitignore and adds attempted decoding of lists back
to the REPL

.gitignore

@@ -1,14 +1,11 @@
-bin/
-data/Purr.sqlite
-data/encryptionKey
-/result
-/config.dhall
-/Dockerfile
-/docker-stack.yml
-.stack-work/
 *.swp
-dist*
+*.txt
 *~
 .env
+.stack-work/
+/Dockerfile
+/config.dhall
+/result
 WD
-*.hs.txt
+bin/
+dist*

README.md

@@ -19,42 +19,62 @@ tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)
 ## What does it look like?
 
 ```
--- Anything after `--` on a single line is a comment
--- We can define functions or "variables" as Tree Calculus values
-false = t 
-_ = t
-true = t t
--- We can define functions as lambda expressions that are eliminated to Tree
--- Calculus terms.
-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! We can inspect program structure, not just inputs/outputs:
-test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork")
+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 > "Hello,  world!"
+tricu < id (head (map (\i : lconcat i " world!") [("Hello, ")]))
+tricu > "Hello,  world!"
 
--- REPL
--- `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!"]
+tricu < -- Intensionality! We can inspect the structure of a function.
+tricu < triage = (\a b c : t (t a b) c)
+tricu < test = triage "Leaf" (\z : "Stem") (\a b : "Fork")
+tricu < test t t
+tricu > "Stem"
+tricu < -- We can even write a function to convert a function to source code
+tricu < toTString id
+tricu > "t (t (t t)) t"
 ```
 
-## Installation
+## Installation and Use
 
 You can easily build and/or run this project using [Nix](https://nixos.org/download/).
 
-- Run REPL immediately: 
+- Quick Start (REPL): 
   - `nix run git+https://git.eversole.co/James/tricu`
-- Build REPL executable in `./result/bin`: 
+- Build executable in `./result/bin`: 
   - `nix build git+https://git.eversole.co/James/tricu`
 
+`./result/bin/tricu --help`
+
+```
+tricu Evaluator and REPL
+
+tricu [COMMAND] ... [OPTIONS]
+  tricu: Exploring Tree Calculus
+
+Common flags:
+  -? --help       Display help message
+  -V --version    Print version information
+
+tricu [repl] [OPTIONS]
+  Start interactive REPL
+
+tricu eval [OPTIONS]
+  Evaluate tricu and return the result of the final expression.
+
+  -f --file=FILE  Input file path(s) for evaluation.
+                    Defaults to stdin.
+  -t --form=FORM  Optional output form: (tree|fsl|ast|ternary|ascii).
+                    Defaults to tricu-compatible `t` tree form.
+
+tricu decode [OPTIONS]
+  Decode a Tree Calculus value into a string representation.
+
+  -f --file=FILE  Optional input file path to attempt decoding.
+                    Defaults to stdin.
+```
+
 ## Acknowledgements 
 
 Tree Calculus was discovered by [Barry Jay](https://github.com/barry-jay-personal/blog). 

demos/LevelOrderTraversal.tri

@@ -0,0 +1,34 @@
+-- Level Order Traversal of a labelled binary tree
+-- Objective: Print each "level" of the tree on a separate line
+--
+-- NOTICE: This demo relies on tricu base library functions
+-- 
+-- We model labelled binary trees as sublists where values act as labels. We
+-- require explicit notation of empty nodes. Empty nodes can be represented 
+-- with an empty list, `[]`, which is equivalent to a single node `t`. 
+--
+-- Example tree inputs:
+-- [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]]
+-- Graph:
+--       1
+--      / \
+--     2   3
+--    /   /  \
+--   4   5    6
+--
+
+isLeaf = (\node : lOr (emptyList node) (emptyList (tail node)))
+getLabel = (\node : head node)
+getLeft = (\node : if (emptyList node) [] (if (emptyList (tail node)) [] (head (tail node))))
+getRight = (\node : if (emptyList node) [] (if (emptyList (tail node)) [] (if (emptyList (tail (tail node))) [] (head (tail (tail node))))))
+
+processLevel = y (\self queue : if (emptyList queue) [] (pair (map getLabel queue) (self (filter (\node : not (emptyList node)) (lconcat (map getLeft queue) (map getRight 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))))))
+levelOrderToString = (\s : toLineString (levelOrderTraversal s))
+
+flatten = foldl (\acc x : lconcat acc x) ""
+flatLOT = (\s : lconcat (t 10 t) (flatten (levelOrderToString s)))
+
+exampleOne = flatLOT [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]]
+exampleTwo = flatLOT [("1") [("2") [("4") [("8") t t] [("9") t t]] [("6") [("10") t t] [("12") t t]]] [("3") [("5") [("11") t t] t] [("7") t t]]]

lib/base.tri

@@ -0,0 +1,41 @@
+false = t
+_ = t
+true = t t
+k = t t
+i = t (t k) t
+s = t (t (k t)) t
+m = s i i
+b = s (k s) k
+c = s (s (k s) (s (k k) s)) (k k)
+iC = (\a b c : s a (k c) b)
+iD = b (b iC) iC
+iE = b (b iD) iC
+yi = (\i : b m (c b (i m)))
+y = yi iC
+yC = yi iD
+yD = yi iE
+id = (\a : a)
+triage = (\a b c : t (t a b) c)
+pair = t
+matchBool = (\ot of : triage of (\_ : ot) (\_ _ : ot))
+matchList = (\oe oc : triage oe _ oc)
+matchPair = (\op : triage _ _ op)
+not = matchBool false true
+and = matchBool id (\z : false)
+if = (\cond then else : t (t else (t t then)) t cond)
+test = triage "Leaf" (\z : "Stem") (\a b : "Fork")
+emptyList = matchList true (\y z : false)
+head = matchList t (\hd tl : hd)
+tail = matchList t (\hd tl : tl)
+lconcat = y (\self : matchList (\k : k) (\h r k : pair h (self r k)))
+lAnd = triage (\x : false) (\_ x : x) (\_ _ x : x)
+lOr = triage (\x : x) (\_ _ : true) (\_ _ x : true)
+hmap = y (\self : matchList (\f : t) (\hd tl f : pair (f hd) (self tl f)))
+map = (\f l : hmap l f)
+equal = y (\self : triage (triage true (\z : false) (\y z : false)) (\ax : triage false (self ax) (\y z : false)) (\ax ay : triage false (\z : false) (\bx by : lAnd (self ax bx) (self ay by))))
+hfilter = y (\self : matchList (\f : t) (\hd tl f : matchBool (t hd) i (f hd) (self tl f)))
+filter = (\f l : hfilter l f)
+hfoldl = y (\self f l x : matchList (\acc : acc) (\hd tl acc : self f tl (f acc hd)) l x)
+foldl  = (\f x l : hfoldl f l x)
+hfoldr = y (\self x f l : matchList x (\hd tl : f (self x f tl) hd) l)
+foldr  = (\f x l : hfoldr x f l)

shell.nix

@@ -1,8 +0,0 @@
-{ pkgs ? import <nixpkgs> {} }:
-let x = pkgs.haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
-		megaparsec
-  ]);
-in
-pkgs.mkShell {
-  buildInputs = [ x ];
-}

src/Eval.hs

@@ -3,8 +3,7 @@ module Eval where
 import Parser
 import Research
 
-import Data.Map (Map)
-import Data.List (foldl')
+import Data.Map  (Map)
 
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -14,7 +13,7 @@ evalSingle env term = case term of
   SFunc name [] body ->
     let lineNoLambda = eliminateLambda body
         result = evalAST env lineNoLambda
-    in Map.insert name result env
+    in Map.insert "__result" result (Map.insert name result env)
   SLambda _ body ->
     let result = evalAST env body
     in Map.insert "__result" result env
@@ -24,39 +23,41 @@ evalSingle env term = case term of
   SVar name ->
     case Map.lookup name env of
       Just value -> Map.insert "__result" value env
-      Nothing -> error $ "Variable " ++ name ++ " not defined"
+      Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
   _ ->
     let result = evalAST env term
     in Map.insert "__result" result env
 
 evalTricu :: Map String T -> [TricuAST] -> Map String T
-evalTricu env [] = env
-evalTricu env [lastLine] =
+evalTricu env list = evalTricu' env (filter (/= SEmpty) list)
+  where
+  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
-evalTricu env (line:rest) =
+  evalTricu' env (line:rest) =
     let lineNoLambda = eliminateLambda line
         updatedEnv = evalSingle env lineNoLambda
     in evalTricu updatedEnv rest
 
 evalAST :: Map String T -> TricuAST -> T
 evalAST env term = case term of
-    SVar name -> case Map.lookup name env of
-        Just value -> value
-        Nothing -> error $ "Variable " ++ name ++ " not defined"
-    TLeaf -> Leaf
-    TStem t -> Stem (evalAST env t)
-    TFork t1 t2 -> Fork (evalAST env t1) (evalAST env t2)
-    SApp t1 t2 -> apply (evalAST env t1) (evalAST env t2)
-    SStr str -> ofString str
-    SInt num -> ofNumber num
-    SList elems -> ofList (map (evalAST Map.empty) elems)
-    SEmpty -> Leaf
-    SFunc name args body ->
-        error $ "Unexpected function definition " ++ name
-        ++ " in evalAST; define via evalSingle."
-    SLambda {} -> error "Internal error: SLambda found in evalAST after elimination."
+  SVar name -> case Map.lookup name env of
+    Just value -> value
+    Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
+  TLeaf -> Leaf
+  TStem t -> Stem (evalAST env t)
+  TFork t1 t2 -> Fork (evalAST env t1) (evalAST env t2)
+  SApp t1 t2 -> apply (evalAST env t1) (evalAST env t2)
+  SStr str -> ofString str
+  SInt num -> ofNumber num
+  SList elems -> ofList (map (evalAST env) elems)
+  SEmpty -> Leaf
+  SFunc name args body ->
+    errorWithoutStackTrace $ "Unexpected function definition " ++ name
+  SLambda {} -> errorWithoutStackTrace "Internal error: SLambda found in evalAST after elimination."
 
 eliminateLambda :: TricuAST -> TricuAST
 eliminateLambda (SLambda (v:vs) body)
@@ -99,11 +100,6 @@ freeVars (SLambda vs b) = foldr Set.delete (freeVars b) vs
 isFree :: String -> TricuAST -> Bool
 isFree x = Set.member x . freeVars
 
-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 TricuAST tree form so that we
 -- can keep the evaluation functions straightforward
 tI :: TricuAST
@@ -117,5 +113,5 @@ tS = SApp (SApp TLeaf (SApp TLeaf (SApp (SApp TLeaf TLeaf) TLeaf))) TLeaf
 
 result :: Map String T -> T
 result r = case Map.lookup "__result" r of
-    Just a -> a
-    Nothing -> error "No __result field found in provided environment"
+  Just a -> a
+  Nothing -> errorWithoutStackTrace "No __result field found in provided environment"

src/FileEval.hs

@@ -0,0 +1,30 @@
+module FileEval where
+
+import Eval
+import Parser
+import Research
+
+import System.IO
+
+import qualified Data.Map as Map
+
+evaluateFileResult :: FilePath -> IO T
+evaluateFileResult filePath = do
+  contents <- readFile filePath
+  let asts = parseTricu contents
+  let finalEnv = evalTricu Map.empty asts
+  case Map.lookup "__result" finalEnv of
+    Just finalResult -> return finalResult
+    Nothing -> errorWithoutStackTrace "No expressions to evaluate found"
+
+evaluateFile :: FilePath -> IO Env
+evaluateFile filePath = do
+  contents <- readFile filePath
+  let asts = parseTricu contents
+  pure $ evalTricu Map.empty asts
+
+evaluateFileWithContext :: Env -> FilePath -> IO Env
+evaluateFileWithContext env filePath = do
+  contents <- readFile filePath
+  let asts = parseTricu contents
+  pure $ evalTricu env asts

src/Lexer.hs

@@ -1,38 +1,25 @@
 module Lexer where
 
 import Research
+
+import Control.Monad               (void)
+import Data.Void
 import Text.Megaparsec
 import Text.Megaparsec.Char hiding (space)
 import Text.Megaparsec.Char.Lexer
 
-import Control.Monad (void)
-import Data.Void
-
 import qualified Data.Set as Set
 
 type Lexer = Parsec Void String
 
-data LToken
-  = LKeywordT
-  | LIdentifier String
-  | LIntegerLiteral Int
-  | LStringLiteral String
-  | LAssign
-  | LColon
-  | LBackslash
-  | LOpenParen
-  | LCloseParen
-  | LOpenBracket
-  | LCloseBracket
-  | LNewline
-  deriving (Show, Eq, Ord)
-
 keywordT :: Lexer LToken
 keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT
 
 identifier :: Lexer LToken
 identifier = do
-  name <- some (letterChar <|> char '_' <|> char '-')
+  first <- letterChar <|> char '_'
+  rest <- many (letterChar <|> char '_' <|> char '-' <|> digitChar)
+  let name = first : rest
   if (name == "t" || name == "__result")
     then fail "Keywords (`t`, `__result`) cannot be used as an identifier"
     else return (LIdentifier name)
@@ -46,11 +33,8 @@ stringLiteral :: Lexer LToken
 stringLiteral = do
   char '"'
   content <- many (noneOf ['"'])
-  if null content
-    then fail "Empty string literals are not allowed"
-    else do
-      char '"' --"
-      return (LStringLiteral content)
+  char '"' --"
+  return (LStringLiteral content)
 
 assign :: Lexer LToken
 assign = char '=' *> pure LAssign
@@ -104,8 +88,7 @@ tricuLexer = do
         , closeBracket
         ]
 
-
 lexTricu :: String -> [LToken]
 lexTricu input = case runParser tricuLexer "" input of
-  Left err -> error $ "Lexical error:\n" ++ errorBundlePretty err
+  Left err -> errorWithoutStackTrace $ "Lexical error:\n" ++ errorBundlePretty err
   Right tokens -> tokens

src/Library.hs

@@ -1,46 +0,0 @@
-module Library where
-
-import Eval
-import Parser
-import Research
-
-import qualified Data.Map as Map
-
-library :: Map.Map String T
-library = evalTricu Map.empty $ parseTricu $ unlines 
-  [ "false = t" 
-  , "true = t t"
-  , "_ = t"
-  , "k = t t"
-  , "i = t (t k) t"
-  , "s = t (t (k t)) t"
-  , "m = s i i"
-  , "b = s (k s) k"
-  , "c = s (s (k s) (s (k k) s)) (k k)"
-  , "iC = (\\a b c : s a (k c) b)"
-  , "iD = b (b iC) iC"
-  , "iE = b (b iD) iC"
-  , "yi = (\\i : b m (c b (i m)))"
-  , "y = yi iC"
-  , "yC = yi iD"
-  , "yD = yi iE"
-  , "id = (\\a : a)"
-  , "triage = (\\a b c : t (t a b) c)"
-  , "pair = t"
-  , "matchBool = (\\ot of : triage of (\\_ : ot) (\\_ _ : ot))"
-  , "matchList = (\\oe oc : triage oe _ oc)"
-  , "matchPair = (\\op : triage _ _ op)"
-  , "not = matchBool false true"
-  , "and = matchBool id (\\z : false)"
-  , "if = (\\cond then else : t (t else (t t then)) t cond)"
-  , "test = triage \"Leaf\" (\\z : \"Stem\") (\\a b : \"Fork\")"
-  , "emptyList = matchList true (\\y z : false)"
-  , "head = matchList t (\\hd tl : hd)"
-  , "tail = matchList t (\\hd tl : tl)"
-  , "listConcat = y (\\self : matchList (\\k : k) (\\h r k : pair h (self r k)))"
-  , "lAnd = triage (\\x : false) (\\_ x : x) (\\_ _ x : x)"
-  , "lOr = triage (\\x : x) (\\_ _ : true) (\\_ _ x : true)"
-  , "hmap = y (\\self : matchList (\\f : t) (\\hd tl f : pair (f hd) (self tl f)))"
-  , "map = (\\f l : hmap l f)"
-  , "equal = y (\\self : triage (triage true (\\z : false) (\\y z : false)) (\\ax : triage false (self ax) (\\y z : false)) (\\ax ay : triage false (\\z : false) (\\bx by : lAnd (self ax bx) (self ay by))))" 
-  ]

src/Main.hs

@@ -1,22 +1,84 @@
 module Main where
 
-import Eval     (evalTricu, result)
-import Library  (library)
-import Parser   (parseTricu)
-import REPL     (repl)
-import Research (T)
+import Eval                   (evalTricu, result)
+import FileEval
+import Parser                 (parseTricu)
+import REPL
+import Research
 
-import Text.Megaparsec (runParser)
+import Control.Monad          (foldM)
+import Control.Monad.IO.Class (liftIO)
+import Text.Megaparsec        (runParser)
+import System.Console.CmdArgs
 
 import qualified Data.Map as Map
 
+data TricuArgs
+  = Repl
+  | Evaluate { file :: [FilePath], form :: EvaluatedForm }
+  | Decode { file :: [FilePath] }
+  deriving (Show, Data, Typeable)
+
+replMode :: TricuArgs
+replMode = Repl
+  &= help "Start interactive REPL"
+  &= auto
+  &= name "repl"
+
+evaluateMode :: TricuArgs
+evaluateMode = Evaluate
+  { file = def &= help "Input file path(s) for evaluation.\n \
+      \ Defaults to stdin."
+      &= name "f" &= typ "FILE"
+    , form = TreeCalculus &= typ "FORM"
+      &= help "Optional output form: (tree|fsl|ast|ternary|ascii).\n \
+      \ Defaults to tricu-compatible `t` tree form."
+      &= name "t"
+  }
+  &= help "Evaluate tricu and return the result of the final expression."
+  &= explicit
+  &= name "eval"
+
+decodeMode :: TricuArgs
+decodeMode = Decode
+  { file = def
+    &= help "Optional input file path to attempt decoding.\n \
+    \ Defaults to stdin."
+    &= name "f" &= typ "FILE"
+  }
+  &= help "Decode a Tree Calculus value into a string representation."
+  &= explicit
+  &= name "decode"
+
 main :: IO ()
 main = do
-  putStrLn "Welcome to the tricu Interpreter"
-  putStrLn "You can exit at any time by typing and entering: "
-  putStrLn ":_exit"
-  repl library
+  args <- cmdArgs $ modes [replMode, evaluateMode, decodeMode]
+    &= help "tricu: Exploring Tree Calculus"
+    &= program "tricu"
+    &= summary "tricu Evaluator and REPL"
+  case args of
+    Repl -> do
+      putStrLn "Welcome to the tricu REPL"
+      putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`"
+      library <- liftIO $ evaluateFile "./lib/base.tri"
+      repl $ Map.delete "__result" library
+    Evaluate { file = filePaths, form = form } -> do
+      result <- case filePaths of
+        [] -> do
+          t <- getContents
+          pure $ runTricu t
+        (filePath:restFilePaths) -> do
+            initialEnv <- evaluateFile filePath
+            finalEnv <- foldM evaluateFileWithContext initialEnv restFilePaths
+            pure $ result finalEnv
+      let fRes = formatResult form result
+      putStr fRes
+    Decode { file = filePaths } -> do
+      value <- case filePaths of
+        [] -> getContents
+        (filePath:_) -> readFile filePath
+      library <- liftIO $ evaluateFile "./lib/base.tri"
+      putStrLn $ decodeResult $ result $ evalTricu library $ parseTricu value
 
 runTricu :: String -> T
-runTricu s = result (evalTricu Map.empty $ parseTricu s)
-runTricuEnv env s = result (evalTricu env $ parseTricu s)
+runTricu = result . evalTricu Map.empty . parseTricu

src/Parser.hs

@@ -1,31 +1,18 @@
 module Parser where
 
 import Lexer
-import Research hiding (toList)
+import Research hiding       (toList)
 
-import Data.List.NonEmpty (toList)
+import Data.List.NonEmpty    (toList)
 import Data.Void (Void)
 import Text.Megaparsec
 import Text.Megaparsec.Char
-import Text.Megaparsec.Error (errorBundlePretty, ParseErrorBundle)
+import Text.Megaparsec.Error (ParseErrorBundle, errorBundlePretty)
 
 import qualified Data.Set as Set
 
-type Parser = Parsec Void [LToken]
-
-data TricuAST
-  = SVar String
-  | SInt Int
-  | SStr String
-  | SList [TricuAST]
-  | SFunc String [String] TricuAST
-  | SApp TricuAST TricuAST
-  | TLeaf
-  | TStem TricuAST
-  | TFork TricuAST TricuAST
-  | SLambda [String] TricuAST
-  | SEmpty
-  deriving (Show, Eq, Ord)
+type Parser    = Parsec Void [LToken]
+type AltParser = Parsec Void String
 
 parseTricu :: String -> [TricuAST]
 parseTricu input
@@ -67,16 +54,9 @@ parseFunction = do
 
 parseAtomicBase :: Parser TricuAST
 parseAtomicBase = choice
-    [ try parseVarWithoutAssignment
-    , parseTreeLeaf
+    [ parseTreeLeaf
     , parseGrouped
     ]
-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 TricuAST
 parseLambda = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) $ do
@@ -242,6 +222,42 @@ isLiteral _ = False
 isNewline (LNewline) = True
 isNewline _ = False
 
+-- Alternative parsers
+altSC :: AltParser ()
+altSC = skipMany (char ' ' <|> char '\t' <|> char '\n')
+
+parseTernaryTerm :: AltParser TricuAST
+parseTernaryTerm = do
+  altSC
+  term <- choice parseTernaryTerm'
+  altSC
+  pure term
+  where
+    parseTernaryTerm' =
+      [ try (between (char '(') (char ')') parseTernaryTerm)
+      , try parseTernaryLeaf
+      , try parseTernaryStem
+      , try parseTernaryFork
+      ]
+
+parseTernaryLeaf :: AltParser TricuAST
+parseTernaryLeaf = char '0' *> pure TLeaf
+
+parseTernaryStem :: AltParser TricuAST
+parseTernaryStem = char '1' *> (TStem <$> parseTernaryTerm)
+
+parseTernaryFork :: AltParser TricuAST
+parseTernaryFork = do
+  char '2'
+  term1 <- parseTernaryTerm
+  term2 <- parseTernaryTerm
+  pure $ TFork term1 term2
+
+parseTernary :: String -> Either String TricuAST
+parseTernary input = case runParser (parseTernaryTerm <* eof) "" input of
+  Left err -> Left (errorBundlePretty err)
+  Right ast -> Right ast
+
 -- Error Handling
 handleParseError :: ParseErrorBundle [LToken] Void -> String
 handleParseError bundle =
@@ -259,4 +275,3 @@ showError (FancyError offset fancy) =
 showError (TrivialError offset Nothing expected) =
   "Parse error at offset " ++ show offset ++ ": expected one of "
   ++ show (Set.toList expected)
-

src/REPL.hs

@@ -1,54 +1,71 @@
 module REPL where
 
 import Eval
+import FileEval
 import Lexer
 import Parser
 import Research
 
 import Control.Exception         (SomeException, catch)
 import Control.Monad.IO.Class    (liftIO)
-import Data.List                 (intercalate)
+import Data.Char                 (isSpace)
+import Data.List                 (dropWhile, dropWhileEnd, intercalate)
 import System.Console.Haskeline
 
 import qualified Data.Map as Map
 
-repl :: Map.Map String T -> IO ()
+repl :: Env -> IO ()
 repl env = runInputT defaultSettings (loop env)
   where
-    loop :: Map.Map String T -> InputT IO ()
+    loop :: Env -> InputT IO ()
     loop env = do
       minput <- getInputLine "tricu < "
       case minput of
-        Nothing -> outputStrLn "Goodbye!"
-        Just ":_exit" -> outputStrLn "Goodbye!"
-        Just "" -> do
-          outputStrLn ""
-          loop env
-        Just input -> do
-          newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
-          loop newEnv
-
-    processInput :: Map.Map String T -> String -> IO (Map.Map String T)
+        Nothing -> outputStrLn "Exiting tricu"
+        Just s -> case strip s of 
+          "!exit" -> outputStrLn "Exiting tricu"
+          "!load" -> do
+            path <- getInputLine "File path to load < "
+            case path of
+              Nothing -> do
+                outputStrLn "No input received; stopping import."
+                loop env
+              Just path -> do
+                loadedEnv <- liftIO $ evaluateFileWithContext env (strip path)
+                loop $ Map.delete "__result" (Map.union loadedEnv env)
+          "" -> do
+            outputStrLn ""
+            loop env
+          input -> do
+            case (take 2 input) of 
+              "--" -> loop env
+              _ -> do
+                newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
+                loop newEnv
+  
+    processInput :: Env -> String -> IO Env
     processInput env input = do
-      let clearEnv = Map.delete "__result" env
-          newEnv = evalSingle clearEnv (parseSingle input)
+      let asts = parseTricu input
+          newEnv = evalTricu env asts
       case Map.lookup "__result" newEnv of
         Just r -> do
-          putStrLn $ "tricu > " ++ show r
-          putStrLn $ "READ -: \"" ++ decodeResult r ++ "\""
+          putStrLn $ "tricu > " ++ decodeResult r
         Nothing -> return ()
       return newEnv
-
-    errorHandler :: Map.Map String T -> SomeException -> IO (Map.Map String T)
+    
+    errorHandler :: Env -> SomeException -> IO (Env)
     errorHandler env e = do
       putStrLn $ "Error: " ++ show e
       return env
+    
+    strip :: String -> String
+    strip = dropWhileEnd isSpace . dropWhile isSpace
 
 decodeResult :: T -> String
 decodeResult tc = case toNumber tc of
   Right num -> show num
   Left _ -> case toString tc of
-    Right str -> str
+    Right str -> "\"" ++ str ++ "\""
     Left _ -> case toList tc of
       Right list -> "[" ++ intercalate ", " (map decodeResult list) ++ "]"
-      Left _ -> ""
+      Left _ -> formatResult TreeCalculus tc

src/Research.hs

@@ -1,14 +1,57 @@
 module Research where
 
 import Control.Monad.State
-import Data.List (intercalate)
-import Data.Map (Map)
+import Data.List                 (intercalate)
+import Data.Map                  (Map)
+import Data.Text                 (Text, replace)
+import System.Console.CmdArgs    (Data, Typeable)
 
-import qualified Data.Map as Map
+import qualified Data.Map        as Map
+import qualified Data.Text as T
 
+-- Tree Calculus Types
 data T = Leaf | Stem T | Fork T T
   deriving (Show, Eq, Ord)
 
+-- Abstract Syntax Tree for tricu
+data TricuAST
+  = SVar String
+  | SInt Int
+  | SStr String
+  | SList [TricuAST]
+  | SFunc String [String] TricuAST
+  | SApp TricuAST TricuAST
+  | TLeaf
+  | TStem TricuAST
+  | TFork TricuAST TricuAST
+  | SLambda [String] TricuAST
+  | SEmpty
+  deriving (Show, Eq, Ord)
+
+-- Tokens from Lexer
+data LToken
+  = LKeywordT
+  | LIdentifier String
+  | LIntegerLiteral Int
+  | LStringLiteral String
+  | LAssign
+  | LColon
+  | LBackslash
+  | LOpenParen
+  | LCloseParen
+  | LOpenBracket
+  | LCloseBracket
+  | LNewline
+  deriving (Show, Eq, Ord)
+
+-- Output formats
+data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii
+  deriving (Show, Data, Typeable)
+
+-- Environment containing previously evaluated TC terms
+type Env = Map.Map String T 
+
+-- Tree Calculus Reduction
 apply :: T -> T -> T
 apply Leaf b                            = Stem b
 apply (Stem a) b                        = Fork a b
@@ -18,16 +61,6 @@ 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
 
-reduce :: T -> T
-reduce expr =
-  let next = step expr
-  in if next == expr then expr else reduce next
-
-step :: T -> T
-step (Fork left right) = reduce (apply (reduce left) (reduce right))
-step (Stem inner) = Stem (reduce inner)
-step t = t
-
 -- SKI Combinators
 _S :: T
 _S = Fork (Stem (Fork Leaf Leaf)) Leaf
@@ -88,7 +121,31 @@ toList (Fork x rest) = case toList rest of
   Left err -> Left err
 toList _ = Left "Invalid Tree Calculus list"
 
--- Utility
+-- Outputs
+formatResult :: EvaluatedForm -> T -> String
+formatResult TreeCalculus = toSimpleT . show
+formatResult FSL          = show
+formatResult AST          = show . toAST
+formatResult Ternary      = toTernaryString
+formatResult Ascii        = toAscii
+
+toSimpleT :: String -> String
+toSimpleT s = T.unpack 
+  $ replace "Fork" "t"
+  $ replace "Stem" "t"
+  $ replace "Leaf" "t"
+  $ (T.pack s)
+
+toTernaryString :: T -> String
+toTernaryString Leaf = "0"
+toTernaryString (Stem t) = "1" ++ toTernaryString t
+toTernaryString (Fork t1 t2) = "2" ++ toTernaryString t1 ++ toTernaryString t2
+
+toAST :: T -> TricuAST
+toAST Leaf = TLeaf
+toAST (Stem a) = TStem (toAST a)
+toAST (Fork a b) = TFork (toAST a) (toAST b)
+
 toAscii :: T -> String
 toAscii tree = go tree "" True
   where
@@ -103,41 +160,4 @@ toAscii tree = go tree "" True
         ++ go left (prefix ++ (if isLast then "    " else "|   ")) False
         ++ go right (prefix ++ (if isLast then "    " else "|   ")) True
 
-rules :: IO ()
-rules = putStr $ header
-              ++ (unlines $ tcRules)
-              ++ (unlines $ haskellRules)
-              ++ footer
-  where
-    tcRules :: [String]
-    tcRules =
-      [ "|                                                                               |"
-      , "|                  ┌--------- | Tree Calculus | ---------┐                      |"
-      , "|                  | 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    |                      |"
-      , "|                  └-------------------------------------┘                      |"
-      , "|                                                                               |"
-      ]
-    haskellRules :: [String]
-    haskellRules =
-      [ "| ┌------------------------------ | Haskell | --------------------------------┐ |"
-      , "| |                                                                           | |"
-      , "| | data T = Leaf | Stem T | Fork TT                                          | |"
-      , "| |                                                                           | |"
-      , "| | apply :: T -> T -> T                                                      | |"
-      , "| | 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            | |"
-      , "| └---------------------------------------------------------------------------┘ |"
-      ]
-    header :: String
-    header = "┌-------------------- | Rules for evaluating Tree Calculus | -------------------┐\n"
-    footer :: String
-    footer = "└-------------------- | Rules for evaluating Tree Calculus | -------------------┘\n"
+-- Utility

test/Spec.hs

@@ -1,12 +1,14 @@
 module Main where
 
 import Eval
+import FileEval
 import Lexer
-import Library
 import Parser
 import REPL
 import Research
+
 import Control.Exception (evaluate, try, SomeException)
+import Control.Monad.IO.Class (liftIO)
 import Test.Tasty
 import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck
@@ -28,6 +30,7 @@ tests = testGroup "Tricu Tests"
   , evaluationTests
   , lambdaEvalTests
   , libraryTests
+  , fileEvaluationTests
   , propertyTests
   ]
 
@@ -50,7 +53,7 @@ lexerTests = testGroup "Lexer Tests"
           expect = Right [LKeywordT, LStringLiteral "string", LIntegerLiteral 42]
       runParser tricuLexer "" input @?= expect
   , testCase "Lex invalid token" $ do
-      let input = "$invalid"
+      let input = "&invalid"
       case runParser tricuLexer "" input of
         Left _ -> return ()
         Right _ -> assertFailure "Expected lexer to fail on invalid token"
@@ -68,12 +71,7 @@ lexerTests = testGroup "Lexer Tests"
 
 parserTests :: TestTree
 parserTests = testGroup "Parser Tests"
-  [-- testCase "Error when parsing incomplete definitions" $ do
-   --   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
+  [ testCase "Error when assigning a value to T" $ do
       let input = lexTricu "t = x"
       case (runParser parseExpression "" input) of
         Left _ -> return ()
@@ -152,10 +150,10 @@ parserTests = testGroup "Parser Tests"
       let input = "(t) -- (t) -- (t)"
           expect = [TLeaf]
       parseTricu input @?= expect
---  , testCase "Comments with no terms" $ do
---      let input = unlines ["-- (t)", "(t t)"]
---          expect = []
---      parseTricu input @?= expect
+  , testCase "Comments with no terms" $ do
+      let input = unlines ["-- (t)", "(t t)"]
+          expect = [SEmpty,SApp TLeaf TLeaf]
+      parseTricu input @?= expect 
   ]
 
 evaluationTests :: TestTree
@@ -218,7 +216,7 @@ evaluationTests = testGroup "Evaluation Tests"
       let input = "x = t t\nx = t\nx"
           env = evalTricu Map.empty (parseTricu input)
       (result env) @?= Leaf
-    , testCase "Apply identity to Boolean Not" $ do
+  , 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 = evalTricu Map.empty (parseTricu input)
@@ -289,95 +287,134 @@ lambdaEvalTests = testGroup "Lambda Evaluation Tests"
 libraryTests :: TestTree
 libraryTests = testGroup "Library Tests"
   [ testCase "K combinator 1" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "k (t) (t t)"
           env = evalTricu library (parseTricu input)
       result env @?= Leaf
   , testCase "K combinator 2" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "k (t t) (t)"
           env = evalTricu library (parseTricu input)
       result env @?= Stem Leaf
   , testCase "K combinator 3" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "k (t t t) (t)"
           env = evalTricu library (parseTricu input)
       result env @?= Fork Leaf Leaf
   , testCase "S combinator" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "s (t) (t) (t)"
           env = evalTricu library (parseTricu input)
       result env @?= Fork Leaf (Stem Leaf)
   , testCase "SKK == I (fully expanded)" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "s k k"
           env = evalTricu library (parseTricu input)
       result env @?= Fork (Stem (Stem Leaf)) (Stem Leaf)
   , testCase "I combinator" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "i not"
           env = evalTricu library (parseTricu input)
       result env @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) (Fork Leaf (Fork Leaf Leaf))
   , testCase "Triage test Leaf" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "test t"
           env = decodeResult $ result $ evalTricu library (parseTricu input)
-      env @?= "Leaf"
+      env @?= "\"Leaf\""
   , testCase "Triage test (Stem Leaf)" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "test (t t)"
           env = decodeResult $ result $ evalTricu library (parseTricu input)
-      env @?= "Stem"
+      env @?= "\"Stem\""
   , testCase "Triage test (Fork Leaf Leaf)" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "test (t t t)"
           env = decodeResult $ result $ evalTricu library (parseTricu input)
-      env @?= "Fork"
+      env @?= "\"Fork\""
   , testCase "Boolean NOT: true" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "not true"
           env = result $ evalTricu library (parseTricu input)
       env @?= Leaf
   , testCase "Boolean NOT: false" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "not false"
           env = result $ evalTricu library (parseTricu input)
       env @?= Stem Leaf
   , testCase "Boolean AND TF" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "and (t t) (t)"
           env = evalTricu library (parseTricu input)
       result env @?= Leaf
   , testCase "Boolean AND FT" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "and (t) (t t)"
           env = evalTricu library (parseTricu input)
       result env @?= Leaf
   , testCase "Boolean AND FF" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "and (t) (t)"
           env = evalTricu library (parseTricu input)
       result env @?= Leaf
   , testCase "Boolean AND TT" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "and (t t) (t t)"
           env = evalTricu library (parseTricu input)
       result env @?= Stem Leaf
   , testCase "List head" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "head [(t) (t t) (t t t)]"
           env = evalTricu library (parseTricu input)
       result env @?= Leaf
   , testCase "List tail" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "head (tail (tail [(t) (t t) (t t t)]))"
           env = evalTricu library (parseTricu input)
       result env @?= Fork Leaf Leaf
   , testCase "List map" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "head (tail (map (\\a : (t t t)) [(t) (t) (t)]))"
           env = evalTricu library (parseTricu input)
       result env @?= Fork Leaf Leaf
   , testCase "Empty list check" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "emptyList []"
           env = evalTricu library (parseTricu input)
       result env @?= Stem Leaf
   , testCase "Non-empty list check" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "not (emptyList [(1) (2) (3)])"
           env = evalTricu library (parseTricu input)
       result env @?= Stem Leaf
   , testCase "Concatenate strings" $ do
-      let input = "listConcat \"Hello, \" \"world!\""
+      library <- evaluateFile "./lib/base.tri"
+      let input = "lconcat \"Hello, \" \"world!\""
           env = decodeResult $ result $ evalTricu library (parseTricu input)
-      env @?= "Hello, world!"
+      env @?= "\"Hello, world!\""
   , testCase "Verifying Equality" $ do
+      library <- evaluateFile "./lib/base.tri"
       let input = "equal (t t t) (t t t)"
           env = evalTricu library (parseTricu input)
       result env @?= Stem Leaf
   ]
 
+fileEvaluationTests :: TestTree
+fileEvaluationTests = testGroup "Evaluation tests"
+  [ testCase "Forks" $ do
+      res <- liftIO $ evaluateFileResult "./test/fork.tri"
+      res @?= Fork Leaf Leaf
+  , testCase "File ends with comment" $ do
+      res <- liftIO $ evaluateFileResult "./test/comments-1.tri"
+      res @?= Fork (Stem Leaf) Leaf
+  , testCase "Mapping and Equality" $ do
+      res <- liftIO $ evaluateFileResult "./test/map.tri"
+      res @?= Stem Leaf
+  , testCase "Eval and decoding string" $ do
+      library <- liftIO $ evaluateFile "./lib/base.tri"
+      res <- liftIO $ evaluateFileWithContext library "./test/string.tri"
+      decodeResult (result res) @?= "\"String test!\""
+  ]
+
 propertyTests :: TestTree
 propertyTests = testGroup "Property Tests"
   [ testProperty "Lexing and parsing round-trip" $ \input ->

test/ascii.tri

@@ -0,0 +1 @@
+t (t (t (t (t t) (t t t)) t) t t) t

test/assignment.tri

@@ -0,0 +1 @@
+x = t (t t) t

test/comments-1.tri

@@ -0,0 +1,9 @@
+-- This is a tricu comment!
+-- t (t t) (t (t t t))
+-- t (t t t) (t t)
+-- x = (\a : a)
+t (t t) t -- Fork (Stem Leaf) Leaf
+-- t t
+-- x
+-- x = (\a : a)
+-- t

test/fork.tri

@@ -0,0 +1 @@
+t t t 

test/map.tri

@@ -0,0 +1,24 @@
+false = t
+true = t t
+_ = t
+k = t t
+i = t (t k) t
+s = t (t (k t)) t
+m = s i i
+b = s (k s) k
+c = s (s (k s) (s (k k) s)) (k k)
+iC = (\a b c : s a (k c) b)
+yi = (\i : b m (c b (i m)))
+y = yi iC
+triage = (\a b c : t (t a b) c)
+pair = t
+matchList = (\oe oc : triage oe _ oc)
+lconcat = y (\self : matchList (\k : k) (\h r k : pair h (self r k)))
+hmap = y (\self : matchList (\f : t) (\hd tl f : pair (f hd) (self tl f)))
+map = (\f l : hmap l f)
+lAnd = triage (\x : false) (\_ x : x) (\_ _ x : x)
+lOr = triage (\x : x) (\_ _ : true) (\_ _ x : true)
+equal = y (\self : triage (triage true (\z : false) (\y z : false)) (\ax : triage false (self ax) (\y z : false)) (\ax ay : triage false (\z : false) (\bx by : lAnd (self ax bx) (self ay by))))
+
+x = map (\i : lconcat "Successfully concatenated " i) [("two strings!")]
+equal x [("Successfully concatenated two strings!")]

test/string.tri

@@ -0,0 +1 @@
+head (map (\i : lconcat "String " i) [("test!")])

tricu.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           tricu
-version:        0.4.0
+version:        0.5.0
 description:    A micro-language for exploring Tree Calculus
 author:         James Eversole
 maintainer:     james@eversole.co
@@ -17,25 +17,21 @@ executable tricu
   hs-source-dirs:
       src
   default-extensions:
-      ConstraintKinds
-      DataKinds
-      DeriveGeneric
-      FlexibleContexts
-      FlexibleInstances
-      GeneralizedNewtypeDeriving
+      DeriveDataTypeable
       OverloadedStrings
-      ScopedTypeVariables
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
   build-depends:
     base >=4.7
+    , cmdargs
     , containers
     , haskeline
     , megaparsec
     , mtl
+    , text
   other-modules:
     Eval
+    FileEval
     Lexer
-    Library
     Parser
     REPL
     Research
@@ -45,8 +41,12 @@ test-suite tricu-tests
   type:                exitcode-stdio-1.0
   main-is:             Spec.hs
   hs-source-dirs:      test, src
+  default-extensions:
+      DeriveDataTypeable
+      OverloadedStrings
   build-depends:       
     base
+    , cmdargs
     , containers
     , haskeline
     , megaparsec
@@ -54,11 +54,12 @@ test-suite tricu-tests
     , tasty
     , tasty-hunit
     , tasty-quickcheck
+    , text
   default-language:    Haskell2010
   other-modules:
     Eval
+    FileEval
     Lexer
-    Library
     Parser
     REPL
     Research