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!"] 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

View File

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

View File

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

View File

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

View File

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

View File

@ -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 = []

View File

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

View File

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

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

View File

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