Merge pull request 'Add "SimpleT" t output form' (#9) from feat/new-outputs into main

Reviewed-on: #9

README.md

@@ -46,14 +46,42 @@ tricu < map (\i : listConcat i " is super cool!") [("Tree Calculus") ("Intension
 READ -: ["Tree Calculus is super cool!", "Intensionality is super cool!", "tricu is super cool!"]
 ```
 
-## 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 - compiler 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 compile [OPTIONS]
+  Compile a file and return the result of the expression in the final line
+
+  -f --file=FILE      Relative or absolute path to file input for compilation
+  -o --output=OUTPUT  Optional output file path for resulting output
+  -t --form=FORM      Output form: (tree|ast|ternary|ascii)
+
+tricu decode [OPTIONS]
+  Decode a Tree Calculus value into a string representation
+
+  -f --input=FILE     Optional file path containing a Tree Calculus value.
+                      Defaults to stdin.
+```
 
 ## Acknowledgements 
 

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
@@ -102,11 +101,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

src/Lexer.hs

@@ -1,32 +1,17 @@
 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
 

src/Library.hs

@@ -4,10 +4,10 @@ import Eval
 import Parser
 import Research
 
-import qualified Data.Map as Map
+import Data.Map (empty)
 
 library :: Env
-library = evalTricu Map.empty $ parseTricu $ unlines 
+library = evalTricu empty $ parseTricu $ unlines
   [ "false = t" 
   , "true = t t"
   , "_ = t"

src/Main.hs

@@ -1,13 +1,13 @@
 module Main where
 
 import Compiler
-import Eval     (evalTricu, result, toAST)
-import Library  (library)
-import Parser   (parseTricu)
+import Eval                   (evalTricu, result)
+import Library                (library)
+import Parser                 (parseTricu)
 import REPL
 import Research
 
-import Text.Megaparsec (runParser)
+import Text.Megaparsec        (runParser)
 import System.Console.CmdArgs
 
 import qualified Data.Map as Map
@@ -18,9 +18,6 @@ data TricuArgs
   | Decode { input :: Maybe FilePath }
   deriving (Show, Data, Typeable)
 
-data CompiledForm = TreeCalculus | AST | Ternary | Ascii
-  deriving (Show, Data, Typeable)
-
 replMode :: TricuArgs
 replMode = Repl
   &= help "Start interactive REPL"
@@ -33,8 +30,8 @@ compileMode = Compile
       &= help "Relative or absolute path to file input for compilation" &= name "f"
   , output = def &= typ "OUTPUT" 
       &= help "Optional output file path for resulting output" &= name "o"
-  , form = TreeCalculus &= typ "FORM" 
-      &= help "Output form: (tree|ast|ternary|ascii)" 
+  , form = FSL &= typ "FORM" 
+      &= help "Output form: (fsl|tree|ast|ternary|ascii)" 
       &= name "t"
   }
   &= help "Compile a file and return the result of the expression in the final line"
@@ -75,9 +72,3 @@ main = do
         Just inputPath -> readFile inputPath
         Nothing -> getContents
       putStrLn $ decodeResult $ result $ evalTricu library $ parseTricu value
-
-formatResult :: CompiledForm -> T -> String
-formatResult TreeCalculus = show
-formatResult AST          = show . toAST
-formatResult Ternary      = toTernaryString
-formatResult Ascii        = toAscii

src/Parser.hs

@@ -1,33 +1,19 @@
 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]
 type AltParser = Parsec Void String
 
-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)
-
 parseTricu :: String -> [TricuAST]
 parseTricu input
   | null tokens = []

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 CompiledForm = 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
@@ -79,13 +122,29 @@ toList (Fork x rest) = case toList rest of
 toList _ = Left "Invalid Tree Calculus list"
 
 -- Outputs
+formatResult :: CompiledForm -> 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
 
--- Utility
-type Env = Map.Map String T 
+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
@@ -101,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

@@ -388,6 +388,9 @@ compilerTests = testGroup "Compiler tests"
   , testCase "Mapping and Equality" $ do
       res <- liftIO $ evaluateFile "./test/map.tri"
       res @?= Stem Leaf
+  , testCase "Map evaluation to String -> compilation -> string decoding" $ do
+      res <- liftIO $ evaluateFile "./test/string.tri"
+      decodeResult res @?= "String test!"
   ]
 
 propertyTests :: TestTree

test/string.tri

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

tricu.cabal

@@ -17,15 +17,8 @@ executable tricu
   hs-source-dirs:
       src
   default-extensions:
-      ConstraintKinds
-      DataKinds
       DeriveDataTypeable
-      DeriveGeneric
-      FlexibleContexts
-      FlexibleInstances
-      GeneralizedNewtypeDeriving
       OverloadedStrings
-      ScopedTypeVariables
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
   build-depends:
     base >=4.7
@@ -34,6 +27,7 @@ executable tricu
     , haskeline
     , megaparsec
     , mtl
+    , text
   other-modules:
     Compiler
     Eval
@@ -48,6 +42,9 @@ 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
@@ -58,6 +55,7 @@ test-suite tricu-tests
     , tasty
     , tasty-hunit
     , tasty-quickcheck
+    , text
   default-language:    Haskell2010
   other-modules:
     Compiler