Add "SimpleT" t output form #9

Merged
James merged 2 commits from feat/new-outputs into main 2024-12-31 16:05:38 +00:00
10 changed files with 120 additions and 112 deletions

View File

@ -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

View File

@ -4,7 +4,6 @@ import Parser
import Research
import Data.Map (Map)
import Data.List (foldl')
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

View File

@ -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

View File

@ -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"

View File

@ -1,7 +1,7 @@
module Main where
import Compiler
import Eval (evalTricu, result, toAST)
import Eval (evalTricu, result)
import Library (library)
import Parser (parseTricu)
import REPL
@ -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

View File

@ -7,27 +7,13 @@ 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 = []

View File

@ -3,12 +3,55 @@ module Research where
import Control.Monad.State
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.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

View File

@ -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

1
test/string.tri Normal file
View File

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

View File

@ -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