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.
This commit is contained in:
		
							
								
								
									
										34
									
								
								README.md
									
									
									
									
									
								
							
							
						
						
									
										34
									
								
								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!"] | 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/). | 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` |   - `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` |   - `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  | ## Acknowledgements  | ||||||
|  |  | ||||||
|  | |||||||
| @ -3,8 +3,7 @@ module Eval where | |||||||
| import Parser | import Parser | ||||||
| import Research | import Research | ||||||
|  |  | ||||||
| import Data.Map (Map) | import Data.Map  (Map) | ||||||
| import Data.List (foldl') |  | ||||||
|  |  | ||||||
| import qualified Data.Map as Map | import qualified Data.Map as Map | ||||||
| import qualified Data.Set as Set | 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 :: String -> TricuAST -> Bool | ||||||
| isFree x = Set.member x . freeVars | 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 | -- We need the SKI operators in an unevaluated TricuAST tree form so that we | ||||||
| -- can keep the evaluation functions straightforward | -- can keep the evaluation functions straightforward | ||||||
| tI :: TricuAST | tI :: TricuAST | ||||||
|  | |||||||
							
								
								
									
										21
									
								
								src/Lexer.hs
									
									
									
									
									
								
							
							
						
						
									
										21
									
								
								src/Lexer.hs
									
									
									
									
									
								
							| @ -1,32 +1,17 @@ | |||||||
| module Lexer where | module Lexer where | ||||||
|  |  | ||||||
| import Research | import Research | ||||||
|  |  | ||||||
|  | import Control.Monad               (void) | ||||||
|  | import Data.Void | ||||||
| import Text.Megaparsec | import Text.Megaparsec | ||||||
| import Text.Megaparsec.Char hiding (space) | import Text.Megaparsec.Char hiding (space) | ||||||
| import Text.Megaparsec.Char.Lexer | import Text.Megaparsec.Char.Lexer | ||||||
|  |  | ||||||
| import Control.Monad (void) |  | ||||||
| import Data.Void |  | ||||||
|  |  | ||||||
| import qualified Data.Set as Set | import qualified Data.Set as Set | ||||||
|  |  | ||||||
| type Lexer = Parsec Void String | 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 :: Lexer LToken | ||||||
| keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT | keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT | ||||||
|  |  | ||||||
|  | |||||||
| @ -4,10 +4,10 @@ import Eval | |||||||
| import Parser | import Parser | ||||||
| import Research | import Research | ||||||
|  |  | ||||||
| import qualified Data.Map as Map | import Data.Map (empty) | ||||||
|  |  | ||||||
| library :: Env | library :: Env | ||||||
| library = evalTricu Map.empty $ parseTricu $ unlines  | library = evalTricu empty $ parseTricu $ unlines | ||||||
|   [ "false = t"  |   [ "false = t"  | ||||||
|   , "true = t t" |   , "true = t t" | ||||||
|   , "_ = t" |   , "_ = t" | ||||||
|  | |||||||
							
								
								
									
										21
									
								
								src/Main.hs
									
									
									
									
									
								
							
							
						
						
									
										21
									
								
								src/Main.hs
									
									
									
									
									
								
							| @ -1,13 +1,13 @@ | |||||||
| module Main where | module Main where | ||||||
|  |  | ||||||
| import Compiler | import Compiler | ||||||
| import Eval     (evalTricu, result, toAST) | import Eval                   (evalTricu, result) | ||||||
| import Library  (library) | import Library                (library) | ||||||
| import Parser   (parseTricu) | import Parser                 (parseTricu) | ||||||
| import REPL | import REPL | ||||||
| import Research | import Research | ||||||
|  |  | ||||||
| import Text.Megaparsec (runParser) | import Text.Megaparsec        (runParser) | ||||||
| import System.Console.CmdArgs | import System.Console.CmdArgs | ||||||
|  |  | ||||||
| import qualified Data.Map as Map | import qualified Data.Map as Map | ||||||
| @ -18,9 +18,6 @@ data TricuArgs | |||||||
|   | Decode { input :: Maybe FilePath } |   | Decode { input :: Maybe FilePath } | ||||||
|   deriving (Show, Data, Typeable) |   deriving (Show, Data, Typeable) | ||||||
|  |  | ||||||
| data CompiledForm = TreeCalculus | AST | Ternary | Ascii |  | ||||||
|   deriving (Show, Data, Typeable) |  | ||||||
|  |  | ||||||
| replMode :: TricuArgs | replMode :: TricuArgs | ||||||
| replMode = Repl | replMode = Repl | ||||||
|   &= help "Start interactive REPL" |   &= help "Start interactive REPL" | ||||||
| @ -33,8 +30,8 @@ compileMode = Compile | |||||||
|       &= help "Relative or absolute path to file input for compilation" &= name "f" |       &= help "Relative or absolute path to file input for compilation" &= name "f" | ||||||
|   , output = def &= typ "OUTPUT"  |   , output = def &= typ "OUTPUT"  | ||||||
|       &= help "Optional output file path for resulting output" &= name "o" |       &= help "Optional output file path for resulting output" &= name "o" | ||||||
|   , form = TreeCalculus &= typ "FORM"  |   , form = FSL &= typ "FORM"  | ||||||
|       &= help "Output form: (tree|ast|ternary|ascii)"  |       &= help "Output form: (fsl|tree|ast|ternary|ascii)"  | ||||||
|       &= name "t" |       &= name "t" | ||||||
|   } |   } | ||||||
|   &= help "Compile a file and return the result of the expression in the final line" |   &= 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 |         Just inputPath -> readFile inputPath | ||||||
|         Nothing -> getContents |         Nothing -> getContents | ||||||
|       putStrLn $ decodeResult $ result $ evalTricu library $ parseTricu value |       putStrLn $ decodeResult $ result $ evalTricu library $ parseTricu value | ||||||
|  |  | ||||||
| formatResult :: CompiledForm -> T -> String |  | ||||||
| formatResult TreeCalculus = show |  | ||||||
| formatResult AST          = show . toAST |  | ||||||
| formatResult Ternary      = toTernaryString |  | ||||||
| formatResult Ascii        = toAscii |  | ||||||
|  | |||||||
| @ -1,33 +1,19 @@ | |||||||
| module Parser where | module Parser where | ||||||
|  |  | ||||||
| import Lexer | 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 Data.Void (Void) | ||||||
| import Text.Megaparsec | import Text.Megaparsec | ||||||
| import Text.Megaparsec.Char | import Text.Megaparsec.Char | ||||||
| import Text.Megaparsec.Error (errorBundlePretty, ParseErrorBundle) | import Text.Megaparsec.Error (ParseErrorBundle, errorBundlePretty) | ||||||
|  |  | ||||||
| import qualified Data.Set as Set | import qualified Data.Set as Set | ||||||
|  |  | ||||||
| type Parser    = Parsec Void [LToken] | type Parser    = Parsec Void [LToken] | ||||||
| type AltParser = Parsec Void String | 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 :: String -> [TricuAST] | ||||||
| parseTricu input | parseTricu input | ||||||
|   | null tokens = [] |   | null tokens = [] | ||||||
|  | |||||||
							
								
								
									
										108
									
								
								src/Research.hs
									
									
									
									
									
								
							
							
						
						
									
										108
									
								
								src/Research.hs
									
									
									
									
									
								
							| @ -1,14 +1,57 @@ | |||||||
| module Research where | module Research where | ||||||
|  |  | ||||||
| import Control.Monad.State | import Control.Monad.State | ||||||
| import Data.List (intercalate) | import Data.List                 (intercalate) | ||||||
| import Data.Map (Map) | 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 | data T = Leaf | Stem T | Fork T T | ||||||
|   deriving (Show, Eq, Ord) |   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 :: T -> T -> T | ||||||
| apply Leaf b                            = Stem b | apply Leaf b                            = Stem b | ||||||
| apply (Stem a) b                        = Fork a 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" | toList _ = Left "Invalid Tree Calculus list" | ||||||
|  |  | ||||||
| -- Outputs | -- 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 :: T -> String | ||||||
| toTernaryString Leaf = "0" | toTernaryString Leaf = "0" | ||||||
| toTernaryString (Stem t) = "1" ++ toTernaryString t | toTernaryString (Stem t) = "1" ++ toTernaryString t | ||||||
| toTernaryString (Fork t1 t2) = "2" ++ toTernaryString t1 ++ toTernaryString t2 | toTernaryString (Fork t1 t2) = "2" ++ toTernaryString t1 ++ toTernaryString t2 | ||||||
|  |  | ||||||
| -- Utility | toAST :: T -> TricuAST | ||||||
| type Env = Map.Map String T  | toAST Leaf = TLeaf | ||||||
|  | toAST (Stem a) = TStem (toAST a) | ||||||
|  | toAST (Fork a b) = TFork (toAST a) (toAST b) | ||||||
|  |  | ||||||
| toAscii :: T -> String | toAscii :: T -> String | ||||||
| toAscii tree = go tree "" True | toAscii tree = go tree "" True | ||||||
| @ -101,41 +160,4 @@ toAscii tree = go tree "" True | |||||||
|         ++ go left (prefix ++ (if isLast then "    " else "|   ")) False |         ++ go left (prefix ++ (if isLast then "    " else "|   ")) False | ||||||
|         ++ go right (prefix ++ (if isLast then "    " else "|   ")) True |         ++ go right (prefix ++ (if isLast then "    " else "|   ")) True | ||||||
|  |  | ||||||
| rules :: IO () | -- Utility | ||||||
| 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" |  | ||||||
|  | |||||||
| @ -388,6 +388,9 @@ compilerTests = testGroup "Compiler tests" | |||||||
|   , testCase "Mapping and Equality" $ do |   , testCase "Mapping and Equality" $ do | ||||||
|       res <- liftIO $ evaluateFile "./test/map.tri" |       res <- liftIO $ evaluateFile "./test/map.tri" | ||||||
|       res @?= Stem Leaf |       res @?= Stem Leaf | ||||||
|  |   , testCase "Map evaluation to String -> compilation -> string decoding" $ do | ||||||
|  |       res <- liftIO $ evaluateFile "./test/string.tri" | ||||||
|  |       decodeResult res @?= "String test!" | ||||||
|   ] |   ] | ||||||
|  |  | ||||||
| propertyTests :: TestTree | propertyTests :: TestTree | ||||||
|  | |||||||
							
								
								
									
										1
									
								
								test/string.tri
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										1
									
								
								test/string.tri
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1 @@ | |||||||
|  | head (map (\i : lconcat "String " i) [("test!")]) | ||||||
							
								
								
									
										12
									
								
								tricu.cabal
									
									
									
									
									
								
							
							
						
						
									
										12
									
								
								tricu.cabal
									
									
									
									
									
								
							| @ -17,15 +17,8 @@ executable tricu | |||||||
|   hs-source-dirs: |   hs-source-dirs: | ||||||
|       src |       src | ||||||
|   default-extensions: |   default-extensions: | ||||||
|       ConstraintKinds |  | ||||||
|       DataKinds |  | ||||||
|       DeriveDataTypeable |       DeriveDataTypeable | ||||||
|       DeriveGeneric |  | ||||||
|       FlexibleContexts |  | ||||||
|       FlexibleInstances |  | ||||||
|       GeneralizedNewtypeDeriving |  | ||||||
|       OverloadedStrings |       OverloadedStrings | ||||||
|       ScopedTypeVariables |  | ||||||
|   ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC |   ghc-options: -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC | ||||||
|   build-depends: |   build-depends: | ||||||
|     base >=4.7 |     base >=4.7 | ||||||
| @ -34,6 +27,7 @@ executable tricu | |||||||
|     , haskeline |     , haskeline | ||||||
|     , megaparsec |     , megaparsec | ||||||
|     , mtl |     , mtl | ||||||
|  |     , text | ||||||
|   other-modules: |   other-modules: | ||||||
|     Compiler |     Compiler | ||||||
|     Eval |     Eval | ||||||
| @ -48,6 +42,9 @@ test-suite tricu-tests | |||||||
|   type:                exitcode-stdio-1.0 |   type:                exitcode-stdio-1.0 | ||||||
|   main-is:             Spec.hs |   main-is:             Spec.hs | ||||||
|   hs-source-dirs:      test, src |   hs-source-dirs:      test, src | ||||||
|  |   default-extensions: | ||||||
|  |       DeriveDataTypeable | ||||||
|  |       OverloadedStrings | ||||||
|   build-depends:        |   build-depends:        | ||||||
|     base |     base | ||||||
|     , cmdargs |     , cmdargs | ||||||
| @ -58,6 +55,7 @@ test-suite tricu-tests | |||||||
|     , tasty |     , tasty | ||||||
|     , tasty-hunit |     , tasty-hunit | ||||||
|     , tasty-quickcheck |     , tasty-quickcheck | ||||||
|  |     , text | ||||||
|   default-language:    Haskell2010 |   default-language:    Haskell2010 | ||||||
|   other-modules: |   other-modules: | ||||||
|     Compiler |     Compiler | ||||||
|  | |||||||
		Reference in New Issue
	
	Block a user
	 James Eversole
					James Eversole