Add "SimpleT" t
output form
#9
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
|
||||||
|
Loading…
x
Reference in New Issue
Block a user