James/tricu
2
2
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

Clearer definition for apply

Browse Source
This commit is contained in:
James Eversole 2025-02-06 08:32:17 -06:00
parent f4e50353ed
commit 30b9505d5f
3 changed files with 36 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
lib/patterns.tri
View File

@ -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!")]])

32
src/Research.hs
View File

@ -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"

8
test/Spec.hs
View File

@ -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"
]