commit 4aa8e19ff484a15c27817c9d7e23bb5670985cc3
parent 7abc7061d9e29bc28448444ad5dad016845d81ed
Author: James Eversole <james@eversole.co>
Date: Tue, 31 Dec 2024 10:00:52 -0600
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.
Diffstat:
10 files changed, 120 insertions(+), 112 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -0,0 +1 @@
+head (map (\i : lconcat "String " i) [("test!")])
diff --git 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
