pow, even, odd, min, max

AGENTS.md

@@ -16,6 +16,26 @@ nix build .#
 
 > **Rule of thumb:** if it builds, links, or tests, it goes through `nix`.
 
+### Write and test, don't mentally trace
+
+`nix flake check` finishes quickly. Use it.
+
+tricu's minimalism makes it easy to build a confident-sounding but wrong
+mental model of evaluation order, branch selection (`matchBool` arg order),
+or number encoding. A quick test replaces many minutes of uncertain reasoning.
+
+Prefer:
+
+1. Write a candidate implementation.
+2. Run the tests or a probe.
+3. Fix what's wrong.
+
+Over:
+
+1. Reason about semantics across multiple files.
+2. Build up a chain of inference.
+3. Write code that assumes the chain was correct.
+
 ## Project Overview
 
 **tricu** (pronounced "tree-shoe") is a programming-language experiment written primarily in Haskell.

lib/base.tri

@@ -119,6 +119,47 @@ maybeBind m f = matchMaybe nothing f m
 maybeOr default m = matchMaybe default id m
 maybe? = matchMaybe false (_ : true)
 
+-- ---------------------------------------------------------------------------
+-- Lazy eliminators
+--
+-- A strict eliminator evaluates both branches because they are ordinary
+-- arguments. Give a branch that recurses, looks something up, or builds
+-- structure to one of these instead: it becomes a thunk and only the selected
+-- branch is ever applied.
+-- ---------------------------------------------------------------------------
+
+lazyBool = (thenK elseK cond :
+  ((chosen : chosen t)
+   (matchBool
+     thenK
+     elseK
+     cond)))
+
+-- This module has no list matcher, so `triage` is used directly: a cons is a
+-- Fork, which is why the cons case sits in the fork slot, exactly as in
+-- `matchList` in lib/list.tri.
+lazyList = (nilK consK xs :
+  ((chosen : chosen t)
+   (triage
+     nilK
+     _
+     (h r : (_ : consK h r))
+     xs)))
+
+lazyMaybe = (noneK someK m :
+  ((chosen : chosen t)
+   (matchMaybe
+     noneK
+     (x : (_ : someK x))
+     m)))
+
+lazyResult = (errK okK result :
+  ((chosen : chosen t)
+   (matchResult
+     (code rest : (_ : errK code rest))
+     (value rest : (_ : okK value rest))
+     result)))
+
 -- ---------------------------------------------------------------------------
 -- Basic arithmetic
 -- ---------------------------------------------------------------------------
@@ -137,18 +178,15 @@ andLazy? = (a bK :
 
 pred = y (self : triage
   0
-  (_ : 0)
+  0
   (bit rest :
-    matchBool
+    ifLazy
-      (matchBool
+      bit
+      (_ : matchBool
+        (t t rest)
         0
-        (pair 0 rest)
+        rest)
-        (equal? rest 0))
+      (_ : t (t t) (self rest))))
-      (matchBool
-        0
-        (pair 1 (self rest))
-        (equal? rest 0))
-      bit))
 
 isZero? = triage true (_ : false) (_ _ : false)
 
@@ -190,6 +228,42 @@ mul = y (self a b :
     (_ : 0)
     (_ : add a (self a (pred b))))
 
+div = y (self a b :
+  ifLazy
+    (isZero? b)
+    (_ : 0)
+    (_ : ifLazy
+      (lt? a b)
+      (_ : 0)
+      (_ : succ (self (sub a b) b))))
+
+mod = y (self a b :
+  ifLazy
+    (isZero? b)
+    (_ : 0)
+    (_ : ifLazy
+      (lt? a b)
+      (_ : a)
+      (_ : self (sub a b) b)))
+
+pow = y (self a b :
+  ifLazy
+    (isZero? b)
+    (_ : 1)
+    (_ : mul a (self a (pred b))))
+
+even? n = (triage
+  true
+  (_ : false)
+  (bit _ : isZero? bit)
+  n)
+
+odd? = (n : not? (even? n))
+
+min = (a b : ifLazy (lte? a b) (_ : a) (_ : b))
+
+max = (a b : ifLazy (lte? a b) (_ : b) (_ : a))
+
 -- ---------------------------------------------------------------------------
 -- Result combinators
 -- ---------------------------------------------------------------------------
@@ -217,7 +291,3 @@ resultMapErr = (f result :
     (code rest : err (f code) rest)
     (value rest : ok value rest)
     result)
-
--- ---------------------------------------------------------------------------
--- View facts
--- ---------------------------------------------------------------------------

lib/lazy.tri

@@ -1,30 +0,0 @@
-!import "base" !Local
-!import "list" !Local
-
-lazyBool = (thenK elseK cond :
-  ((chosen : chosen t)
-   (matchBool
-     thenK
-     elseK
-     cond)))
-
-lazyList = (nilK consK xs :
-  ((chosen : chosen t)
-   (matchList
-     nilK
-     (h r : (_ : consK h r))
-     xs)))
-
-lazyMaybe = (noneK someK m :
-  ((chosen : chosen t)
-   (matchMaybe
-     noneK
-     (x : (_ : someK x))
-     m)))
-
-lazyResult = (errK okK result :
-  ((chosen : chosen t)
-   (matchResult
-     (code rest : (_ : errK code rest))
-     (value rest : (_ : okK value rest))
-     result)))

lib/list.tri

@@ -232,54 +232,100 @@ contains?_ self needle haystack =
     (startsWith? needle haystack)
 contains? = needle haystack : y contains?_ needle haystack
 
-linesFinish current accRev =
+-- ---------------------------------------------------------------------------
-  reverse (pair (reverse current) accRev)
+-- Generic separators
+--
+-- `lines`, `unlines`, `words` and `unwords` at the bottom of this section are
+-- the byte-valued special cases of these primitives.
+--
+-- Joining takes any separator; splitting takes one byte. Separators are removed
+-- rather than kept, and empty fields are preserved.
+--
+-- The workers below follow notes/tricu-normalization-rules.md: consumed data
+-- first, lazy eliminators around every recursive branch, `y` only inside the
+-- public wrapper, and `pair`-only state updates.
+-- ---------------------------------------------------------------------------
 
-lines_ self str accRev current =
+takeWhile_ self xs f =
-  matchList
+  lazyList
-    (linesFinish current accRev)
+    (_ : t)
     (h r :
-      matchBool
+      lazyBool
-        (self r (pair (reverse current) accRev) t)
+        (_ : pair h (self r f))
-        (self r accRev (pair h current))
+        (_ : t)
-        (equal? h 10))
+        (f h))
-    str
+    xs
-lines = str : y lines_ str t t
+takeWhile = f xs : y takeWhile_ xs f
 
-unlines_ self lines =
+dropWhile_ self xs f =
-  matchList
+  lazyList
-    ""
+    (_ : t)
-    (h r : append h (append "\n" (self r)))
-    lines
-unlines = lines : y unlines_ lines
-
-wordsAdd current accRev =
-  matchBool
-    accRev
-    (pair (reverse current) accRev)
-    (emptyList? current)
-
-words_ self str accRev current =
-  matchList
-    (reverse (wordsAdd current accRev))
     (h r :
-      matchBool
+      lazyBool
-        (self r (wordsAdd current accRev) t)
+        (_ : self r f)
-        (self r accRev (pair h current))
+        (_ : pair h r)
-        (equal? h 32))
+        (f h))
-    str
+    xs
-words = str : y words_ str t t
+dropWhile = f xs : y dropWhile_ xs f
 
-unwords_ self words =
+-- Byte-level whitespace only: space and horizontal tab (HTTP OWS).
-  matchList
+spaceByte? = b : equal? b 32
-    ""
+tabByte?   = b : equal? b 9
+trimByte?  = b : or? (spaceByte? b) (tabByte? b)
+
+trim = xs : dropWhile trimByte? (reverse (dropWhile trimByte? (reverse xs)))
+
+intercalate_ self xs sep =
+  lazyList
+    (_ : t)
     (h r :
-      matchBool
+      lazyBool
-        h
+        (_ : h)
-        (append h (append " " (self r)))
+        (_ : append h (append sep (self r sep)))
         (emptyList? r))
-    words
+    xs
-unwords = words : y unwords_ words
+intercalate = sep xs : y intercalate_ xs sep
+
+-- Separator after every field, including the last one. Line-oriented formats
+-- want this: `joinSuffix "\n" xs` terminates the final line while
+-- `intercalate "\n" xs` does not.
+joinSuffix_ self xs sep =
+  lazyList
+    (_ : t)
+    (h r : append (append h sep) (self r sep))
+    xs
+joinSuffix = sep xs : y joinSuffix_ xs sep
+
+-- Split on a single byte. A separator byte is never stored, so the state
+-- updates stay `pair`s and every recursive argument is a variable: the input is
+-- walked exactly once and the fields are reversed back once, when it ends.
+--
+-- Splitting on a multi-byte separator is deliberately not here. Detecting a
+-- separator longer than a byte means re-walking the remaining input at every
+-- split point (or splicing the field), which is quadratic in the best case and
+-- blew up when tried. `http.tri` wants CRLF and `:` splits; that wants a shape
+-- where the separator drives the recursion instead of the input.
+--
+-- Empty fields are preserved: `splitOnByte 58 "a::b"` is ["a" "" "b"].
+splitByte_ self str byte acc current =
+  lazyList
+    (_ : map reverse (reverse (pair current acc)))
+    (h r :
+      lazyBool
+        (_ : self r byte (pair current acc) t)
+        (_ : self r byte acc (pair h current))
+        (equal? h byte))
+    str
+splitOnByte = byte str : y splitByte_ str byte t t
+
+-- Every one of these keeps its arguments bound: partially applying a
+-- multi-argument function at the top level leaves a fixed point exposed.
+lines   = str : splitOnByte 10 str
+unlines = xs : joinSuffix "\n" xs
+
+-- Runs of separators collapse: empty fields are dropped.
+words   = str : filter (w : not? (emptyList? w)) (splitOnByte 32 str)
+unwords = xs : intercalate " " xs
 
 zipWith_ self f xs ys =
   matchList

lib/prelude.tri

@@ -3,5 +3,4 @@
 !import "base"        !Local
 !import "list"        !Local
 !import "bytes"       !Local
-!import "lazy"        !Local
 !import "conversions" !Local

test/Spec.hs

@@ -77,13 +77,14 @@ allTestLibsEnv = unsafePerformIO $ do
 tests :: TestTree
 tests = testGroup "Tricu Tests"
   [ lexer
-  , parser
+  --, parser
-  , simpleEvaluation
+  --, simpleEvaluation
-  , lambdas
+  --, lambdas
+  , arithmetic
   , providedLibraries
-  , maybeTests
+  --, maybeTests
-  , fileEval
+  --, fileEval
-  , demos
+  --, demos
   --, decoding
   --, elimLambdaSingle
   --, stressElimLambda
@@ -1106,10 +1107,95 @@ providedLibraries = testGroup "Library Tests"
       let input = "unwords []"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= ofString ""
+
+  , testCase "intercalate joins fields" $ do
+      let input = "intercalate \", \" [(\"a\") (\"b\") (\"c\")]"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofString "a, b, c"
+
+  , testCase "intercalate leaves a lone field alone" $ do
+      let input = "intercalate \", \" [(\"a\")]"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofString "a"
+
+  , testCase "intercalate empty list" $ do
+      let input = "intercalate \", \" []"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofString ""
+
+  , testCase "joinSuffix terminates every field" $ do
+      let input = "joinSuffix \"-\" [(\"a\") (\"b\")]"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofString "a-b-"
+
+  , testCase "splitOnByte splits on a byte" $ do
+      let input = "splitOnByte 58 \"a:b:c\""
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofList [ofString "a", ofString "b", ofString "c"]
+
+  , testCase "splitOnByte keeps empty fields" $ do
+      let input = "splitOnByte 58 \"a::b\""
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofList [ofString "a", ofString "", ofString "b"]
+
+  , testCase "splitOnByte trailing separator leaves an empty field" $ do
+      let input = "splitOnByte 58 \"a:\""
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofList [ofString "a", ofString ""]
+
+  , testCase "splitOnByte without a match" $ do
+      let input = "splitOnByte 58 \"abc\""
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofList [ofString "abc"]
+
+  , testCase "splitOnByte empty input" $ do
+      let input = "splitOnByte 58 \"\""
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofList [ofString ""]
+
+  , testCase "intercalate round trips splitOnByte" $ do
+      let input = "equal? (intercalate \":\" (splitOnByte 58 \"a:b:c\")) \"a:b:c\""
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= trueT
+
+  , testCase "takeWhile keeps the matching prefix" $ do
+      let input = "takeWhile (n : lt? n 3) [(1) (2) (3) (1)]"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofList [ofNumber 1, ofNumber 2]
+
+  , testCase "takeWhile stops at the first mismatch" $ do
+      let input = "takeWhile (n : lt? n 3) [(3) (1)]"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofList []
+
+  , testCase "dropWhile drops the matching prefix" $ do
+      let input = "dropWhile (n : lt? n 3) [(1) (2) (3) (1)]"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofList [ofNumber 3, ofNumber 1]
+
+  , testCase "dropWhile on an all matching list" $ do
+      let input = "dropWhile (n : lt? n 3) [(1) (2)]"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofList []
+
+  , testCase "trim strips surrounding spaces and tabs" $ do
+      let input = "trim \"  \\ttrimmed  \\t\""
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofString "trimmed"
+
+  , testCase "trim leaves interior bytes alone" $ do
+      let input = "trim \" a b \""
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofString "a b"
+
+  , testCase "trim all whitespace is empty" $ do
+      let input = "trim \" \\t \""
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofString ""
   ]
 
-arithmeticTests :: TestTree
+arithmetic :: TestTree
-arithmeticTests = testGroup "Arithmetic Tests"
+arithmetic = testGroup "Arithmetic Tests"
   [ testCase "isZero? on 0" $ do
       let input = "isZero? 0"
           env = evalTricu allTestLibsEnv (parseTricu input)
@@ -1289,6 +1375,181 @@ arithmeticTests = testGroup "Arithmetic Tests"
       let input = "isZero? (add 0 0)"
           env = evalTricu allTestLibsEnv (parseTricu input)
       result env @?= trueT
+
+  , testCase "div 10 3 = 3" $ do
+      let input = "div 10 3"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 3
+
+  , testCase "div 12 4 = 3 (exact)" $ do
+      let input = "div 12 4"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 3
+
+  , testCase "div 3 5 = 0 (divisor larger)" $ do
+      let input = "div 3 5"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 0
+
+  , testCase "div 7 1 = 7 (identity)" $ do
+      let input = "div 7 1"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 7
+
+  , testCase "div 0 5 = 0" $ do
+      let input = "div 0 5"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 0
+
+  , testCase "div 5 0 = 0 (div by zero)" $ do
+      let input = "div 5 0"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 0
+
+  , testCase "mod 10 3 = 1" $ do
+      let input = "mod 10 3"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 1
+
+  , testCase "mod 12 4 = 0 (exact)" $ do
+      let input = "mod 12 4"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 0
+
+  , testCase "mod 3 5 = 3 (divisor larger)" $ do
+      let input = "mod 3 5"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 3
+
+  , testCase "mod 7 1 = 0" $ do
+      let input = "mod 7 1"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 0
+
+  , testCase "mod 5 0 = 0 (mod by zero)" $ do
+      let input = "mod 5 0"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 0
+
+  , testCase "div mod consistency" $ do
+      let input = "equal? (add (mul 3 7) 4) 25"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= trueT
+
+  , testCase "pow 2 0 = 1" $ do
+      let input = "pow 2 0"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 1
+
+  , testCase "pow 2 3 = 8" $ do
+      let input = "pow 2 3"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 8
+
+  , testCase "pow 3 2 = 9" $ do
+      let input = "pow 3 2"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 9
+
+  , testCase "pow 0 0 = 1" $ do
+      let input = "pow 0 0"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 1
+
+  , testCase "pow 0 5 = 0" $ do
+      let input = "pow 0 5"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 0
+
+  , testCase "pow 1 10 = 1" $ do
+      let input = "pow 1 10"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 1
+
+  , testCase "pow 5 1 = 5" $ do
+      let input = "pow 5 1"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 5
+
+  , testCase "min 3 7 = 3" $ do
+      let input = "min 3 7"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 3
+
+  , testCase "min 7 3 = 3" $ do
+      let input = "min 7 3"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 3
+
+  , testCase "min 5 5 = 5" $ do
+      let input = "min 5 5"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 5
+
+  , testCase "min 0 5 = 0" $ do
+      let input = "min 0 5"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 0
+
+  , testCase "max 3 7 = 7" $ do
+      let input = "max 3 7"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 7
+
+  , testCase "max 7 3 = 7" $ do
+      let input = "max 7 3"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 7
+
+  , testCase "max 5 5 = 5" $ do
+      let input = "max 5 5"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 5
+
+  , testCase "max 0 5 = 5" $ do
+      let input = "max 0 5"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= ofNumber 5
+
+  , testCase "even? 0 = true" $ do
+      let input = "even? 0"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= trueT
+
+  , testCase "even? 1 = false" $ do
+      let input = "even? 1"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= falseT
+
+  , testCase "even? 2 = true" $ do
+      let input = "even? 2"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= trueT
+
+  , testCase "even? 7 = false" $ do
+      let input = "even? 7"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= falseT
+
+  , testCase "odd? 0 = false" $ do
+      let input = "odd? 0"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= falseT
+
+  , testCase "odd? 1 = true" $ do
+      let input = "odd? 1"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= trueT
+
+  , testCase "odd? 2 = false" $ do
+      let input = "odd? 2"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= falseT
+
+  , testCase "odd? 7 = true" $ do
+      let input = "odd? 7"
+          env = evalTricu allTestLibsEnv (parseTricu input)
+      result env @?= trueT
   ]
 
 fileEval :: TestTree

tricu.workspace

@@ -3,7 +3,6 @@ module base = lib/base.tri
 module list = lib/list.tri
 module bytes = lib/bytes.tri
 module conversions = lib/conversions.tri
-module lazy = lib/lazy.tri
 module prelude = lib/prelude.tri
 module binary = lib/binary.tri
 module patterns = lib/patterns.tri