commit 10c7cc367d0cf0cbbb70ad70a9e4c71adb9e7700
parent 118062d33ce9da676ea651272b8556b80316986d
Author: James Eversole <james@eversole.co>
Date: Thu, 23 Jan 2025 15:46:40 -0600
Some special characters in ids; new demos
Adds support for several special characters in identifiers. Adds a demo
for converting values to source code and another for checking equality.
Updates the existing demo and tests to reflect new names for functions
returning booleans.
Diffstat:
8 files changed, 208 insertions(+), 135 deletions(-)
diff --git a/README.md b/README.md
@@ -29,11 +29,11 @@ tricu > "Hello, world!"
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 < 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"
+tricu < -- We can even write a function to convert a term back to source code
+tricu < toSource not?
+tricu > "(t (t (t t) (t t t)) (t t (t t t)))"
```
## Installation and Use
diff --git a/demos/LevelOrderTraversal.tri b/demos/LevelOrderTraversal.tri
@@ -1,68 +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]]]
-
-exampleTwo
diff --git a/demos/equality.tri b/demos/equality.tri
@@ -0,0 +1,24 @@
+false = t
+true = t t
+
+triage = (\a b c : t (t a b) c)
+
+matchBool = (\ot of : triage
+ of
+ (\_ : ot)
+ (\_ _ : ot)
+)
+
+not_TC? = t (t (t t) (t t t)) (t t (t t t))
+not_Lambda? = matchBool false true
+
+areEqual? = equal not_TC not_Lambda
+
+true_TC? = not_TC false
+false_TC? = not_TC true
+
+true_Lambda? = not_Lambda false
+false_Lambda? = not_Lambda true
+
+areTrueEqual? = equal true_TC true_Lambda
+areFalseEqual? = equal false_TC false_Lambda
diff --git a/demos/levelOrderTraversal.tri b/demos/levelOrderTraversal.tri
@@ -0,0 +1,65 @@
+-- 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
+--
+
+label = (\node : head node)
+
+left = (\node : if (emptyList node)
+ []
+ (if (emptyList (tail node))
+ []
+ (head (tail node))))
+
+right = (\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 label queue) (self (filter
+ (\node : not (emptyList node))
+ (lconcat (map left queue) (map right 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) ""
+
+levelOrderTraversal = (\s : lconcat (t 10 t) (flatten (levelOrderToString s)))
+
+exampleOne = levelOrderTraversal [("1")
+ [("2") [("4") t t] t]
+ [("3") [("5") t t] [("6") t t]]]
+
+exampleTwo = levelOrderTraversal [("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]]]
+
+exampleTwo
diff --git a/demos/toSource.tri b/demos/toSource.tri
@@ -0,0 +1,46 @@
+-- Thanks to intensionality, we can inspect the structure of a given value
+-- even if it's a function. This includes lambdas which are eliminated to
+-- Tree Calculus (TC) terms during evaluation.
+
+-- Triage takes four arguments: the first three represent behaviors for each
+-- structural case in Tree Calculus (Leaf, Stem, and Fork).
+-- The fourth argument is the value whose structure is inspected. By evaluating
+-- the Tree Calculus term, `triage` enables branching logic based on the term's
+-- shape, making it possible to perform structure-specific operations such as
+-- reconstructing the terms' source code representation.
+triage = (\a b c : t (t a b) c)
+
+-- Base case of a single Leaf
+sourceLeaf = t (head "t")
+
+-- Stem case
+sourceStem = (\convert : (\a rest :
+ t (head "(") -- Start with a left parenthesis "(".
+ (t (head "t") -- Add a "t"
+ (t (head " ") -- Add a space.
+ (convert a -- Recursively convert the argument.
+ (t (head ")") rest)))))) -- Close with ")" and append the rest.
+
+-- Fork case
+sourceFork = (\convert : (\a b rest :
+ t (head "(") -- Start with a left parenthesis "(".
+ (t (head "t") -- Add a "t"
+ (t (head " ") -- Add a space.
+ (convert a -- Recursively convert the first arg.
+ (t (head " ") -- Add another space.
+ (convert b -- Recursively convert the second arg.
+ (t (head ")") rest)))))))) -- Close with ")" and append the rest.
+
+-- Wrapper around triage
+toSource_ = y (\self arg :
+ triage
+ sourceLeaf -- Triage `a` case, Leaf
+ (sourceStem self) -- Triage `b` case, Stem
+ (sourceFork self) -- Triage `c` case, Fork
+ arg) -- The term to be inspected
+
+-- toSource takes a single TC term and returns a String
+toSource = (\v : toSource_ v "")
+
+exampleOne = toSource true -- OUT: "(t t)"
+exampleTwo = toSource not -- OUT: "(t (t (t t) (t t t)) (t t (t t t)))"
diff --git a/lib/base.tri b/lib/base.tri
@@ -1,22 +1,25 @@
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)
+_ = 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)
+pair = t
+if = (\cond then else : t (t else (t t then)) t cond)
+
triage = (\a b c : t (t a b) c)
-pair = t
+test = triage "Leaf" (\_ : "Stem") (\_ _ : "Fork")
matchBool = (\ot of : triage
of
@@ -36,58 +39,58 @@ 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")
+not? = matchBool false true
+and? = matchBool id (\_ : false)
+emptyList? = matchList true (\_ _ : false)
-emptyList = matchList true (\y z : false)
-head = matchList t (\hd tl : hd)
-tail = matchList t (\hd tl : tl)
+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
- (\x : false)
- (\_ x : x)
+ (\_ : false)
+ (\_ x : x)
(\_ _ x : x)
)
lOr = (triage
- (\x : x)
- (\_ _ : true)
- (\_ _ x : true)
+ (\x : x)
+ (\_ _ : true)
+ (\_ _ _ : true)
)
-hmap = y (\self :
+map_ = y (\self :
matchList
- (\f : t)
- (\hd tl f : pair
- (f hd)
- (self tl f)))
-map = (\f l : hmap l f)
+ (\_ : t)
+ (\head tail f : pair (f head) (self tail f)))
+map = (\f l : map_ l f)
-equal = y (\self : triage
+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))))
+ (\_ : false)
+ (\_ _ : false))
+ (\ax :
+ triage
+ false
+ (self ax)
+ (\_ _ : false))
+ (\ax ay :
+ triage
+ false
+ (\_ : 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)
+filter_ = y (\self : matchList
+ (\_ : t)
+ (\head tail f : matchBool (t head) i (f head) (self tail f)))
+filter = (\f l : filter_ 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)
+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)
-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)
+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)
diff --git a/src/Lexer.hs b/src/Lexer.hs
@@ -18,7 +18,10 @@ keywordT = string "t" *> notFollowedBy alphaNumChar *> pure LKeywordT
identifier :: Lexer LToken
identifier = do
first <- letterChar <|> char '_'
- rest <- many (letterChar <|> char '_' <|> char '-' <|> digitChar)
+ rest <- many $ letterChar
+ <|> digitChar
+ <|> char '_' <|> char '-' <|> char '?' <|> char '!'
+ <|> char '$' <|> char '#' <|> char '@' <|> char '%'
let name = first : rest
if (name == "t" || name == "__result")
then fail "Keywords (`t`, `__result`) cannot be used as an identifier"
diff --git a/test/Spec.hs b/test/Spec.hs
@@ -308,7 +308,7 @@ libraryTests = testGroup "Library Tests"
result env @?= Fork (Stem (Stem Leaf)) (Stem Leaf)
, testCase "I combinator" $ do
library <- evaluateFile "./lib/base.tri"
- let input = "i not"
+ 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
@@ -328,32 +328,32 @@ libraryTests = testGroup "Library Tests"
env @?= "\"Fork\""
, testCase "Boolean NOT: true" $ do
library <- evaluateFile "./lib/base.tri"
- let input = "not true"
+ 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"
+ 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)"
+ 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)"
+ 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)"
+ 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)"
+ let input = "and? (t t) (t t)"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "List head" $ do
@@ -373,12 +373,12 @@ libraryTests = testGroup "Library Tests"
result env @?= Fork Leaf Leaf
, testCase "Empty list check" $ do
library <- evaluateFile "./lib/base.tri"
- let input = "emptyList []"
+ 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)])"
+ let input = "not? (emptyList? [(1) (2) (3)])"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
, testCase "Concatenate strings" $ do
@@ -388,7 +388,7 @@ libraryTests = testGroup "Library Tests"
env @?= "\"Hello, world!\""
, testCase "Verifying Equality" $ do
library <- evaluateFile "./lib/base.tri"
- let input = "equal (t t t) (t t t)"
+ let input = "equal? (t t t) (t t t)"
env = evalTricu library (parseTricu input)
result env @?= Stem Leaf
]
