Compare commits
4 Commits
Author | SHA1 | Date | |
---|---|---|---|
f9864b8361 | |||
1a9a4494e0 | |||
a16a24a808 | |||
7d1b6a741d |
1
.gitignore
vendored
1
.gitignore
vendored
@ -9,3 +9,4 @@
|
|||||||
WD
|
WD
|
||||||
bin/
|
bin/
|
||||||
dist*
|
dist*
|
||||||
|
.tricu_history
|
||||||
|
10
README.md
10
README.md
@ -2,7 +2,9 @@
|
|||||||
|
|
||||||
## Introduction
|
## Introduction
|
||||||
|
|
||||||
tricu (pronounced "tree-shoe") is a purely functional interpreted language implemented in Haskell. It is fundamentally based on the application of [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf) terms, but minimal syntax sugar is included to provide a useful programming tool. tricu is under active development and you can expect breaking changes with nearly every commit.
|
tricu (pronounced "tree-shoe") is a purely functional interpreted language implemented in Haskell. It is fundamentally based on the application of [Tree Calculus](https://github.com/barry-jay-personal/typed_tree_calculus/blob/main/typed_program_analysis.pdf) terms, but minimal syntax sugar is included to provide a useful programming tool.
|
||||||
|
|
||||||
|
*tricu is under active development and you should expect breaking changes with every commit.*
|
||||||
|
|
||||||
tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)`.
|
tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)`.
|
||||||
|
|
||||||
@ -14,7 +16,7 @@ tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)
|
|||||||
- Lambda abstraction syntax: `id = (\a : a)`
|
- Lambda abstraction syntax: `id = (\a : a)`
|
||||||
- List, Number, and String literals: `[(2) ("Hello")]`
|
- List, Number, and String literals: `[(2) ("Hello")]`
|
||||||
- Function application: `not (not false)`
|
- Function application: `not (not false)`
|
||||||
- Higher order/first-class functions: `map (\a : lconcat a "!") [("Hello")]`
|
- Higher order/first-class functions: `map (\a : append a "!") [("Hello")]`
|
||||||
- Intensionality blurs the distinction between functions and data (see REPL examples)
|
- Intensionality blurs the distinction between functions and data (see REPL examples)
|
||||||
- Simple module system for code organization
|
- Simple module system for code organization
|
||||||
|
|
||||||
@ -23,9 +25,9 @@ tricu is the word for "tree" in Lojban: `(x1) is a tree of species/cultivar (x2)
|
|||||||
```
|
```
|
||||||
tricu < -- Anything after `--` on a single line is a comment
|
tricu < -- Anything after `--` on a single line is a comment
|
||||||
tricu < id = (\a : a) -- Lambda abstraction is eliminated to tree calculus terms
|
tricu < id = (\a : a) -- Lambda abstraction is eliminated to tree calculus terms
|
||||||
tricu < head (map (\i : lconcat i " world!") [("Hello, ")])
|
tricu < head (map (\i : append i " world!") [("Hello, ")])
|
||||||
tricu > "Hello, world!"
|
tricu > "Hello, world!"
|
||||||
tricu < id (head (map (\i : lconcat i " world!") [("Hello, ")]))
|
tricu < id (head (map (\i : append i " world!") [("Hello, ")]))
|
||||||
tricu > "Hello, world!"
|
tricu > "Hello, world!"
|
||||||
|
|
||||||
tricu < -- Intensionality! We can inspect the structure of a function or data.
|
tricu < -- Intensionality! We can inspect the structure of a function or data.
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
!import "lib/base.tri" !Local
|
!import "../lib/base.tri" !Local
|
||||||
|
!import "../lib/list.tri" !Local
|
||||||
|
|
||||||
main = lambdaEqualsTC
|
main = lambdaEqualsTC
|
||||||
|
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
!import "lib/base.tri" !Local
|
!import "../lib/base.tri" Lib
|
||||||
|
!import "../lib/list.tri" !Local
|
||||||
|
|
||||||
main = exampleTwo
|
main = exampleTwo
|
||||||
-- Level Order Traversal of a labelled binary tree
|
-- Level Order Traversal of a labelled binary tree
|
||||||
@ -37,21 +38,21 @@ processLevel = y (\self queue : if (emptyList? queue)
|
|||||||
[]
|
[]
|
||||||
(pair (map label queue) (self (filter
|
(pair (map label queue) (self (filter
|
||||||
(\node : not? (emptyList? node))
|
(\node : not? (emptyList? node))
|
||||||
(lconcat (map left queue) (map right queue))))))
|
(append (map left queue) (map right queue))))))
|
||||||
|
|
||||||
levelOrderTraversal_ = \a : processLevel (t a t)
|
levelOrderTraversal_ = \a : processLevel (t a t)
|
||||||
|
|
||||||
toLineString = y (\self levels : if (emptyList? levels)
|
toLineString = y (\self levels : if (emptyList? levels)
|
||||||
""
|
""
|
||||||
(lconcat
|
(append
|
||||||
(lconcat (map (\x : lconcat x " ") (head levels)) "")
|
(append (map (\x : append x " ") (head levels)) "")
|
||||||
(if (emptyList? (tail levels)) "" (lconcat (t (t 10 t) t) (self (tail levels))))))
|
(if (emptyList? (tail levels)) "" (append (t (t 10 t) t) (self (tail levels))))))
|
||||||
|
|
||||||
levelOrderToString = \s : toLineString (levelOrderTraversal_ s)
|
levelOrderToString = \s : toLineString (levelOrderTraversal_ s)
|
||||||
|
|
||||||
flatten = foldl (\acc x : lconcat acc x) ""
|
flatten = foldl (\acc x : append acc x) ""
|
||||||
|
|
||||||
levelOrderTraversal = \s : lconcat (t 10 t) (flatten (levelOrderToString s))
|
levelOrderTraversal = \s : append (t 10 t) (flatten (levelOrderToString s))
|
||||||
|
|
||||||
exampleOne = levelOrderTraversal [("1")
|
exampleOne = levelOrderTraversal [("1")
|
||||||
[("2") [("4") t t] t]
|
[("2") [("4") t t] t]
|
||||||
|
@ -1,18 +1,8 @@
|
|||||||
!import "lib/base.tri" !Local
|
!import "../lib/base.tri" !Local
|
||||||
|
!import "../lib/list.tri" !Local
|
||||||
|
|
||||||
main = size size
|
main = size size
|
||||||
|
|
||||||
compose = \f g x : f (g x)
|
|
||||||
|
|
||||||
succ = y (\self :
|
|
||||||
triage
|
|
||||||
1
|
|
||||||
t
|
|
||||||
(triage
|
|
||||||
(t (t t))
|
|
||||||
(\_ tail : t t (self tail))
|
|
||||||
t))
|
|
||||||
|
|
||||||
size = (\x :
|
size = (\x :
|
||||||
(y (\self x :
|
(y (\self x :
|
||||||
compose succ
|
compose succ
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
!import "lib/base.tri" !Local
|
!import "../lib/base.tri" !Local
|
||||||
|
!import "../lib/list.tri" !Local
|
||||||
|
|
||||||
main = toSource not?
|
main = toSource not?
|
||||||
-- Thanks to intensionality, we can inspect the structure of a given value
|
-- Thanks to intensionality, we can inspect the structure of a given value
|
||||||
|
@ -34,6 +34,7 @@
|
|||||||
devShells.default = pkgs.mkShell {
|
devShells.default = pkgs.mkShell {
|
||||||
buildInputs = with pkgs; [
|
buildInputs = with pkgs; [
|
||||||
haskellPackages.cabal-install
|
haskellPackages.cabal-install
|
||||||
|
haskellPackages.ghc-events
|
||||||
haskellPackages.ghcid
|
haskellPackages.ghcid
|
||||||
customGHC
|
customGHC
|
||||||
upx
|
upx
|
||||||
|
63
lib/base.tri
63
lib/base.tri
@ -1,13 +1,8 @@
|
|||||||
false = t
|
false = t
|
||||||
_ = t
|
_ = t
|
||||||
true = 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)
|
|
||||||
id = \a : a
|
id = \a : a
|
||||||
|
const = \a b : a
|
||||||
pair = t
|
pair = t
|
||||||
if = \cond then else : t (t else (t t then)) t cond
|
if = \cond then else : t (t else (t t then)) t cond
|
||||||
|
|
||||||
@ -15,6 +10,8 @@ y = ((\mut wait fun : wait mut (\x : fun (wait mut x)))
|
|||||||
(\x : x x)
|
(\x : x x)
|
||||||
(\a0 a1 a2 : t (t a0) (t t a2) a1))
|
(\a0 a1 a2 : t (t a0) (t t a2) a1))
|
||||||
|
|
||||||
|
compose = \f g x : f (g x)
|
||||||
|
|
||||||
triage = \leaf stem fork : t (t leaf stem) fork
|
triage = \leaf stem fork : t (t leaf stem) fork
|
||||||
test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork")
|
test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork")
|
||||||
|
|
||||||
@ -24,21 +21,6 @@ matchBool = (\ot of : triage
|
|||||||
(\_ _ : ot)
|
(\_ _ : ot)
|
||||||
)
|
)
|
||||||
|
|
||||||
matchList = \a b : triage a _ b
|
|
||||||
|
|
||||||
matchPair = \a : triage _ _ a
|
|
||||||
|
|
||||||
not? = matchBool false true
|
|
||||||
and? = matchBool id (\_ : false)
|
|
||||||
emptyList? = matchList true (\_ _ : false)
|
|
||||||
|
|
||||||
head = matchList t (\head _ : head)
|
|
||||||
tail = matchList t (\_ tail : tail)
|
|
||||||
|
|
||||||
lconcat = y (\self : matchList
|
|
||||||
(\k : k)
|
|
||||||
(\h r k : pair h (self r k)))
|
|
||||||
|
|
||||||
lAnd = (triage
|
lAnd = (triage
|
||||||
(\_ : false)
|
(\_ : false)
|
||||||
(\_ x : x)
|
(\_ x : x)
|
||||||
@ -49,11 +31,22 @@ lOr = (triage
|
|||||||
(\_ _ : true)
|
(\_ _ : true)
|
||||||
(\_ _ _ : true))
|
(\_ _ _ : true))
|
||||||
|
|
||||||
map_ = y (\self :
|
matchPair = \a : triage _ _ a
|
||||||
matchList
|
|
||||||
(\_ : t)
|
not? = matchBool false true
|
||||||
(\head tail f : pair (f head) (self tail f)))
|
and? = matchBool id (\_ : false)
|
||||||
map = \f l : map_ l f
|
|
||||||
|
or? = (\x z :
|
||||||
|
matchBool
|
||||||
|
(matchBool true true z)
|
||||||
|
(matchBool true false z)
|
||||||
|
x)
|
||||||
|
|
||||||
|
xor? = (\x z :
|
||||||
|
matchBool
|
||||||
|
(matchBool false true z)
|
||||||
|
(matchBool true false z)
|
||||||
|
x)
|
||||||
|
|
||||||
equal? = y (\self : triage
|
equal? = y (\self : triage
|
||||||
(triage
|
(triage
|
||||||
@ -71,13 +64,11 @@ equal? = y (\self : triage
|
|||||||
(\_ : false)
|
(\_ : false)
|
||||||
(\bx by : lAnd (self ax bx) (self ay by))))
|
(\bx by : lAnd (self ax bx) (self ay by))))
|
||||||
|
|
||||||
filter_ = y (\self : matchList
|
succ = y (\self :
|
||||||
(\_ : t)
|
triage
|
||||||
(\head tail f : matchBool (t head) i (f head) (self tail f)))
|
1
|
||||||
filter = \f l : filter_ l f
|
t
|
||||||
|
(triage
|
||||||
foldl_ = y (\self f l x : matchList (\acc : acc) (\head tail acc : self f tail (f acc head)) l x)
|
(t (t t))
|
||||||
foldl = \f x l : foldl_ f l x
|
(\_ tail : t t (self tail))
|
||||||
|
t))
|
||||||
foldr_ = y (\self x f l : matchList x (\head tail : f (self x f tail) head) l)
|
|
||||||
foldr = \f x l : foldr_ x f l
|
|
||||||
|
77
lib/list.tri
Normal file
77
lib/list.tri
Normal file
@ -0,0 +1,77 @@
|
|||||||
|
!import "base.tri" !Local
|
||||||
|
|
||||||
|
matchList = \a b : triage a _ b
|
||||||
|
|
||||||
|
emptyList? = matchList true (\_ _ : false)
|
||||||
|
head = matchList t (\head _ : head)
|
||||||
|
tail = matchList t (\_ tail : tail)
|
||||||
|
|
||||||
|
append = y (\self : matchList
|
||||||
|
(\k : k)
|
||||||
|
(\h r k : pair h (self r k)))
|
||||||
|
|
||||||
|
lExist? = y (\self x : matchList
|
||||||
|
false
|
||||||
|
(\h z : or? (equal? x h) (self x z)))
|
||||||
|
|
||||||
|
map_ = y (\self :
|
||||||
|
matchList
|
||||||
|
(\_ : t)
|
||||||
|
(\head tail f : pair (f head) (self tail f)))
|
||||||
|
map = \f l : map_ l f
|
||||||
|
|
||||||
|
filter_ = y (\self : matchList
|
||||||
|
(\_ : t)
|
||||||
|
(\head tail f : matchBool (t head) id (f head) (self tail f)))
|
||||||
|
filter = \f l : filter_ l f
|
||||||
|
|
||||||
|
foldl_ = y (\self f l x : matchList (\acc : acc) (\head tail acc : self f tail (f acc head)) l x)
|
||||||
|
foldl = \f x l : foldl_ f l x
|
||||||
|
|
||||||
|
foldr_ = y (\self x f l : matchList x (\head tail : f (self x f tail) head) l)
|
||||||
|
foldr = \f x l : foldr_ x f l
|
||||||
|
|
||||||
|
length = y (\self : matchList
|
||||||
|
0
|
||||||
|
(\_ tail : succ (self tail)))
|
||||||
|
|
||||||
|
reverse = y (\self : matchList
|
||||||
|
t
|
||||||
|
(\head tail : append (self tail) (pair head t)))
|
||||||
|
|
||||||
|
snoc = y (\self x : matchList
|
||||||
|
(pair x t)
|
||||||
|
(\h z : pair h (self x z)))
|
||||||
|
|
||||||
|
count = y (\self x : matchList
|
||||||
|
0
|
||||||
|
(\h z : matchBool
|
||||||
|
(succ (self x z))
|
||||||
|
(self x z)
|
||||||
|
(equal? x h)))
|
||||||
|
|
||||||
|
last = y (\self : matchList
|
||||||
|
t
|
||||||
|
(\hd tl : matchBool
|
||||||
|
hd
|
||||||
|
(self tl)
|
||||||
|
(emptyList? tl)))
|
||||||
|
|
||||||
|
all? = y (\self pred : matchList
|
||||||
|
true
|
||||||
|
(\h z : and? (pred h) (self pred z)))
|
||||||
|
|
||||||
|
any? = y (\self pred : matchList
|
||||||
|
false
|
||||||
|
(\h z : or? (pred h) (self pred z)))
|
||||||
|
|
||||||
|
unique_ = y (\self seen : matchList
|
||||||
|
t
|
||||||
|
(\head rest : matchBool
|
||||||
|
(self seen rest)
|
||||||
|
(pair head (self (pair head seen) rest))
|
||||||
|
(lExist? head seen)))
|
||||||
|
unique = \xs : unique_ t xs
|
||||||
|
|
||||||
|
intersect = \xs ys : filter (\x : lExist? x ys) xs
|
||||||
|
union = \xs ys : unique (append xs ys)
|
35
lib/patterns.tri
Normal file
35
lib/patterns.tri
Normal file
@ -0,0 +1,35 @@
|
|||||||
|
!import "list.tri" !Local
|
||||||
|
|
||||||
|
match_ = y (\self value patterns :
|
||||||
|
triage
|
||||||
|
t
|
||||||
|
(\_ : t)
|
||||||
|
(\pattern rest :
|
||||||
|
triage
|
||||||
|
t
|
||||||
|
(\_ : t)
|
||||||
|
(\test result :
|
||||||
|
if (test value)
|
||||||
|
(result value)
|
||||||
|
(self value rest))
|
||||||
|
pattern)
|
||||||
|
patterns)
|
||||||
|
|
||||||
|
match = (\value patterns :
|
||||||
|
match_ value (map (\sublist :
|
||||||
|
pair (head sublist) (head (tail sublist)))
|
||||||
|
patterns))
|
||||||
|
|
||||||
|
otherwise = const (t t)
|
||||||
|
|
||||||
|
-- matchExample = (\x : match x [[(equal? 1) (\_ : "one")]
|
||||||
|
-- [(equal? 2) (\_ : "two")]
|
||||||
|
-- [(equal? 3) (\_ : "three")]
|
||||||
|
-- [(equal? 4) (\_ : "four")]
|
||||||
|
-- [(equal? 5) (\_ : "five")]
|
||||||
|
-- [(equal? 6) (\_ : "six")]
|
||||||
|
-- [(equal? 7) (\_ : "seven")]
|
||||||
|
-- [(equal? 8) (\_ : "eight")]
|
||||||
|
-- [(equal? 9) (\_ : "nine")]
|
||||||
|
-- [(equal? 10) (\_ : "ten")]
|
||||||
|
-- [ otherwise (\_ : "I ran out of fingers!")]])
|
26
src/Eval.hs
26
src/Eval.hs
@ -19,16 +19,16 @@ evalSingle env term
|
|||||||
Nothing ->
|
Nothing ->
|
||||||
let res = evalAST env body
|
let res = evalAST env body
|
||||||
in Map.insert "!result" res (Map.insert name res env)
|
in Map.insert "!result" res (Map.insert name res env)
|
||||||
| SApp func arg <- term
|
| SApp func arg <- term
|
||||||
= let res = apply (evalAST env func) (evalAST env arg)
|
= let res = apply (evalAST env func) (evalAST env arg)
|
||||||
in Map.insert "!result" res env
|
in Map.insert "!result" res env
|
||||||
| SVar name <- term
|
| SVar name <- term
|
||||||
= case Map.lookup name env of
|
= case Map.lookup name env of
|
||||||
Just v -> Map.insert "!result" v env
|
Just v -> Map.insert "!result" v env
|
||||||
Nothing ->
|
Nothing ->
|
||||||
errorWithoutStackTrace $ "Variable `" ++ name ++ "` not defined\n\
|
errorWithoutStackTrace $ "Variable `" ++ name ++ "` not defined\n\
|
||||||
\This error should never occur here. Please report this as an issue."
|
\This error should never occur here. Please report this as an issue."
|
||||||
| otherwise
|
| otherwise
|
||||||
= Map.insert "!result" (evalAST env term) env
|
= Map.insert "!result" (evalAST env term) env
|
||||||
|
|
||||||
evalTricu :: Env -> [TricuAST] -> Env
|
evalTricu :: Env -> [TricuAST] -> Env
|
||||||
@ -74,8 +74,6 @@ elimLambda = go
|
|||||||
-- Composition optimization
|
-- Composition optimization
|
||||||
go (SLambda [f] (SLambda [g] (SLambda [x] body)))
|
go (SLambda [f] (SLambda [g] (SLambda [x] body)))
|
||||||
| body == SApp (SVar f) (SApp (SVar g) (SVar x)) = _B
|
| body == SApp (SVar f) (SApp (SVar g) (SVar x)) = _B
|
||||||
go (SLambda [f] (SLambda [x] (SLambda [y] body)))
|
|
||||||
| body == SApp (SApp (SVar f) (SVar y)) (SVar x) = _C
|
|
||||||
-- General elimination
|
-- General elimination
|
||||||
go (SLambda (v:vs) body)
|
go (SLambda (v:vs) body)
|
||||||
| null vs = toSKI v (elimLambda body)
|
| null vs = toSKI v (elimLambda body)
|
||||||
@ -97,7 +95,6 @@ elimLambda = go
|
|||||||
_K = parseSingle "t t"
|
_K = parseSingle "t t"
|
||||||
_I = parseSingle "t (t (t t)) t"
|
_I = parseSingle "t (t (t t)) t"
|
||||||
_B = parseSingle "t (t (t t (t (t (t t t)) t))) (t t)"
|
_B = parseSingle "t (t (t t (t (t (t t t)) t))) (t t)"
|
||||||
_C = parseSingle "t (t (t (t (t t (t (t (t t t)) t))) (t (t (t t (t t))) (t (t (t t t)) t)))) (t t (t t))"
|
|
||||||
_TRIAGE = parseSingle "t (t (t t (t (t (t t t))))) t"
|
_TRIAGE = parseSingle "t (t (t t (t (t (t t t))))) t"
|
||||||
|
|
||||||
isFree :: String -> TricuAST -> Bool
|
isFree :: String -> TricuAST -> Bool
|
||||||
@ -144,18 +141,23 @@ reorderDefs env defs
|
|||||||
|
|
||||||
buildDepGraph :: [TricuAST] -> Map.Map String (Set.Set String)
|
buildDepGraph :: [TricuAST] -> Map.Map String (Set.Set String)
|
||||||
buildDepGraph topDefs
|
buildDepGraph topDefs
|
||||||
| not (null duplicateNames) =
|
| not (null conflictingDefs) =
|
||||||
errorWithoutStackTrace $
|
errorWithoutStackTrace $
|
||||||
"Duplicate definitions detected: " ++ show duplicateNames
|
"Conflicting definitions detected: " ++ show conflictingDefs
|
||||||
| otherwise =
|
| otherwise =
|
||||||
Map.fromList
|
Map.fromList
|
||||||
[ (name, depends topDefs (SDef name [] body))
|
[ (name, depends topDefs (SDef name [] body))
|
||||||
| SDef name _ body <- topDefs]
|
| SDef name _ body <- topDefs]
|
||||||
where
|
where
|
||||||
names = [name | SDef name _ _ <- topDefs]
|
defsMap = Map.fromListWith (++)
|
||||||
duplicateNames =
|
[(name, [(name, body)]) | SDef name _ body <- topDefs]
|
||||||
[ name | (name, count) <- Map.toList (countOccurrences names) , count > 1]
|
|
||||||
countOccurrences = foldr (\x -> Map.insertWith (+) x 1) Map.empty
|
conflictingDefs =
|
||||||
|
[ name
|
||||||
|
| (name, defs) <- Map.toList defsMap
|
||||||
|
, let bodies = map snd defs
|
||||||
|
, not $ all (== head bodies) (tail bodies)
|
||||||
|
]
|
||||||
|
|
||||||
sortDeps :: Map.Map String (Set.Set String) -> [String]
|
sortDeps :: Map.Map String (Set.Set String) -> [String]
|
||||||
sortDeps graph = go [] Set.empty (Map.keys graph)
|
sortDeps graph = go [] Set.empty (Map.keys graph)
|
||||||
|
107
src/FileEval.hs
107
src/FileEval.hs
@ -6,12 +6,34 @@ import Parser
|
|||||||
import Research
|
import Research
|
||||||
|
|
||||||
import Data.List (partition)
|
import Data.List (partition)
|
||||||
|
import Data.Maybe (mapMaybe)
|
||||||
import Control.Monad (foldM)
|
import Control.Monad (foldM)
|
||||||
import System.IO
|
import System.IO
|
||||||
|
import System.FilePath (takeDirectory, normalise, (</>))
|
||||||
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
|
|
||||||
|
extractMain :: Env -> Either String T
|
||||||
|
extractMain env =
|
||||||
|
case Map.lookup "main" env of
|
||||||
|
Just result -> Right result
|
||||||
|
Nothing -> Left "No `main` function detected"
|
||||||
|
|
||||||
|
processImports :: Set.Set FilePath -> FilePath -> FilePath -> [TricuAST]
|
||||||
|
-> Either String ([TricuAST], [(FilePath, String, FilePath)])
|
||||||
|
processImports seen base currentPath asts =
|
||||||
|
let (imports, nonImports) = partition isImp asts
|
||||||
|
importPaths = mapMaybe getImportInfo imports
|
||||||
|
in if currentPath `Set.member` seen
|
||||||
|
then Left $ "Encountered cyclic import: " ++ currentPath
|
||||||
|
else Right (nonImports, importPaths)
|
||||||
|
where
|
||||||
|
isImp (SImport _ _) = True
|
||||||
|
isImp _ = False
|
||||||
|
getImportInfo (SImport p n) = Just (p, n, makeRelativeTo currentPath p)
|
||||||
|
getImportInfo _ = Nothing
|
||||||
|
|
||||||
evaluateFileResult :: FilePath -> IO T
|
evaluateFileResult :: FilePath -> IO T
|
||||||
evaluateFileResult filePath = do
|
evaluateFileResult filePath = do
|
||||||
contents <- readFile filePath
|
contents <- readFile filePath
|
||||||
@ -19,11 +41,11 @@ evaluateFileResult filePath = do
|
|||||||
case parseProgram tokens of
|
case parseProgram tokens of
|
||||||
Left err -> errorWithoutStackTrace (handleParseError err)
|
Left err -> errorWithoutStackTrace (handleParseError err)
|
||||||
Right ast -> do
|
Right ast -> do
|
||||||
ast <- preprocessFile filePath
|
processedAst <- preprocessFile filePath
|
||||||
let finalEnv = evalTricu Map.empty ast
|
let finalEnv = evalTricu Map.empty processedAst
|
||||||
case Map.lookup "main" finalEnv of
|
case extractMain finalEnv of
|
||||||
Just finalResult -> return finalResult
|
Right result -> return result
|
||||||
Nothing -> errorWithoutStackTrace "No `main` function detected"
|
Left err -> errorWithoutStackTrace err
|
||||||
|
|
||||||
evaluateFile :: FilePath -> IO Env
|
evaluateFile :: FilePath -> IO Env
|
||||||
evaluateFile filePath = do
|
evaluateFile filePath = do
|
||||||
@ -46,37 +68,33 @@ evaluateFileWithContext env filePath = do
|
|||||||
pure $ evalTricu env ast
|
pure $ evalTricu env ast
|
||||||
|
|
||||||
preprocessFile :: FilePath -> IO [TricuAST]
|
preprocessFile :: FilePath -> IO [TricuAST]
|
||||||
preprocessFile = preprocessFile' Set.empty
|
preprocessFile p = preprocessFile' Set.empty p p
|
||||||
|
|
||||||
preprocessFile' :: Set.Set FilePath -> FilePath -> IO [TricuAST]
|
preprocessFile' :: Set.Set FilePath -> FilePath -> FilePath -> IO [TricuAST]
|
||||||
preprocessFile' inProgress filePath
|
preprocessFile' seen base currentPath = do
|
||||||
| filePath `Set.member` inProgress =
|
contents <- readFile currentPath
|
||||||
errorWithoutStackTrace $ "Encountered cyclic import: " ++ filePath
|
let tokens = lexTricu contents
|
||||||
| otherwise = do
|
case parseProgram tokens of
|
||||||
contents <- readFile filePath
|
Left err -> errorWithoutStackTrace (handleParseError err)
|
||||||
let tokens = lexTricu contents
|
Right ast ->
|
||||||
case parseProgram tokens of
|
case processImports seen base currentPath ast of
|
||||||
Left err -> errorWithoutStackTrace (handleParseError err)
|
Left err -> errorWithoutStackTrace err
|
||||||
Right asts -> do
|
Right (nonImports, importPaths) -> do
|
||||||
let (imports, nonImports) = partition isImport asts
|
let seen' = Set.insert currentPath seen
|
||||||
let newInProgress = Set.insert filePath inProgress
|
imported <- concat <$> mapM (processImportPath seen' base) importPaths
|
||||||
importedASTs <- concat <$> mapM (processImport newInProgress "") imports
|
pure $ imported ++ nonImports
|
||||||
pure $ importedASTs ++ nonImports
|
|
||||||
where
|
where
|
||||||
isImport :: TricuAST -> Bool
|
processImportPath seen base (path, name, importPath) = do
|
||||||
isImport (SImport _ _) = True
|
ast <- preprocessFile' seen base importPath
|
||||||
isImport _ = False
|
pure $ map (nsDefinition (if name == "!Local" then "" else name))
|
||||||
|
$ filter (not . isImp) ast
|
||||||
|
isImp (SImport _ _) = True
|
||||||
|
isImp _ = False
|
||||||
|
|
||||||
processImport :: Set.Set FilePath -> String -> TricuAST -> IO [TricuAST]
|
makeRelativeTo :: FilePath -> FilePath -> FilePath
|
||||||
processImport prog currentModule (SImport path "!Local") = do
|
makeRelativeTo f i =
|
||||||
ast <- preprocessFile' prog path
|
let d = takeDirectory f
|
||||||
let defs = filter (not . isImport) ast
|
in normalise $ d </> i
|
||||||
pure $ map (nsDefinition currentModule) defs
|
|
||||||
processImport prog _ (SImport path name) = do
|
|
||||||
ast <- preprocessFile' prog path
|
|
||||||
let defs = filter (not . isImport) ast
|
|
||||||
pure $ map (nsDefinition name) defs
|
|
||||||
processImport _ _ _ = error "Unexpected non-import in processImport"
|
|
||||||
|
|
||||||
nsDefinitions :: String -> [TricuAST] -> [TricuAST]
|
nsDefinitions :: String -> [TricuAST] -> [TricuAST]
|
||||||
nsDefinitions moduleName = map (nsDefinition moduleName)
|
nsDefinitions moduleName = map (nsDefinition moduleName)
|
||||||
@ -85,7 +103,7 @@ nsDefinition :: String -> TricuAST -> TricuAST
|
|||||||
nsDefinition "" def = def
|
nsDefinition "" def = def
|
||||||
nsDefinition moduleName (SDef name args body)
|
nsDefinition moduleName (SDef name args body)
|
||||||
| isPrefixed name = SDef name args (nsBody moduleName body)
|
| isPrefixed name = SDef name args (nsBody moduleName body)
|
||||||
| otherwise = SDef (nsVariable moduleName name)
|
| otherwise = SDef (nsVariable moduleName name)
|
||||||
args (nsBody moduleName body)
|
args (nsBody moduleName body)
|
||||||
nsDefinition moduleName other =
|
nsDefinition moduleName other =
|
||||||
nsBody moduleName other
|
nsBody moduleName other
|
||||||
@ -106,7 +124,7 @@ nsBody moduleName (TStem subtree) =
|
|||||||
TStem (nsBody moduleName subtree)
|
TStem (nsBody moduleName subtree)
|
||||||
nsBody moduleName (SDef name args body)
|
nsBody moduleName (SDef name args body)
|
||||||
| isPrefixed name = SDef name args (nsBody moduleName body)
|
| isPrefixed name = SDef name args (nsBody moduleName body)
|
||||||
| otherwise = SDef (nsVariable moduleName name)
|
| otherwise = SDef (nsVariable moduleName name)
|
||||||
args (nsBody moduleName body)
|
args (nsBody moduleName body)
|
||||||
nsBody _ other = other
|
nsBody _ other = other
|
||||||
|
|
||||||
@ -116,13 +134,20 @@ nsBodyScoped moduleName args body = case body of
|
|||||||
if name `elem` args
|
if name `elem` args
|
||||||
then SVar name
|
then SVar name
|
||||||
else nsBody moduleName (SVar name)
|
else nsBody moduleName (SVar name)
|
||||||
SApp func arg -> SApp (nsBodyScoped moduleName args func) (nsBodyScoped moduleName args arg)
|
SApp func arg ->
|
||||||
SLambda innerArgs innerBody -> SLambda innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody)
|
SApp (nsBodyScoped moduleName args func) (nsBodyScoped moduleName args arg)
|
||||||
SList items -> SList (map (nsBodyScoped moduleName args) items)
|
SLambda innerArgs innerBody ->
|
||||||
TFork left right -> TFork (nsBodyScoped moduleName args left) (nsBodyScoped moduleName args right)
|
SLambda innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody)
|
||||||
TStem subtree -> TStem (nsBodyScoped moduleName args subtree)
|
SList items ->
|
||||||
|
SList (map (nsBodyScoped moduleName args) items)
|
||||||
|
TFork left right ->
|
||||||
|
TFork (nsBodyScoped moduleName args left)
|
||||||
|
(nsBodyScoped moduleName args right)
|
||||||
|
TStem subtree ->
|
||||||
|
TStem (nsBodyScoped moduleName args subtree)
|
||||||
SDef name innerArgs innerBody ->
|
SDef name innerArgs innerBody ->
|
||||||
SDef (nsVariable moduleName name) innerArgs (nsBodyScoped moduleName (args ++ innerArgs) innerBody)
|
SDef (nsVariable moduleName name) innerArgs
|
||||||
|
(nsBodyScoped moduleName (args ++ innerArgs) innerBody)
|
||||||
other -> other
|
other -> other
|
||||||
|
|
||||||
isPrefixed :: String -> Bool
|
isPrefixed :: String -> Bool
|
||||||
|
@ -59,7 +59,7 @@ keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT
|
|||||||
identifier :: Lexer LToken
|
identifier :: Lexer LToken
|
||||||
identifier = do
|
identifier = do
|
||||||
first <- lowerChar <|> char '_'
|
first <- lowerChar <|> char '_'
|
||||||
rest <- many $ letterChar
|
rest <- many $ letterChar
|
||||||
<|> digitChar <|> char '_' <|> char '-' <|> char '?'
|
<|> digitChar <|> char '_' <|> char '-' <|> char '?'
|
||||||
<|> char '$' <|> char '#' <|> char '@' <|> char '%'
|
<|> char '$' <|> char '#' <|> char '@' <|> char '%'
|
||||||
let name = first : rest
|
let name = first : rest
|
||||||
|
@ -8,7 +8,9 @@ import Research
|
|||||||
|
|
||||||
import Control.Monad (foldM)
|
import Control.Monad (foldM)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import Data.Version (showVersion)
|
||||||
import Text.Megaparsec (runParser)
|
import Text.Megaparsec (runParser)
|
||||||
|
import Paths_tricu (version)
|
||||||
import System.Console.CmdArgs
|
import System.Console.CmdArgs
|
||||||
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
@ -52,10 +54,12 @@ decodeMode = TDecode
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
let versionStr = "tricu Evaluator and REPL " ++ showVersion version
|
||||||
args <- cmdArgs $ modes [replMode, evaluateMode, decodeMode]
|
args <- cmdArgs $ modes [replMode, evaluateMode, decodeMode]
|
||||||
&= help "tricu: Exploring Tree Calculus"
|
&= help "tricu: Exploring Tree Calculus"
|
||||||
&= program "tricu"
|
&= program "tricu"
|
||||||
&= summary "tricu Evaluator and REPL"
|
&= summary versionStr
|
||||||
|
&= versionArg [explicit, name "version", summary versionStr]
|
||||||
case args of
|
case args of
|
||||||
Repl -> do
|
Repl -> do
|
||||||
putStrLn "Welcome to the tricu REPL"
|
putStrLn "Welcome to the tricu REPL"
|
||||||
|
@ -255,9 +255,9 @@ parseSingleItemM = do
|
|||||||
|
|
||||||
parseVarM :: ParserM TricuAST
|
parseVarM :: ParserM TricuAST
|
||||||
parseVarM = do
|
parseVarM = do
|
||||||
token <- satisfyM (\case
|
token <- satisfyM (\case
|
||||||
LNamespace _ -> True
|
LNamespace _ -> True
|
||||||
LIdentifier _ -> True
|
LIdentifier _ -> True
|
||||||
_ -> False)
|
_ -> False)
|
||||||
case token of
|
case token of
|
||||||
LNamespace ns -> do
|
LNamespace ns -> do
|
||||||
|
110
src/REPL.hs
110
src/REPL.hs
@ -8,59 +8,109 @@ import Research
|
|||||||
|
|
||||||
import Control.Exception (SomeException, catch)
|
import Control.Exception (SomeException, catch)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Catch (handle, MonadCatch)
|
import Control.Monad.Catch (handle, MonadCatch)
|
||||||
|
import Control.Monad.Trans.Class (lift)
|
||||||
|
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
|
||||||
import Data.Char (isSpace)
|
import Data.Char (isSpace)
|
||||||
import Data.List (dropWhile, dropWhileEnd, intercalate)
|
import Data.List ( dropWhile
|
||||||
|
, dropWhileEnd
|
||||||
|
, isPrefixOf)
|
||||||
import System.Console.Haskeline
|
import System.Console.Haskeline
|
||||||
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
repl :: Env -> IO ()
|
repl :: Env -> IO ()
|
||||||
repl env = runInputT defaultSettings (withInterrupt (loop env))
|
repl env = runInputT settings (withInterrupt (loop env True))
|
||||||
where
|
where
|
||||||
loop :: Env -> InputT IO ()
|
settings :: Settings IO
|
||||||
loop env = handle (interruptHandler env) $ do
|
settings = Settings
|
||||||
|
{ complete = completeWord Nothing " \t" completeCommands
|
||||||
|
, historyFile = Just ".tricu_history"
|
||||||
|
, autoAddHistory = True
|
||||||
|
}
|
||||||
|
|
||||||
|
completeCommands :: String -> IO [Completion]
|
||||||
|
completeCommands str = return $ map simpleCompletion $
|
||||||
|
filter (str `isPrefixOf`) commands
|
||||||
|
where
|
||||||
|
commands = ["!exit", "!decode", "!definitions", "!import"]
|
||||||
|
|
||||||
|
loop :: Env -> Bool -> InputT IO ()
|
||||||
|
loop env decode = handle (interruptHandler env decode) $ do
|
||||||
minput <- getInputLine "tricu < "
|
minput <- getInputLine "tricu < "
|
||||||
case minput of
|
case minput of
|
||||||
Nothing -> outputStrLn "Exiting tricu"
|
Nothing -> outputStrLn "Exiting tricu"
|
||||||
Just s
|
Just s
|
||||||
|
| strip s == "" -> loop env decode
|
||||||
| strip s == "!exit" -> outputStrLn "Exiting tricu"
|
| strip s == "!exit" -> outputStrLn "Exiting tricu"
|
||||||
| strip s == "" -> loop env
|
| strip s == "!decode" -> do
|
||||||
| strip s == "!import" -> do
|
outputStrLn $ "Decoding " ++ (if decode then "disabled" else "enabled")
|
||||||
path <- getInputLine "File path to load < "
|
loop env (not decode)
|
||||||
case path of
|
| strip s == "!definitions" -> do
|
||||||
Nothing -> do
|
let defs = Map.keys $ Map.delete "!result" env
|
||||||
outputStrLn "No input received; stopping import."
|
if null defs
|
||||||
loop env
|
then outputStrLn "No definitions discovered."
|
||||||
Just p -> do
|
else do
|
||||||
loadedEnv <- liftIO $ evaluateFileWithContext env
|
outputStrLn "Available definitions:"
|
||||||
(strip p) `catch` \e -> errorHandler env e
|
mapM_ outputStrLn defs
|
||||||
loop $ Map.delete "!result" (Map.union loadedEnv env)
|
loop env decode
|
||||||
| take 2 s == "--" -> loop env
|
| "!import" `isPrefixOf` strip s -> handleImport env decode
|
||||||
|
| take 2 s == "--" -> loop env decode
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
newEnv <- liftIO $ processInput env s `catch` errorHandler env
|
newEnv <- liftIO $ processInput env s decode `catch` errorHandler env
|
||||||
loop newEnv
|
loop newEnv decode
|
||||||
|
|
||||||
interruptHandler :: Env -> Interrupt -> InputT IO ()
|
handleImport :: Env -> Bool -> InputT IO ()
|
||||||
interruptHandler env _ = do
|
handleImport env decode = do
|
||||||
|
result <- runMaybeT $ do
|
||||||
|
let fileSettings = setComplete completeFilename defaultSettings
|
||||||
|
path <- MaybeT $ runInputT fileSettings $
|
||||||
|
getInputLineWithInitial "File path to load < " ("", "")
|
||||||
|
|
||||||
|
contents <- liftIO $ readFile (strip path)
|
||||||
|
|
||||||
|
if | Left err <- parseProgram (lexTricu contents) -> do
|
||||||
|
lift $ outputStrLn $ "Parse error: " ++ handleParseError err
|
||||||
|
MaybeT $ return Nothing
|
||||||
|
| Right ast <- parseProgram (lexTricu contents) -> do
|
||||||
|
ns <- MaybeT $ runInputT defaultSettings $
|
||||||
|
getInputLineWithInitial "Namespace (or !Local for no namespace) < " ("", "")
|
||||||
|
|
||||||
|
processedAst <- liftIO $ preprocessFile (strip path)
|
||||||
|
let namespacedAst | strip ns == "!Local" = processedAst
|
||||||
|
| otherwise = nsDefinitions (strip ns) processedAst
|
||||||
|
loadedEnv = evalTricu env namespacedAst
|
||||||
|
return loadedEnv
|
||||||
|
|
||||||
|
if | Nothing <- result -> do
|
||||||
|
outputStrLn "Import cancelled."
|
||||||
|
loop env decode
|
||||||
|
| Just loadedEnv <- result ->
|
||||||
|
loop (Map.delete "!result" loadedEnv) decode
|
||||||
|
|
||||||
|
interruptHandler :: Env -> Bool -> Interrupt -> InputT IO ()
|
||||||
|
interruptHandler env decode _ = do
|
||||||
outputStrLn "Interrupted with CTRL+C\n\
|
outputStrLn "Interrupted with CTRL+C\n\
|
||||||
\You can use the !exit command or CTRL+D to exit"
|
\You can use the !exit command or CTRL+D to exit"
|
||||||
loop env
|
loop env decode
|
||||||
|
|
||||||
processInput :: Env -> String -> IO Env
|
processInput :: Env -> String -> Bool -> IO Env
|
||||||
processInput env input = do
|
processInput env input decode = do
|
||||||
let asts = parseTricu input
|
let asts = parseTricu input
|
||||||
newEnv = evalTricu env asts
|
newEnv = evalTricu env asts
|
||||||
if
|
case Map.lookup "!result" newEnv of
|
||||||
| Just r <- Map.lookup "!result" newEnv -> do
|
Just r -> do
|
||||||
putStrLn $ "tricu > " ++ decodeResult r
|
putStrLn $ "tricu > " ++
|
||||||
| otherwise -> return ()
|
if decode
|
||||||
|
then decodeResult r
|
||||||
|
else show r
|
||||||
|
Nothing -> pure ()
|
||||||
return newEnv
|
return newEnv
|
||||||
|
|
||||||
errorHandler :: Env -> SomeException -> IO (Env)
|
errorHandler :: Env -> SomeException -> IO (Env)
|
||||||
errorHandler env e = do
|
errorHandler env e = do
|
||||||
putStrLn $ "Error: " ++ show e
|
putStrLn $ "Error: " ++ show e
|
||||||
return env
|
return env
|
||||||
|
|
||||||
strip :: String -> String
|
strip :: String -> String
|
||||||
strip = dropWhileEnd isSpace . dropWhile isSpace
|
strip = dropWhileEnd isSpace . dropWhile isSpace
|
||||||
|
@ -53,7 +53,7 @@ data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii | Decode
|
|||||||
deriving (Show, Data, Typeable)
|
deriving (Show, Data, Typeable)
|
||||||
|
|
||||||
-- Environment containing previously evaluated TC terms
|
-- Environment containing previously evaluated TC terms
|
||||||
type Env = Map.Map String T
|
type Env = Map.Map String T
|
||||||
|
|
||||||
-- Tree Calculus Reduction
|
-- Tree Calculus Reduction
|
||||||
apply :: T -> T -> T
|
apply :: T -> T -> T
|
||||||
@ -122,7 +122,7 @@ formatResult Ascii = toAscii
|
|||||||
formatResult Decode = decodeResult
|
formatResult Decode = decodeResult
|
||||||
|
|
||||||
toSimpleT :: String -> String
|
toSimpleT :: String -> String
|
||||||
toSimpleT s = T.unpack
|
toSimpleT s = T.unpack
|
||||||
$ replace "Fork" "t"
|
$ replace "Fork" "t"
|
||||||
$ replace "Stem" "t"
|
$ replace "Stem" "t"
|
||||||
$ replace "Leaf" "t"
|
$ replace "Leaf" "t"
|
||||||
|
82
test/Spec.hs
82
test/Spec.hs
@ -30,7 +30,7 @@ tests = testGroup "Tricu Tests"
|
|||||||
, parser
|
, parser
|
||||||
, simpleEvaluation
|
, simpleEvaluation
|
||||||
, lambdas
|
, lambdas
|
||||||
, baseLibrary
|
, providedLibraries
|
||||||
, fileEval
|
, fileEval
|
||||||
, modules
|
, modules
|
||||||
, demos
|
, demos
|
||||||
@ -343,137 +343,101 @@ lambdas = testGroup "Lambda Evaluation Tests"
|
|||||||
runTricu input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
|
runTricu input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
|
||||||
]
|
]
|
||||||
|
|
||||||
baseLibrary :: TestTree
|
providedLibraries :: TestTree
|
||||||
baseLibrary = testGroup "Library Tests"
|
providedLibraries = testGroup "Library Tests"
|
||||||
[ testCase "K combinator 1" $ do
|
[ testCase "Triage test Leaf" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.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"
|
let input = "test t"
|
||||||
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
||||||
env @?= "\"Leaf\""
|
env @?= "\"Leaf\""
|
||||||
|
|
||||||
, testCase "Triage test (Stem Leaf)" $ do
|
, testCase "Triage test (Stem Leaf)" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "test (t t)"
|
let input = "test (t t)"
|
||||||
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
||||||
env @?= "\"Stem\""
|
env @?= "\"Stem\""
|
||||||
|
|
||||||
, testCase "Triage test (Fork Leaf Leaf)" $ do
|
, testCase "Triage test (Fork Leaf Leaf)" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "test (t t t)"
|
let input = "test (t t t)"
|
||||||
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
||||||
env @?= "\"Fork\""
|
env @?= "\"Fork\""
|
||||||
|
|
||||||
, testCase "Boolean NOT: true" $ do
|
, testCase "Boolean NOT: true" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "not? true"
|
let input = "not? true"
|
||||||
env = result $ evalTricu library (parseTricu input)
|
env = result $ evalTricu library (parseTricu input)
|
||||||
env @?= Leaf
|
env @?= Leaf
|
||||||
|
|
||||||
, testCase "Boolean NOT: false" $ do
|
, testCase "Boolean NOT: false" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "not? false"
|
let input = "not? false"
|
||||||
env = result $ evalTricu library (parseTricu input)
|
env = result $ evalTricu library (parseTricu input)
|
||||||
env @?= Stem Leaf
|
env @?= Stem Leaf
|
||||||
|
|
||||||
|
|
||||||
, testCase "Boolean AND TF" $ do
|
, testCase "Boolean AND TF" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "and? (t t) (t)"
|
let input = "and? (t t) (t)"
|
||||||
env = evalTricu library (parseTricu input)
|
env = evalTricu library (parseTricu input)
|
||||||
result env @?= Leaf
|
result env @?= Leaf
|
||||||
|
|
||||||
, testCase "Boolean AND FT" $ do
|
, testCase "Boolean AND FT" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "and? (t) (t t)"
|
let input = "and? (t) (t t)"
|
||||||
env = evalTricu library (parseTricu input)
|
env = evalTricu library (parseTricu input)
|
||||||
result env @?= Leaf
|
result env @?= Leaf
|
||||||
|
|
||||||
, testCase "Boolean AND FF" $ do
|
, testCase "Boolean AND FF" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "and? (t) (t)"
|
let input = "and? (t) (t)"
|
||||||
env = evalTricu library (parseTricu input)
|
env = evalTricu library (parseTricu input)
|
||||||
result env @?= Leaf
|
result env @?= Leaf
|
||||||
|
|
||||||
, testCase "Boolean AND TT" $ do
|
, testCase "Boolean AND TT" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "and? (t t) (t t)"
|
let input = "and? (t t) (t t)"
|
||||||
env = evalTricu library (parseTricu input)
|
env = evalTricu library (parseTricu input)
|
||||||
result env @?= Stem Leaf
|
result env @?= Stem Leaf
|
||||||
|
|
||||||
, testCase "List head" $ do
|
, testCase "List head" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "head [(t) (t t) (t t t)]"
|
let input = "head [(t) (t t) (t t t)]"
|
||||||
env = evalTricu library (parseTricu input)
|
env = evalTricu library (parseTricu input)
|
||||||
result env @?= Leaf
|
result env @?= Leaf
|
||||||
|
|
||||||
, testCase "List tail" $ do
|
, testCase "List tail" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "head (tail (tail [(t) (t t) (t t t)]))"
|
let input = "head (tail (tail [(t) (t t) (t t t)]))"
|
||||||
env = evalTricu library (parseTricu input)
|
env = evalTricu library (parseTricu input)
|
||||||
result env @?= Fork Leaf Leaf
|
result env @?= Fork Leaf Leaf
|
||||||
|
|
||||||
, testCase "List map" $ do
|
, testCase "List map" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "head (tail (map (\\a : (t t t)) [(t) (t) (t)]))"
|
let input = "head (tail (map (\\a : (t t t)) [(t) (t) (t)]))"
|
||||||
env = evalTricu library (parseTricu input)
|
env = evalTricu library (parseTricu input)
|
||||||
result env @?= Fork Leaf Leaf
|
result env @?= Fork Leaf Leaf
|
||||||
|
|
||||||
, testCase "Empty list check" $ do
|
, testCase "Empty list check" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "emptyList? []"
|
let input = "emptyList? []"
|
||||||
env = evalTricu library (parseTricu input)
|
env = evalTricu library (parseTricu input)
|
||||||
result env @?= Stem Leaf
|
result env @?= Stem Leaf
|
||||||
|
|
||||||
, testCase "Non-empty list check" $ do
|
, testCase "Non-empty list check" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "not? (emptyList? [(1) (2) (3)])"
|
let input = "not? (emptyList? [(1) (2) (3)])"
|
||||||
env = evalTricu library (parseTricu input)
|
env = evalTricu library (parseTricu input)
|
||||||
result env @?= Stem Leaf
|
result env @?= Stem Leaf
|
||||||
|
|
||||||
, testCase "Concatenate strings" $ do
|
, testCase "Concatenate strings" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "lconcat \"Hello, \" \"world!\""
|
let input = "append \"Hello, \" \"world!\""
|
||||||
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
env = decodeResult $ result $ evalTricu library (parseTricu input)
|
||||||
env @?= "\"Hello, world!\""
|
env @?= "\"Hello, world!\""
|
||||||
|
|
||||||
, testCase "Verifying Equality" $ do
|
, testCase "Verifying Equality" $ do
|
||||||
library <- evaluateFile "./lib/base.tri"
|
library <- evaluateFile "./lib/list.tri"
|
||||||
let input = "equal? (t t t) (t t t)"
|
let input = "equal? (t t t) (t t t)"
|
||||||
env = evalTricu library (parseTricu input)
|
env = evalTricu library (parseTricu input)
|
||||||
result env @?= Stem Leaf
|
result env @?= Stem Leaf
|
||||||
@ -490,12 +454,12 @@ fileEval = testGroup "File evaluation tests"
|
|||||||
res @?= Fork (Stem Leaf) Leaf
|
res @?= Fork (Stem Leaf) Leaf
|
||||||
|
|
||||||
, testCase "Mapping and Equality" $ do
|
, testCase "Mapping and Equality" $ do
|
||||||
library <- liftIO $ evaluateFile "./lib/base.tri"
|
library <- liftIO $ evaluateFile "./lib/list.tri"
|
||||||
fEnv <- liftIO $ evaluateFileWithContext library "./test/map.tri"
|
fEnv <- liftIO $ evaluateFileWithContext library "./test/map.tri"
|
||||||
(mainResult fEnv) @?= Stem Leaf
|
(mainResult fEnv) @?= Stem Leaf
|
||||||
|
|
||||||
, testCase "Eval and decoding string" $ do
|
, testCase "Eval and decoding string" $ do
|
||||||
library <- liftIO $ evaluateFile "./lib/base.tri"
|
library <- liftIO $ evaluateFile "./lib/list.tri"
|
||||||
res <- liftIO $ evaluateFileWithContext library "./test/string.tri"
|
res <- liftIO $ evaluateFileWithContext library "./test/string.tri"
|
||||||
decodeResult (result res) @?= "\"String test!\""
|
decodeResult (result res) @?= "\"String test!\""
|
||||||
]
|
]
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
|
|
||||||
!import "test/cycle-2.tri" Cycle2
|
!import "cycle-2.tri" Cycle2
|
||||||
|
|
||||||
cycle1 = t Cycle2.cycle2
|
cycle1 = t Cycle2.cycle2
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
|
|
||||||
!import "test/cycle-1.tri" Cycle1
|
!import "cycle-1.tri" Cycle1
|
||||||
|
|
||||||
cycle2 = t Cycle1.cycle1
|
cycle2 = t Cycle1.cycle1
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
|
|
||||||
!import "test/local-ns/2.tri" Two
|
!import "2.tri" Two
|
||||||
|
|
||||||
main = Two.x
|
main = Two.x
|
||||||
|
@ -1,2 +1,2 @@
|
|||||||
|
|
||||||
!import "test/local-ns/3.tri" !Local
|
!import "3.tri" !Local
|
||||||
|
@ -1,2 +1 @@
|
|||||||
|
|
||||||
x = 3
|
x = 3
|
||||||
|
@ -1,2 +1,2 @@
|
|||||||
x = map (\i : lconcat "Successfully concatenated " i) [("two strings!")]
|
x = map (\i : append "Successfully concatenated " i) [("two strings!")]
|
||||||
main = equal? x [("Successfully concatenated two strings!")]
|
main = equal? x [("Successfully concatenated two strings!")]
|
||||||
|
@ -1,2 +1,2 @@
|
|||||||
!import "./test/multi-level-B.tri" B
|
!import "multi-level-B.tri" B
|
||||||
main = B.main
|
main = B.main
|
||||||
|
@ -1,2 +1,2 @@
|
|||||||
!import "./test/multi-level-C.tri" C
|
!import "multi-level-C.tri" C
|
||||||
main = C.val
|
main = C.val
|
||||||
|
@ -1,2 +1,2 @@
|
|||||||
!import "./test/namespace-B.tri" B
|
!import "namespace-B.tri" B
|
||||||
main = B.x
|
main = B.x
|
||||||
|
@ -1 +1 @@
|
|||||||
head (map (\i : lconcat "String " i) [("test!")])
|
head (map (\i : append "String " i) [("test!")])
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
|
|
||||||
!import "./test/vars-B.tri" B
|
!import "vars-B.tri" B
|
||||||
|
|
||||||
!import "./test/vars-C.tri" C
|
!import "vars-C.tri" C
|
||||||
|
|
||||||
main = B.y (C.z)
|
main = B.y (C.z)
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
cabal-version: 1.12
|
cabal-version: 1.12
|
||||||
|
|
||||||
name: tricu
|
name: tricu
|
||||||
version: 0.13.0
|
version: 0.15.0
|
||||||
description: A micro-language for exploring Tree Calculus
|
description: A micro-language for exploring Tree Calculus
|
||||||
author: James Eversole
|
author: James Eversole
|
||||||
maintainer: james@eversole.co
|
maintainer: james@eversole.co
|
||||||
@ -27,10 +27,12 @@ executable tricu
|
|||||||
, cmdargs
|
, cmdargs
|
||||||
, containers
|
, containers
|
||||||
, exceptions
|
, exceptions
|
||||||
|
, filepath
|
||||||
, haskeline
|
, haskeline
|
||||||
, megaparsec
|
, megaparsec
|
||||||
, mtl
|
, mtl
|
||||||
, text
|
, text
|
||||||
|
, transformers
|
||||||
other-modules:
|
other-modules:
|
||||||
Eval
|
Eval
|
||||||
FileEval
|
FileEval
|
||||||
@ -54,6 +56,7 @@ test-suite tricu-tests
|
|||||||
, cmdargs
|
, cmdargs
|
||||||
, containers
|
, containers
|
||||||
, exceptions
|
, exceptions
|
||||||
|
, filepath
|
||||||
, haskeline
|
, haskeline
|
||||||
, megaparsec
|
, megaparsec
|
||||||
, mtl
|
, mtl
|
||||||
@ -61,6 +64,7 @@ test-suite tricu-tests
|
|||||||
, tasty-hunit
|
, tasty-hunit
|
||||||
, tasty-quickcheck
|
, tasty-quickcheck
|
||||||
, text
|
, text
|
||||||
|
, transformers
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
other-modules:
|
other-modules:
|
||||||
Eval
|
Eval
|
||||||
|
Reference in New Issue
Block a user