Add "SimpleT" t output form

This new output form allows easy piping to the decode function of the
tricu executable. Includes a new test for roundtrip evaluation of map,
compilation to tree calculus terms, and decoding back to a human
readable string.

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