Compare commits
No commits in common. "main" and "feat/new-outputs" have entirely different histories.
main
...
feat/new-o
17
.gitignore
vendored
17
.gitignore
vendored
@ -1,11 +1,14 @@
|
||||
bin/
|
||||
data/Purr.sqlite
|
||||
data/encryptionKey
|
||||
/result
|
||||
/config.dhall
|
||||
/Dockerfile
|
||||
/docker-stack.yml
|
||||
.stack-work/
|
||||
*.swp
|
||||
*.txt
|
||||
dist*
|
||||
*~
|
||||
.env
|
||||
.stack-work/
|
||||
/Dockerfile
|
||||
/config.dhall
|
||||
/result
|
||||
WD
|
||||
bin/
|
||||
dist*
|
||||
*.hs.txt
|
||||
|
64
README.md
64
README.md
@ -19,21 +19,31 @@ tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)
|
||||
## What does it look like?
|
||||
|
||||
```
|
||||
tricu < -- Anything after `--` on a single line is a comment
|
||||
tricu < id = (\a : a) -- Lambda abstraction is eliminated to tree calculus terms
|
||||
tricu < head (map (\i : lconcat i " world!") [("Hello, ")])
|
||||
tricu > "Hello, world!"
|
||||
tricu < id (head (map (\i : lconcat i " world!") [("Hello, ")]))
|
||||
tricu > "Hello, world!"
|
||||
-- Anything after `--` on a single line is a comment
|
||||
-- We can define functions or "variables" as Tree Calculus values
|
||||
false = t
|
||||
_ = t
|
||||
true = t t
|
||||
-- We can define functions as lambda expressions that are eliminated to Tree
|
||||
-- Calculus terms.
|
||||
id = (\a : a) -- `id` evaluates to the TC form of: t (t (t t)) t
|
||||
triage = (\a b c : t (t a b) c)
|
||||
-- Intensionality! We can inspect program structure, not just inputs/outputs:
|
||||
test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork")
|
||||
|
||||
tricu < -- Intensionality! We can inspect the structure of a function.
|
||||
tricu < triage = (\a b c : t (t a b) c)
|
||||
tricu < test = triage "Leaf" (\z : "Stem") (\a b : "Fork")
|
||||
tricu < test t t
|
||||
tricu > "Stem"
|
||||
tricu < -- We can even write a function to convert a function to source code
|
||||
tricu < toTString id
|
||||
tricu > "t (t (t t)) t"
|
||||
-- REPL
|
||||
-- `tricu <` is the input prompt
|
||||
-- `tricu >` is the Tree Calculus form output. Most are elided below.
|
||||
-- `READ -:` is an attempt to interpret the TC output as strings/numbers.
|
||||
tricu < test t
|
||||
tricu > Fork (Fork Leaf (Fork ...) ... )
|
||||
READ -: "Leaf"
|
||||
tricu < test (t t)
|
||||
READ -: "Stem"
|
||||
tricu < test (t t t)
|
||||
READ -: "Fork"
|
||||
tricu < map (\i : listConcat i " is super cool!") [("Tree Calculus") ("Intensionality") ("tricu")]
|
||||
READ -: ["Tree Calculus is super cool!", "Intensionality is super cool!", "tricu is super cool!"]
|
||||
```
|
||||
|
||||
## Installation and Use
|
||||
@ -44,35 +54,33 @@ You can easily build and/or run this project using [Nix](https://nixos.org/downl
|
||||
- `nix run git+https://git.eversole.co/James/tricu`
|
||||
- Build executable in `./result/bin`:
|
||||
- `nix build git+https://git.eversole.co/James/tricu`
|
||||
|
||||
`./result/bin/tricu --help`
|
||||
- `./result/bin/tricu --help`
|
||||
|
||||
```
|
||||
tricu Evaluator and REPL
|
||||
tricu - compiler and repl
|
||||
|
||||
tricu [COMMAND] ... [OPTIONS]
|
||||
tricu: Exploring Tree Calculus
|
||||
|
||||
Common flags:
|
||||
-? --help Display help message
|
||||
-V --version Print version information
|
||||
-? --help Display help message
|
||||
-V --version Print version information
|
||||
|
||||
tricu [repl] [OPTIONS]
|
||||
Start interactive REPL
|
||||
|
||||
tricu eval [OPTIONS]
|
||||
Evaluate tricu and return the result of the final expression.
|
||||
tricu compile [OPTIONS]
|
||||
Compile a file and return the result of the expression in the final line
|
||||
|
||||
-f --file=FILE Input file path(s) for evaluation.
|
||||
Defaults to stdin.
|
||||
-t --form=FORM Optional output form: (tree|fsl|ast|ternary|ascii).
|
||||
Defaults to tricu-compatible `t` tree form.
|
||||
-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.
|
||||
Decode a Tree Calculus value into a string representation
|
||||
|
||||
-f --file=FILE Optional input file path to attempt decoding.
|
||||
Defaults to stdin.
|
||||
-f --input=FILE Optional file path containing a Tree Calculus value.
|
||||
Defaults to stdin.
|
||||
```
|
||||
|
||||
## Acknowledgements
|
||||
|
@ -1,34 +0,0 @@
|
||||
-- Level Order Traversal of a labelled binary tree
|
||||
-- Objective: Print each "level" of the tree on a separate line
|
||||
--
|
||||
-- NOTICE: This demo relies on tricu base library functions
|
||||
--
|
||||
-- We model labelled binary trees as sublists where values act as labels. We
|
||||
-- require explicit notation of empty nodes. Empty nodes can be represented
|
||||
-- with an empty list, `[]`, which is equivalent to a single node `t`.
|
||||
--
|
||||
-- Example tree inputs:
|
||||
-- [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]]
|
||||
-- Graph:
|
||||
-- 1
|
||||
-- / \
|
||||
-- 2 3
|
||||
-- / / \
|
||||
-- 4 5 6
|
||||
--
|
||||
|
||||
isLeaf = (\node : lOr (emptyList node) (emptyList (tail node)))
|
||||
getLabel = (\node : head node)
|
||||
getLeft = (\node : if (emptyList node) [] (if (emptyList (tail node)) [] (head (tail node))))
|
||||
getRight = (\node : if (emptyList node) [] (if (emptyList (tail node)) [] (if (emptyList (tail (tail node))) [] (head (tail (tail node))))))
|
||||
|
||||
processLevel = y (\self queue : if (emptyList queue) [] (pair (map getLabel queue) (self (filter (\node : not (emptyList node)) (lconcat (map getLeft queue) (map getRight queue))))))
|
||||
levelOrderTraversal = (\a : processLevel (t a t))
|
||||
toLineString = y (\self levels : if (emptyList levels) "" (lconcat (lconcat (map (\x : lconcat x " ") (head levels)) "") (if (emptyList (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels))))))
|
||||
levelOrderToString = (\s : toLineString (levelOrderTraversal s))
|
||||
|
||||
flatten = foldl (\acc x : lconcat acc x) ""
|
||||
flatLOT = (\s : lconcat (t 10 t) (flatten (levelOrderToString s)))
|
||||
|
||||
exampleOne = flatLOT [("1") [("2") [("4") t t] t] [("3") [("5") t t] [("6") t t]]]]
|
||||
exampleTwo = flatLOT [("1") [("2") [("4") [("8") t t] [("9") t t]] [("6") [("10") t t] [("12") t t]]] [("3") [("5") [("11") t t] t] [("7") t t]]]
|
41
lib/base.tri
41
lib/base.tri
@ -1,41 +0,0 @@
|
||||
false = t
|
||||
_ = t
|
||||
true = t t
|
||||
k = t t
|
||||
i = t (t k) t
|
||||
s = t (t (k t)) t
|
||||
m = s i i
|
||||
b = s (k s) k
|
||||
c = s (s (k s) (s (k k) s)) (k k)
|
||||
iC = (\a b c : s a (k c) b)
|
||||
iD = b (b iC) iC
|
||||
iE = b (b iD) iC
|
||||
yi = (\i : b m (c b (i m)))
|
||||
y = yi iC
|
||||
yC = yi iD
|
||||
yD = yi iE
|
||||
id = (\a : a)
|
||||
triage = (\a b c : t (t a b) c)
|
||||
pair = t
|
||||
matchBool = (\ot of : triage of (\_ : ot) (\_ _ : ot))
|
||||
matchList = (\oe oc : triage oe _ oc)
|
||||
matchPair = (\op : triage _ _ op)
|
||||
not = matchBool false true
|
||||
and = matchBool id (\z : false)
|
||||
if = (\cond then else : t (t else (t t then)) t cond)
|
||||
test = triage "Leaf" (\z : "Stem") (\a b : "Fork")
|
||||
emptyList = matchList true (\y z : false)
|
||||
head = matchList t (\hd tl : hd)
|
||||
tail = matchList t (\hd tl : tl)
|
||||
lconcat = y (\self : matchList (\k : k) (\h r k : pair h (self r k)))
|
||||
lAnd = triage (\x : false) (\_ x : x) (\_ _ x : x)
|
||||
lOr = triage (\x : x) (\_ _ : true) (\_ _ x : true)
|
||||
hmap = y (\self : matchList (\f : t) (\hd tl f : pair (f hd) (self tl f)))
|
||||
map = (\f l : hmap l f)
|
||||
equal = y (\self : triage (triage true (\z : false) (\y z : false)) (\ax : triage false (self ax) (\y z : false)) (\ax ay : triage false (\z : false) (\bx by : lAnd (self ax bx) (self ay by))))
|
||||
hfilter = y (\self : matchList (\f : t) (\hd tl f : matchBool (t hd) i (f hd) (self tl f)))
|
||||
filter = (\f l : hfilter l f)
|
||||
hfoldl = y (\self f l x : matchList (\acc : acc) (\hd tl acc : self f tl (f acc hd)) l x)
|
||||
foldl = (\f x l : hfoldl f l x)
|
||||
hfoldr = y (\self x f l : matchList x (\hd tl : f (self x f tl) hd) l)
|
||||
foldr = (\f x l : hfoldr x f l)
|
8
shell.nix
Normal file
8
shell.nix
Normal file
@ -0,0 +1,8 @@
|
||||
{ pkgs ? import <nixpkgs> {} }:
|
||||
let x = pkgs.haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
|
||||
megaparsec
|
||||
]);
|
||||
in
|
||||
pkgs.mkShell {
|
||||
buildInputs = [ x ];
|
||||
}
|
19
src/Compiler.hs
Normal file
19
src/Compiler.hs
Normal file
@ -0,0 +1,19 @@
|
||||
module Compiler where
|
||||
|
||||
import Eval
|
||||
import Library
|
||||
import Parser
|
||||
import Research
|
||||
|
||||
import System.IO
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
evaluateFile :: FilePath -> IO T
|
||||
evaluateFile filePath = do
|
||||
contents <- readFile filePath
|
||||
let asts = parseTricu contents
|
||||
let finalEnv = evalTricu library asts
|
||||
case Map.lookup "__result" finalEnv of
|
||||
Just finalResult -> return finalResult
|
||||
Nothing -> error "No result found in final environment"
|
15
src/Eval.hs
15
src/Eval.hs
@ -13,7 +13,7 @@ evalSingle env term = case term of
|
||||
SFunc name [] body ->
|
||||
let lineNoLambda = eliminateLambda body
|
||||
result = evalAST env lineNoLambda
|
||||
in Map.insert "__result" result (Map.insert name result env)
|
||||
in Map.insert name result env
|
||||
SLambda _ body ->
|
||||
let result = evalAST env body
|
||||
in Map.insert "__result" result env
|
||||
@ -23,7 +23,7 @@ evalSingle env term = case term of
|
||||
SVar name ->
|
||||
case Map.lookup name env of
|
||||
Just value -> Map.insert "__result" value env
|
||||
Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
|
||||
Nothing -> error $ "Variable " ++ name ++ " not defined"
|
||||
_ ->
|
||||
let result = evalAST env term
|
||||
in Map.insert "__result" result env
|
||||
@ -46,18 +46,19 @@ evalAST :: Map String T -> TricuAST -> T
|
||||
evalAST env term = case term of
|
||||
SVar name -> case Map.lookup name env of
|
||||
Just value -> value
|
||||
Nothing -> errorWithoutStackTrace $ "Variable " ++ name ++ " not defined"
|
||||
Nothing -> error $ "Variable " ++ name ++ " not defined"
|
||||
TLeaf -> Leaf
|
||||
TStem t -> Stem (evalAST env t)
|
||||
TFork t1 t2 -> Fork (evalAST env t1) (evalAST env t2)
|
||||
SApp t1 t2 -> apply (evalAST env t1) (evalAST env t2)
|
||||
SStr str -> ofString str
|
||||
SInt num -> ofNumber num
|
||||
SList elems -> ofList (map (evalAST env) elems)
|
||||
SList elems -> ofList (map (evalAST Map.empty) elems)
|
||||
SEmpty -> Leaf
|
||||
SFunc name args body ->
|
||||
errorWithoutStackTrace $ "Unexpected function definition " ++ name
|
||||
SLambda {} -> errorWithoutStackTrace "Internal error: SLambda found in evalAST after elimination."
|
||||
error $ "Unexpected function definition " ++ name
|
||||
++ " in evalAST; define via evalSingle."
|
||||
SLambda {} -> error "Internal error: SLambda found in evalAST after elimination."
|
||||
|
||||
eliminateLambda :: TricuAST -> TricuAST
|
||||
eliminateLambda (SLambda (v:vs) body)
|
||||
@ -114,4 +115,4 @@ tS = SApp (SApp TLeaf (SApp TLeaf (SApp (SApp TLeaf TLeaf) TLeaf))) TLeaf
|
||||
result :: Map String T -> T
|
||||
result r = case Map.lookup "__result" r of
|
||||
Just a -> a
|
||||
Nothing -> errorWithoutStackTrace "No __result field found in provided environment"
|
||||
Nothing -> error "No __result field found in provided environment"
|
||||
|
@ -1,30 +0,0 @@
|
||||
module FileEval where
|
||||
|
||||
import Eval
|
||||
import Parser
|
||||
import Research
|
||||
|
||||
import System.IO
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
evaluateFileResult :: FilePath -> IO T
|
||||
evaluateFileResult filePath = do
|
||||
contents <- readFile filePath
|
||||
let asts = parseTricu contents
|
||||
let finalEnv = evalTricu Map.empty asts
|
||||
case Map.lookup "__result" finalEnv of
|
||||
Just finalResult -> return finalResult
|
||||
Nothing -> errorWithoutStackTrace "No expressions to evaluate found"
|
||||
|
||||
evaluateFile :: FilePath -> IO Env
|
||||
evaluateFile filePath = do
|
||||
contents <- readFile filePath
|
||||
let asts = parseTricu contents
|
||||
pure $ evalTricu Map.empty asts
|
||||
|
||||
evaluateFileWithContext :: Env -> FilePath -> IO Env
|
||||
evaluateFileWithContext env filePath = do
|
||||
contents <- readFile filePath
|
||||
let asts = parseTricu contents
|
||||
pure $ evalTricu env asts
|
13
src/Lexer.hs
13
src/Lexer.hs
@ -17,9 +17,7 @@ keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT
|
||||
|
||||
identifier :: Lexer LToken
|
||||
identifier = do
|
||||
first <- letterChar <|> char '_'
|
||||
rest <- many (letterChar <|> char '_' <|> char '-' <|> digitChar)
|
||||
let name = first : rest
|
||||
name <- some (letterChar <|> char '_' <|> char '-')
|
||||
if (name == "t" || name == "__result")
|
||||
then fail "Keywords (`t`, `__result`) cannot be used as an identifier"
|
||||
else return (LIdentifier name)
|
||||
@ -33,8 +31,11 @@ stringLiteral :: Lexer LToken
|
||||
stringLiteral = do
|
||||
char '"'
|
||||
content <- many (noneOf ['"'])
|
||||
char '"' --"
|
||||
return (LStringLiteral content)
|
||||
if null content
|
||||
then fail "Empty string literals are not allowed"
|
||||
else do
|
||||
char '"' --"
|
||||
return (LStringLiteral content)
|
||||
|
||||
assign :: Lexer LToken
|
||||
assign = char '=' *> pure LAssign
|
||||
@ -90,5 +91,5 @@ tricuLexer = do
|
||||
|
||||
lexTricu :: String -> [LToken]
|
||||
lexTricu input = case runParser tricuLexer "" input of
|
||||
Left err -> errorWithoutStackTrace $ "Lexical error:\n" ++ errorBundlePretty err
|
||||
Left err -> error $ "Lexical error:\n" ++ errorBundlePretty err
|
||||
Right tokens -> tokens
|
||||
|
46
src/Library.hs
Normal file
46
src/Library.hs
Normal file
@ -0,0 +1,46 @@
|
||||
module Library where
|
||||
|
||||
import Eval
|
||||
import Parser
|
||||
import Research
|
||||
|
||||
import Data.Map (empty)
|
||||
|
||||
library :: Env
|
||||
library = evalTricu empty $ parseTricu $ unlines
|
||||
[ "false = t"
|
||||
, "true = t t"
|
||||
, "_ = t"
|
||||
, "k = t t"
|
||||
, "i = t (t k) t"
|
||||
, "s = t (t (k t)) t"
|
||||
, "m = s i i"
|
||||
, "b = s (k s) k"
|
||||
, "c = s (s (k s) (s (k k) s)) (k k)"
|
||||
, "iC = (\\a b c : s a (k c) b)"
|
||||
, "iD = b (b iC) iC"
|
||||
, "iE = b (b iD) iC"
|
||||
, "yi = (\\i : b m (c b (i m)))"
|
||||
, "y = yi iC"
|
||||
, "yC = yi iD"
|
||||
, "yD = yi iE"
|
||||
, "id = (\\a : a)"
|
||||
, "triage = (\\a b c : t (t a b) c)"
|
||||
, "pair = t"
|
||||
, "matchBool = (\\ot of : triage of (\\_ : ot) (\\_ _ : ot))"
|
||||
, "matchList = (\\oe oc : triage oe _ oc)"
|
||||
, "matchPair = (\\op : triage _ _ op)"
|
||||
, "not = matchBool false true"
|
||||
, "and = matchBool id (\\z : false)"
|
||||
, "if = (\\cond then else : t (t else (t t then)) t cond)"
|
||||
, "test = triage \"Leaf\" (\\z : \"Stem\") (\\a b : \"Fork\")"
|
||||
, "emptyList = matchList true (\\y z : false)"
|
||||
, "head = matchList t (\\hd tl : hd)"
|
||||
, "tail = matchList t (\\hd tl : tl)"
|
||||
, "lconcat = y (\\self : matchList (\\k : k) (\\h r k : pair h (self r k)))"
|
||||
, "lAnd = triage (\\x : false) (\\_ x : x) (\\_ _ x : x)"
|
||||
, "lOr = triage (\\x : x) (\\_ _ : true) (\\_ _ x : true)"
|
||||
, "hmap = y (\\self : matchList (\\f : t) (\\hd tl f : pair (f hd) (self tl f)))"
|
||||
, "map = (\\f l : hmap l f)"
|
||||
, "equal = y (\\self : triage (triage true (\\z : false) (\\y z : false)) (\\ax : triage false (self ax) (\\y z : false)) (\\ax ay : triage false (\\z : false) (\\bx by : lAnd (self ax bx) (self ay by))))"
|
||||
]
|
74
src/Main.hs
74
src/Main.hs
@ -1,13 +1,12 @@
|
||||
module Main where
|
||||
|
||||
import Compiler
|
||||
import Eval (evalTricu, result)
|
||||
import FileEval
|
||||
import Library (library)
|
||||
import Parser (parseTricu)
|
||||
import REPL
|
||||
import Research
|
||||
|
||||
import Control.Monad (foldM)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Text.Megaparsec (runParser)
|
||||
import System.Console.CmdArgs
|
||||
|
||||
@ -15,8 +14,8 @@ import qualified Data.Map as Map
|
||||
|
||||
data TricuArgs
|
||||
= Repl
|
||||
| Evaluate { file :: [FilePath], form :: EvaluatedForm }
|
||||
| Decode { file :: [FilePath] }
|
||||
| Compile { file :: FilePath, output :: Maybe FilePath, form :: CompiledForm }
|
||||
| Decode { input :: Maybe FilePath }
|
||||
deriving (Show, Data, Typeable)
|
||||
|
||||
replMode :: TricuArgs
|
||||
@ -25,60 +24,51 @@ replMode = Repl
|
||||
&= auto
|
||||
&= name "repl"
|
||||
|
||||
evaluateMode :: TricuArgs
|
||||
evaluateMode = Evaluate
|
||||
{ file = def &= help "Input file path(s) for evaluation.\n \
|
||||
\ Defaults to stdin."
|
||||
&= name "f" &= typ "FILE"
|
||||
, form = TreeCalculus &= typ "FORM"
|
||||
&= help "Optional output form: (tree|fsl|ast|ternary|ascii).\n \
|
||||
\ Defaults to tricu-compatible `t` tree form."
|
||||
compileMode :: TricuArgs
|
||||
compileMode = Compile
|
||||
{ file = def &= typ "FILE"
|
||||
&= 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 = FSL &= typ "FORM"
|
||||
&= help "Output form: (fsl|tree|ast|ternary|ascii)"
|
||||
&= name "t"
|
||||
}
|
||||
&= help "Evaluate tricu and return the result of the final expression."
|
||||
&= help "Compile a file and return the result of the expression in the final line"
|
||||
&= explicit
|
||||
&= name "eval"
|
||||
&= name "compile"
|
||||
|
||||
decodeMode :: TricuArgs
|
||||
decodeMode = Decode
|
||||
{ file = def
|
||||
&= help "Optional input file path to attempt decoding.\n \
|
||||
\ Defaults to stdin."
|
||||
&= name "f" &= typ "FILE"
|
||||
{ input = def &= typ "FILE"
|
||||
&= help "Optional file path containing a Tree Calculus value. Defaults to stdin." &= name "f"
|
||||
}
|
||||
&= help "Decode a Tree Calculus value into a string representation."
|
||||
&= help "Decode a Tree Calculus value into a string representation"
|
||||
&= explicit
|
||||
&= name "decode"
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- cmdArgs $ modes [replMode, evaluateMode, decodeMode]
|
||||
args <- cmdArgs $ modes [replMode, compileMode, decodeMode]
|
||||
&= help "tricu: Exploring Tree Calculus"
|
||||
&= program "tricu"
|
||||
&= summary "tricu Evaluator and REPL"
|
||||
&= summary "tricu - compiler and repl"
|
||||
|
||||
case args of
|
||||
Repl -> do
|
||||
putStrLn "Welcome to the tricu REPL"
|
||||
putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`"
|
||||
library <- liftIO $ evaluateFile "./lib/base.tri"
|
||||
repl $ Map.delete "__result" library
|
||||
Evaluate { file = filePaths, form = form } -> do
|
||||
result <- case filePaths of
|
||||
[] -> do
|
||||
t <- getContents
|
||||
pure $ runTricu t
|
||||
(filePath:restFilePaths) -> do
|
||||
initialEnv <- evaluateFile filePath
|
||||
finalEnv <- foldM evaluateFileWithContext initialEnv restFilePaths
|
||||
pure $ result finalEnv
|
||||
repl library
|
||||
Compile { file = filePath, output = maybeOutputPath, form = form } -> do
|
||||
result <- evaluateFile filePath
|
||||
let fRes = formatResult form result
|
||||
putStr fRes
|
||||
Decode { file = filePaths } -> do
|
||||
value <- case filePaths of
|
||||
[] -> getContents
|
||||
(filePath:_) -> readFile filePath
|
||||
library <- liftIO $ evaluateFile "./lib/base.tri"
|
||||
case maybeOutputPath of
|
||||
Just outputPath -> do
|
||||
writeFile outputPath fRes
|
||||
putStrLn $ "Output to: " ++ outputPath
|
||||
Nothing -> putStr fRes
|
||||
Decode { input = maybeInputPath } -> do
|
||||
value <- case maybeInputPath of
|
||||
Just inputPath -> readFile inputPath
|
||||
Nothing -> getContents
|
||||
putStrLn $ decodeResult $ result $ evalTricu library $ parseTricu value
|
||||
|
||||
runTricu :: String -> T
|
||||
runTricu = result . evalTricu Map.empty . parseTricu
|
||||
|
@ -54,9 +54,16 @@ parseFunction = do
|
||||
|
||||
parseAtomicBase :: Parser TricuAST
|
||||
parseAtomicBase = choice
|
||||
[ parseTreeLeaf
|
||||
[ try parseVarWithoutAssignment
|
||||
, parseTreeLeaf
|
||||
, parseGrouped
|
||||
]
|
||||
parseVarWithoutAssignment :: Parser TricuAST
|
||||
parseVarWithoutAssignment = do
|
||||
LIdentifier name <- satisfy isIdentifier
|
||||
if (name == "t" || name == "__result")
|
||||
then fail $ "Reserved keyword: " ++ name ++ " cannot be assigned."
|
||||
else notFollowedBy (satisfy (== LAssign)) *> return (SVar name)
|
||||
|
||||
parseLambda :: Parser TricuAST
|
||||
parseLambda = between (satisfy (== LOpenParen)) (satisfy (== LCloseParen)) $ do
|
||||
|
43
src/REPL.hs
43
src/REPL.hs
@ -1,15 +1,13 @@
|
||||
module REPL where
|
||||
|
||||
import Eval
|
||||
import FileEval
|
||||
import Lexer
|
||||
import Parser
|
||||
import Research
|
||||
|
||||
import Control.Exception (SomeException, catch)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Char (isSpace)
|
||||
import Data.List (dropWhile, dropWhileEnd, intercalate)
|
||||
import Data.List (intercalate)
|
||||
import System.Console.Haskeline
|
||||
|
||||
import qualified Data.Map as Map
|
||||
@ -21,27 +19,14 @@ repl env = runInputT defaultSettings (loop env)
|
||||
loop env = do
|
||||
minput <- getInputLine "tricu < "
|
||||
case minput of
|
||||
Nothing -> outputStrLn "Exiting tricu"
|
||||
Just s -> case strip s of
|
||||
"!exit" -> outputStrLn "Exiting tricu"
|
||||
"!load" -> do
|
||||
path <- getInputLine "File path to load < "
|
||||
case path of
|
||||
Nothing -> do
|
||||
outputStrLn "No input received; stopping import."
|
||||
loop env
|
||||
Just path -> do
|
||||
loadedEnv <- liftIO $ evaluateFileWithContext env (strip path)
|
||||
loop $ Map.delete "__result" (Map.union loadedEnv env)
|
||||
"" -> do
|
||||
outputStrLn ""
|
||||
loop env
|
||||
input -> do
|
||||
case (take 2 input) of
|
||||
"--" -> loop env
|
||||
_ -> do
|
||||
newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
|
||||
loop newEnv
|
||||
Nothing -> outputStrLn "Goodbye!"
|
||||
Just ":_exit" -> outputStrLn "Goodbye!"
|
||||
Just "" -> do
|
||||
outputStrLn ""
|
||||
loop env
|
||||
Just input -> do
|
||||
newEnv <- liftIO $ (processInput env input `catch` errorHandler env)
|
||||
loop newEnv
|
||||
|
||||
processInput :: Env -> String -> IO Env
|
||||
processInput env input = do
|
||||
@ -49,7 +34,8 @@ repl env = runInputT defaultSettings (loop env)
|
||||
newEnv = evalTricu env asts
|
||||
case Map.lookup "__result" newEnv of
|
||||
Just r -> do
|
||||
putStrLn $ "tricu > " ++ decodeResult r
|
||||
putStrLn $ "tricu > " ++ show r
|
||||
putStrLn $ "READ -: \"" ++ decodeResult r ++ "\""
|
||||
Nothing -> return ()
|
||||
return newEnv
|
||||
|
||||
@ -57,15 +43,12 @@ repl env = runInputT defaultSettings (loop env)
|
||||
errorHandler env e = do
|
||||
putStrLn $ "Error: " ++ show e
|
||||
return env
|
||||
|
||||
strip :: String -> String
|
||||
strip = dropWhileEnd isSpace . dropWhile isSpace
|
||||
|
||||
decodeResult :: T -> String
|
||||
decodeResult tc = case toNumber tc of
|
||||
Right num -> show num
|
||||
Left _ -> case toString tc of
|
||||
Right str -> "\"" ++ str ++ "\""
|
||||
Right str -> str
|
||||
Left _ -> case toList tc of
|
||||
Right list -> "[" ++ intercalate ", " (map decodeResult list) ++ "]"
|
||||
Left _ -> formatResult TreeCalculus tc
|
||||
Left _ -> ""
|
||||
|
@ -45,7 +45,7 @@ data LToken
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- Output formats
|
||||
data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii
|
||||
data CompiledForm = TreeCalculus | FSL | AST | Ternary | Ascii
|
||||
deriving (Show, Data, Typeable)
|
||||
|
||||
-- Environment containing previously evaluated TC terms
|
||||
@ -122,7 +122,7 @@ toList (Fork x rest) = case toList rest of
|
||||
toList _ = Left "Invalid Tree Calculus list"
|
||||
|
||||
-- Outputs
|
||||
formatResult :: EvaluatedForm -> T -> String
|
||||
formatResult :: CompiledForm -> T -> String
|
||||
formatResult TreeCalculus = toSimpleT . show
|
||||
formatResult FSL = show
|
||||
formatResult AST = show . toAST
|
||||
|
54
test/Spec.hs
54
test/Spec.hs
@ -1,8 +1,9 @@
|
||||
module Main where
|
||||
|
||||
import Compiler
|
||||
import Eval
|
||||
import FileEval
|
||||
import Lexer
|
||||
import Library
|
||||
import Parser
|
||||
import REPL
|
||||
import Research
|
||||
@ -30,7 +31,7 @@ tests = testGroup "Tricu Tests"
|
||||
, evaluationTests
|
||||
, lambdaEvalTests
|
||||
, libraryTests
|
||||
, fileEvaluationTests
|
||||
, compilerTests
|
||||
, propertyTests
|
||||
]
|
||||
|
||||
@ -53,7 +54,7 @@ lexerTests = testGroup "Lexer Tests"
|
||||
expect = Right [LKeywordT, LStringLiteral "string", LIntegerLiteral 42]
|
||||
runParser tricuLexer "" input @?= expect
|
||||
, testCase "Lex invalid token" $ do
|
||||
let input = "&invalid"
|
||||
let input = "$invalid"
|
||||
case runParser tricuLexer "" input of
|
||||
Left _ -> return ()
|
||||
Right _ -> assertFailure "Expected lexer to fail on invalid token"
|
||||
@ -287,132 +288,109 @@ lambdaEvalTests = testGroup "Lambda Evaluation Tests"
|
||||
libraryTests :: TestTree
|
||||
libraryTests = testGroup "Library Tests"
|
||||
[ testCase "K combinator 1" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "k (t) (t t)"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Leaf
|
||||
, testCase "K combinator 2" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "k (t t) (t)"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Stem Leaf
|
||||
, testCase "K combinator 3" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "k (t t t) (t)"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Fork Leaf Leaf
|
||||
, testCase "S combinator" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "s (t) (t) (t)"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Fork Leaf (Stem Leaf)
|
||||
, testCase "SKK == I (fully expanded)" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "s k k"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Fork (Stem (Stem Leaf)) (Stem Leaf)
|
||||
, testCase "I combinator" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "i not"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Fork (Fork (Stem Leaf) (Fork Leaf Leaf)) (Fork Leaf (Fork Leaf Leaf))
|
||||
, testCase "Triage test Leaf" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "test t"
|
||||
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
||||
env @?= "\"Leaf\""
|
||||
env @?= "Leaf"
|
||||
, testCase "Triage test (Stem Leaf)" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "test (t t)"
|
||||
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
||||
env @?= "\"Stem\""
|
||||
env @?= "Stem"
|
||||
, testCase "Triage test (Fork Leaf Leaf)" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "test (t t t)"
|
||||
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
||||
env @?= "\"Fork\""
|
||||
env @?= "Fork"
|
||||
, testCase "Boolean NOT: true" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "not true"
|
||||
env = result $ evalTricu library (parseTricu input)
|
||||
env @?= Leaf
|
||||
, testCase "Boolean NOT: false" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "not false"
|
||||
env = result $ evalTricu library (parseTricu input)
|
||||
env @?= Stem Leaf
|
||||
, testCase "Boolean AND TF" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "and (t t) (t)"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Leaf
|
||||
, testCase "Boolean AND FT" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "and (t) (t t)"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Leaf
|
||||
, testCase "Boolean AND FF" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "and (t) (t)"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Leaf
|
||||
, testCase "Boolean AND TT" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "and (t t) (t t)"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Stem Leaf
|
||||
, testCase "List head" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "head [(t) (t t) (t t t)]"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Leaf
|
||||
, testCase "List tail" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "head (tail (tail [(t) (t t) (t t t)]))"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Fork Leaf Leaf
|
||||
, testCase "List map" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "head (tail (map (\\a : (t t t)) [(t) (t) (t)]))"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Fork Leaf Leaf
|
||||
, testCase "Empty list check" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "emptyList []"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Stem Leaf
|
||||
, testCase "Non-empty list check" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "not (emptyList [(1) (2) (3)])"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Stem Leaf
|
||||
, testCase "Concatenate strings" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "lconcat \"Hello, \" \"world!\""
|
||||
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
||||
env @?= "\"Hello, world!\""
|
||||
env @?= "Hello, world!"
|
||||
, testCase "Verifying Equality" $ do
|
||||
library <- evaluateFile "./lib/base.tri"
|
||||
let input = "equal (t t t) (t t t)"
|
||||
env = evalTricu library (parseTricu input)
|
||||
result env @?= Stem Leaf
|
||||
]
|
||||
|
||||
fileEvaluationTests :: TestTree
|
||||
fileEvaluationTests = testGroup "Evaluation tests"
|
||||
compilerTests :: TestTree
|
||||
compilerTests = testGroup "Compiler tests"
|
||||
[ testCase "Forks" $ do
|
||||
res <- liftIO $ evaluateFileResult "./test/fork.tri"
|
||||
res <- liftIO $ evaluateFile "./test/fork.tri"
|
||||
res @?= Fork Leaf Leaf
|
||||
, testCase "File ends with comment" $ do
|
||||
res <- liftIO $ evaluateFileResult "./test/comments-1.tri"
|
||||
res <- liftIO $ evaluateFile "./test/comments-1.tri"
|
||||
res @?= Fork (Stem Leaf) Leaf
|
||||
, testCase "Mapping and Equality" $ do
|
||||
res <- liftIO $ evaluateFileResult "./test/map.tri"
|
||||
res <- liftIO $ evaluateFile "./test/map.tri"
|
||||
res @?= Stem Leaf
|
||||
, testCase "Eval and decoding string" $ do
|
||||
library <- liftIO $ evaluateFile "./lib/base.tri"
|
||||
res <- liftIO $ evaluateFileWithContext library "./test/string.tri"
|
||||
decodeResult (result res) @?= "\"String test!\""
|
||||
, testCase "Map evaluation to String -> compilation -> string decoding" $ do
|
||||
res <- liftIO $ evaluateFile "./test/string.tri"
|
||||
decodeResult res @?= "String test!"
|
||||
]
|
||||
|
||||
propertyTests :: TestTree
|
||||
|
@ -1 +0,0 @@
|
||||
x = t (t t) t
|
@ -1,7 +1,7 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
name: tricu
|
||||
version: 0.5.0
|
||||
version: 0.4.0
|
||||
description: A micro-language for exploring Tree Calculus
|
||||
author: James Eversole
|
||||
maintainer: james@eversole.co
|
||||
@ -29,9 +29,10 @@ executable tricu
|
||||
, mtl
|
||||
, text
|
||||
other-modules:
|
||||
Compiler
|
||||
Eval
|
||||
FileEval
|
||||
Lexer
|
||||
Library
|
||||
Parser
|
||||
REPL
|
||||
Research
|
||||
@ -57,9 +58,10 @@ test-suite tricu-tests
|
||||
, text
|
||||
default-language: Haskell2010
|
||||
other-modules:
|
||||
Compiler
|
||||
Eval
|
||||
FileEval
|
||||
Lexer
|
||||
Library
|
||||
Parser
|
||||
REPL
|
||||
Research
|
||||
|
Loading…
x
Reference in New Issue
Block a user