tricu

commit 5acc628aa8b404de84f31490ca40ac54ccd86ca2
parent 1e7b2cd2236d3e6d3935399a467d377e014b5034
Author: James Eversole <james@eversole.co>
Date:   Thu,  6 Feb 2025 08:32:17 -0600

Clearer definition for apply

Diffstat:
M
lib/patterns.tri
 | 
23
++++++++++++-----------
M
src/Research.hs
 | 
32
++++++++++++++++++++------------
M
test/Spec.hs
 | 
8
++++----

3 files changed, 36 insertions(+), 27 deletions(-)
diff --git a/lib/patterns.tri b/lib/patterns.tri
@@ -22,14 +22,15 @@ match = (\value 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!")]])
+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!")]])
diff --git a/src/Research.hs b/src/Research.hs
@@ -55,15 +55,24 @@ data EvaluatedForm = TreeCalculus | FSL | AST | Ternary | Ascii | Decode
 -- Environment containing previously evaluated TC terms
 type Env = Map.Map String T
 
--- Tree Calculus Reduction
+-- Tree Calculus Reduction Rules
+{- 
+  The t operator is left associative.
+  1.  t  t      a b       -> a
+  2.  t (t a)   b c       -> a c (b c)
+  3a. t (t a b) c t       -> a
+  3b. t (t a b) c (t u)   -> b u
+  3c. t (t a b) c (t u v) -> c u v
+-}
 apply :: T -> T -> T
-apply Leaf b                            = Stem b
-apply (Stem a) b                        = Fork a b
-apply (Fork Leaf a) _                   = a
-apply (Fork (Stem a1) a2) b             = apply (apply a1 b) (apply a2 b)
-apply (Fork (Fork a1 a2) a3) Leaf       = a1
-apply (Fork (Fork a1 a2) a3) (Stem u)   = apply a2 u
-apply (Fork (Fork a1 a2) a3) (Fork u v) = apply (apply a3 u) v
+apply (Fork Leaf a)         _         = a
+apply (Fork (Stem a) b) c             = apply (apply a c) (apply b c)
+apply (Fork (Fork a  b) c)  Leaf      = a
+apply (Fork (Fork a  b) c) (Stem u)   = apply b u
+apply (Fork (Fork a  b) c) (Fork u v) = apply (apply c u) v
+-- Left associative `t`
+apply  Leaf b                         = Stem b
+apply (Stem a) b                      = Fork a b
 
 -- Booleans
 _false :: T
@@ -77,7 +86,7 @@ _not = Fork (Fork _true (Fork Leaf _false)) Leaf
 
 -- Marshalling
 ofString :: String -> T
-ofString str = ofList (map ofNumber (map fromEnum str))
+ofString str = ofList $ map (ofNumber . fromEnum) str
 
 ofNumber :: Int -> T
 ofNumber 0 = Leaf
@@ -87,8 +96,7 @@ ofNumber n =
     (ofNumber (n `div` 2))
 
 ofList :: [T] -> T
-ofList [] = Leaf
-ofList (x:xs) = Fork x (ofList xs)
+ofList = foldr Fork Leaf
 
 toNumber :: T -> Either String Int
 toNumber Leaf = Right 0
@@ -126,7 +134,7 @@ toSimpleT s = T.unpack
   $ replace "Fork" "t"
   $ replace "Stem" "t"
   $ replace "Leaf" "t"
-  $ (T.pack s)
+  $ T.pack s
 
 toTernaryString :: T -> String
 toTernaryString Leaf = "0"
diff --git a/test/Spec.hs b/test/Spec.hs
@@ -329,20 +329,20 @@ lambdas = testGroup "Lambda Evaluation Tests"
         let input = "f = (\\x : (\\y : x y))\ng = (\\z : z)\nf g t"
         runTricu input @?= "Leaf"
 
-  , testCase "Lambda with a string literal" $ do
+  , testCase "Lambda applied to string literal" $ do
         let input = "f = (\\x : x)\nf \"hello\""
         runTricu input @?= "Fork (Fork Leaf (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork Leaf (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) (Fork (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork (Stem Leaf) Leaf))))))) Leaf))))"
 
 
-   , testCase "Lambda with an integer literal" $ do
+   , testCase "Lambda applied to integer literal" $ do
         let input = "f = (\\x : x)\nf 42"
         runTricu input @?= "Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) (Fork Leaf (Fork (Stem Leaf) Leaf)))))"
 
-   , testCase "Lambda with a list literal" $ do
+   , testCase "Lambda applied to list literal" $ do
         let input = "f = (\\x : x)\nf [t (t t)]"
         runTricu input @?= "Fork Leaf (Fork (Stem Leaf) Leaf)"
 
-  , testCase "Lambda with list literal" $ do
+  , testCase "Lambda containing list literal" $ do
       let input = "(\\a : [(a)]) 1"
       runTricu input @?= "Fork (Fork (Stem Leaf) Leaf) Leaf"
   ]