diff --git a/README.md b/README.md index 62ff109..6164145 100644 --- a/README.md +++ b/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 diff --git a/src/Eval.hs b/src/Eval.hs index c670731..3d31b36 100644 --- a/src/Eval.hs +++ b/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 diff --git a/src/Lexer.hs b/src/Lexer.hs index 6d65c2e..6e7b1b0 100644 --- a/src/Lexer.hs +++ b/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 diff --git a/src/Library.hs b/src/Library.hs index 3ae1e23..5db2793 100644 --- a/src/Library.hs +++ b/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" diff --git a/src/Main.hs b/src/Main.hs index 954751f..a8e82ff 100644 --- a/src/Main.hs +++ b/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 diff --git a/src/Parser.hs b/src/Parser.hs index 2cffd7b..0026dc0 100644 --- a/src/Parser.hs +++ b/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 = [] diff --git a/src/Research.hs b/src/Research.hs index 4a9e145..6665fb9 100644 --- a/src/Research.hs +++ b/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 diff --git a/test/Spec.hs b/test/Spec.hs index 64a2160..cfc4142 100644 --- a/test/Spec.hs +++ b/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 diff --git a/test/string.tri b/test/string.tri new file mode 100644 index 0000000..a0c96c8 --- /dev/null +++ b/test/string.tri @@ -0,0 +1 @@ +head (map (\i : lconcat "String " i) [("test!")]) diff --git a/tricu.cabal b/tricu.cabal index 48a7270..012500e 100644 --- a/tricu.cabal +++ b/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