diff --git a/README.md b/README.md index 95d0bd9..bba5b9e 100644 --- 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/equality.tri b/demos/equality.tri new file mode 100644 index 0000000..212f041 --- /dev/null +++ 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 similarity index 58% rename from demos/LevelOrderTraversal.tri rename to demos/levelOrderTraversal.tri index 06b21ae..63a11e8 100644 --- a/demos/LevelOrderTraversal.tri +++ b/demos/levelOrderTraversal.tri @@ -17,20 +17,15 @@ -- 4 5 6 -- -isLeaf = (\node : - lOr - (emptyList node) - (emptyList (tail node))) +label = (\node : head node) -getLabel = (\node : head node) - -getLeft = (\node : if (emptyList node) +left = (\node : if (emptyList node) [] (if (emptyList (tail node)) [] (head (tail node)))) -getRight = (\node : if (emptyList node) +right = (\node : if (emptyList node) [] (if (emptyList (tail node)) [] @@ -40,11 +35,11 @@ getRight = (\node : if (emptyList node) processLevel = y (\self queue : if (emptyList queue) [] - (pair (map getLabel queue) (self (filter + (pair (map label queue) (self (filter (\node : not (emptyList node)) - (lconcat (map getLeft queue) (map getRight queue)))))) + (lconcat (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) "" @@ -52,17 +47,19 @@ toLineString = y (\self levels : if (emptyList levels) (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)) +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]]] +levelOrderTraversal = (\s : lconcat (t 10 t) (flatten (levelOrderToString s))) -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]]] +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 new file mode 100644 index 0000000..fec1d86 --- /dev/null +++ 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 index 1c199fc..2930bb9 100644 --- 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 index 6ed1a5d..284c100 100644 --- 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 index 2358b86..cfc76bf 100644 --- 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 ]