mk: phase 4A — appendo canary green, both directions

Three coupled fixes plus a new relations module land together because
each is required for the next: appendo can't terminate without all
three.

1. unify.sx — added (:cons h t) tagged cons-cell shape because SX has no
   improper pairs. The unifier treats (:cons h t) and the native list
   (h . t) as equivalent. mk-walk* re-flattens cons cells back to flat
   lists for clean reification.

2. stream.sx — switched mature stream cells from plain SX lists to a
   (:s head tail) tagged shape so a mature head can have a thunk tail.
   With the old representation, mk-mplus had to (cons head thunk) which
   SX rejects (cons requires a list cdr).

3. conde.sx — wraps each clause in Zzz (inverse-eta delay) for laziness.
   Zzz uses (gensym "zzz-s-") for the substitution parameter so it does
   not capture user goals that follow the (l s ls) convention. Without
   gensym, every relation that uses `s` as a list parameter silently
   binds it to the substitution dict.

relations.sx is the new module: nullo, pairo, caro, cdro, conso,
firsto, resto, listo, appendo, membero. 25 new tests.

Canary green:
  (run* q (appendo (list 1 2) (list 3 4) q))
    → ((1 2 3 4))
  (run* q (fresh (l s) (appendo l s (list 1 2 3)) (== q (list l s))))
    → ((() (1 2 3)) ((1) (2 3)) ((1 2) (3)) ((1 2 3) ()))
  (run 3 q (listo q))
    → (() (_.0) (_.0 _.1))

152/152 cumulative.

lib/minikanren/tests/conde.sx

@@ -1,93 +1,89 @@
 ;; lib/minikanren/tests/conde.sx — Phase 2 piece C tests for `conde`.
 ;;
-;; Note on ordering: mk-mplus only interleaves when the left stream is a
-;; paused thunk. Eager streams from == compose via mature DFS order
-;; (left-clause results first, then right-clause). True interleaving is
-;; tested in Phase 4 via recursive relations.
+;; Note on ordering: conde clauses are wrapped in Zzz (inverse-eta delay),
+;; so applying the conde goal to a substitution returns thunks. mk-mplus
+;; suspends-and-swaps when its left operand is paused, giving fair
+;; interleaving — this is exactly what makes recursive relations work,
+;; but it does mean conde answers can interleave rather than appear in
+;; strict left-to-right clause order.
 
 ;; --- single-clause conde ≡ conj of clause body ---
 
 (mk-test
   "conde-one-clause"
-  (let
-    ((q (mk-var "q")))
-    (let
-      ((res (stream-take 5 ((conde ((== q 7))) empty-s))))
-      (map (fn (s) (mk-walk q s)) res)))
+  (let ((q (mk-var "q"))) (run* q (conde ((== q 7)))))
   (list 7))
 
 (mk-test
   "conde-one-clause-multi-goals"
   (let
     ((q (mk-var "q")))
-    (let
-      ((res (stream-take 5 ((conde ((fresh (x) (== x 5) (== q (list x x))))) empty-s))))
-      (map (fn (s) (mk-walk* q s)) res)))
+    (run* q (conde ((fresh (x) (== x 5) (== q (list x x)))))))
   (list (list 5 5)))
 
-;; --- multi-clause: produces one row per clause (eager DFS order) ---
+;; --- multi-clause: produces one row per clause (interleaved) ---
 
 (mk-test
-  "conde-three-clauses"
+  "conde-three-clauses-as-set"
   (let
-    ((q (mk-var "q")))
-    (let
-      ((res (stream-take 10 ((conde ((== q 1)) ((== q 2)) ((== q 3))) empty-s))))
-      (map (fn (s) (mk-walk q s)) res)))
-  (list 1 2 3))
+    ((qs (run* q (conde ((== q 1)) ((== q 2)) ((== q 3))))))
+    (and
+      (= (len qs) 3)
+      (and
+        (some (fn (x) (= x 1)) qs)
+        (and
+          (some (fn (x) (= x 2)) qs)
+          (some (fn (x) (= x 3)) qs)))))
+  true)
 
 (mk-test
-  "conde-mixed-success-failure"
+  "conde-mixed-success-failure-as-set"
   (let
-    ((q (mk-var "q")))
-    (let
-      ((res (stream-take 10 ((conde ((== q "a")) ((== 1 2)) ((== q "b"))) empty-s))))
-      (map (fn (s) (mk-walk q s)) res)))
-  (list "a" "b"))
+    ((qs (run* q (conde ((== q "a")) ((== 1 2)) ((== q "b"))))))
+    (and
+      (= (len qs) 2)
+      (and (some (fn (x) (= x "a")) qs) (some (fn (x) (= x "b")) qs))))
+  true)
 
 ;; --- conde with conjuncts inside clauses ---
 
 (mk-test
-  "conde-clause-conj"
+  "conde-clause-conj-as-set"
   (let
-    ((q (mk-var "q")) (r (mk-var "r")))
-    (let
-      ((res (stream-take 10 ((conde ((== q 1) (== r 10)) ((== q 2) (== r 20))) empty-s))))
-      (map (fn (s) (list (mk-walk q s) (mk-walk r s))) res)))
-  (list (list 1 10) (list 2 20)))
-
-;; --- conde + fresh: multiple solutions per clause ---
-
-(mk-test
-  "conde-with-fresh-and-disj"
-  (let
-    ((q (mk-var "q")))
-    (let
-      ((res (stream-take 10 ((conde ((fresh (x) (mk-disj (== x 1) (== x 2)) (== q x))) ((== q 100))) empty-s))))
-      (map (fn (s) (mk-walk q s)) res)))
-  (list 1 2 100))
+    ((rows (run* q (fresh (x y) (conde ((== x 1) (== y 10)) ((== x 2) (== y 20))) (== q (list x y))))))
+    (and
+      (= (len rows) 2)
+      (and
+        (some (fn (r) (= r (list 1 10))) rows)
+        (some (fn (r) (= r (list 2 20))) rows))))
+  true)
 
 ;; --- nested conde ---
 
 (mk-test
-  "conde-nested"
+  "conde-nested-yields-three"
   (let
-    ((q (mk-var "q")))
-    (let
-      ((res (stream-take 10 ((conde ((conde ((== q 1)) ((== q 2)))) ((== q 3))) empty-s))))
-      (map (fn (s) (mk-walk q s)) res)))
-  (list 1 2 3))
+    ((qs (run* q (conde ((conde ((== q 1)) ((== q 2)))) ((== q 3))))))
+    (and
+      (= (len qs) 3)
+      (and
+        (some (fn (x) (= x 1)) qs)
+        (and
+          (some (fn (x) (= x 2)) qs)
+          (some (fn (x) (= x 3)) qs)))))
+  true)
 
 ;; --- conde all clauses fail → empty stream ---
 
 (mk-test
   "conde-all-fail"
-  ((conde ((== 1 2)) ((== 3 4)))
-    empty-s)
+  (run*
+    q
+    (conde ((== 1 2)) ((== 3 4))))
   (list))
 
 ;; --- empty conde: no clauses ⇒ fail ---
 
-(mk-test "conde-no-clauses" ((conde) empty-s) (list))
+(mk-test "conde-no-clauses" (run* q (conde)) (list))
 
 (mk-tests-run!)

lib/minikanren/tests/fresh.sx

@@ -4,12 +4,12 @@
 
 (mk-test
   "fresh-empty-vars-equiv-conj"
-  ((fresh () (== 1 1)) empty-s)
+  (stream-take 5 ((fresh () (== 1 1)) empty-s))
   (list empty-s))
 
 (mk-test
   "fresh-empty-vars-no-goals-is-succeed"
-  ((fresh ()) empty-s)
+  (stream-take 5 ((fresh ()) empty-s))
   (list empty-s))
 
 ;; --- single var ---
@@ -17,8 +17,8 @@
 (mk-test
   "fresh-one-var-bound"
   (let
-    ((s (first ((fresh (x) (== x 7)) empty-s))))
-    (let ((vs (vals s))) (first vs)))
+    ((s (first (stream-take 5 ((fresh (x) (== x 7)) empty-s)))))
+    (first (vals s)))
   7)
 
 ;; --- multiple vars + multiple goals ---
@@ -33,7 +33,7 @@
           (== x 10)
           (== y 20)
           (== q (list x y)))))
-    (mk-walk* q (first (g empty-s))))
+    (mk-walk* q (first (stream-take 5 (g empty-s)))))
   (list 10 20))
 
 (mk-test
@@ -47,7 +47,7 @@
           (== b 2)
           (== c 3)
           (== q (list a b c)))))
-    (mk-walk* q (first (g empty-s))))
+    (mk-walk* q (first (stream-take 5 (g empty-s)))))
   (list 1 2 3))
 
 ;; --- fresh interacts with disj ---
@@ -77,7 +77,7 @@
             (== x 1)
             (== y 2)
             (== q (list x y))))))
-    (mk-walk* q (first (g empty-s))))
+    (mk-walk* q (first (stream-take 5 (g empty-s)))))
   (list 1 2))
 
 ;; --- call-fresh (functional alternative) ---
@@ -85,7 +85,7 @@
 (mk-test
   "call-fresh-binds-and-walks"
   (let
-    ((s (first ((call-fresh (fn (x) (== x 99))) empty-s))))
+    ((s (first (stream-take 5 ((call-fresh (fn (x) (== x 99))) empty-s)))))
     (first (vals s)))
   99)
 
@@ -95,7 +95,7 @@
     ((q (mk-var "q")))
     (let
       ((g (call-fresh (fn (x) (mk-conj (== x 5) (== q (list x x)))))))
-      (mk-walk* q (first (g empty-s)))))
+      (mk-walk* q (first (stream-take 5 (g empty-s))))))
   (list 5 5))
 
 (mk-tests-run!)

lib/minikanren/tests/goals.sx

@@ -1,124 +1,153 @@
 ;; lib/minikanren/tests/goals.sx — Phase 2 tests for stream.sx + goals.sx.
 ;;
-;; Loaded after: lib/guest/match.sx, lib/minikanren/unify.sx,
-;;               lib/minikanren/stream.sx, lib/minikanren/goals.sx.
-;; Reuses the mk-test* counters from tests/unify.sx — load that first to
-;; accumulate, or call mk-tests-run! after this file alone for fresh totals.
+;; Streams use a tagged shape internally (`(:s head tail)`) so that mature
+;; cells can have thunk tails — SX has no improper pairs. Test assertions
+;; therefore stream-take into a plain SX list, or check goal effects via
+;; mk-walk on the resulting subst, instead of inspecting raw streams.
 
-;; --- stream-take base cases ---
+;; --- stream-take base cases (input streams use s-cons / mzero) ---
 
 (mk-test
   "stream-take-zero-from-mature"
-  (stream-take 0 (list 1 2 3))
+  (stream-take 0 (s-cons (empty-subst) mzero))
   (list))
 
-(mk-test "stream-take-from-empty" (stream-take 5 mzero) (list))
+(mk-test "stream-take-from-mzero" (stream-take 5 mzero) (list))
 
 (mk-test
-  "stream-take-mature-list"
-  (stream-take 5 (list 1 2 3))
-  (list 1 2 3))
+  "stream-take-mature-pair"
+  (stream-take 5 (s-cons :a (s-cons :b mzero)))
+  (list :a :b))
 
 (mk-test
   "stream-take-fewer-than-available"
-  (stream-take 2 (list 10 20 30))
-  (list 10 20))
+  (stream-take 1 (s-cons :a (s-cons :b mzero)))
+  (list :a))
 
 (mk-test
   "stream-take-all-with-neg-1"
-  (stream-take -1 (list 1 2 3 4))
-  (list 1 2 3 4))
+  (stream-take -1 (s-cons :a (s-cons :b (s-cons :c mzero))))
+  (list :a :b :c))
 
 ;; --- stream-take forces immature thunks ---
 
 (mk-test
   "stream-take-forces-thunk"
-  (stream-take 3 (fn () (list "a" "b" "c")))
-  (list "a" "b" "c"))
+  (stream-take 5 (fn () (s-cons :x mzero)))
+  (list :x))
 
 (mk-test
   "stream-take-forces-nested-thunks"
-  (stream-take
-    3
-    (fn () (fn () (list 1 2 3))))
-  (list 1 2 3))
+  (stream-take 5 (fn () (fn () (s-cons :y mzero))))
+  (list :y))
 
 ;; --- mk-mplus interleaves ---
 
 (mk-test
   "mplus-empty-left"
-  (mk-mplus mzero (list 1 2))
-  (list 1 2))
+  (stream-take 5 (mk-mplus mzero (s-cons :r mzero)))
+  (list :r))
+
 (mk-test
   "mplus-empty-right"
-  (mk-mplus (list 1 2) mzero)
-  (list 1 2))
+  (stream-take 5 (mk-mplus (s-cons :l mzero) mzero))
+  (list :l))
 
 (mk-test
   "mplus-mature-mature"
-  (mk-mplus (list 1 2) (list 3 4))
-  (list 1 2 3 4))
+  (stream-take
+    5
+    (mk-mplus (s-cons :a (s-cons :b mzero)) (s-cons :c (s-cons :d mzero))))
+  (list :a :b :c :d))
 
 (mk-test
   "mplus-with-paused-left-swaps"
-  (stream-take 4 (mk-mplus (fn () (list "a" "b")) (list "c" "d")))
-  (list "c" "d" "a" "b"))
+  (stream-take
+    5
+    (mk-mplus
+      (fn () (s-cons :a (s-cons :b mzero)))
+      (s-cons :c (s-cons :d mzero))))
+  (list :c :d :a :b))
 
 ;; --- mk-bind ---
 
-(mk-test "bind-empty-stream" (mk-bind mzero (fn (s) (unit s))) (list))
+(mk-test
+  "bind-empty-stream"
+  (stream-take 5 (mk-bind mzero (fn (s) (unit s))))
+  (list))
 
 (mk-test
   "bind-singleton-identity"
-  (mk-bind (list 5) (fn (x) (list x)))
+  (stream-take
+    5
+    (mk-bind (s-cons 5 mzero) (fn (x) (unit x))))
   (list 5))
 
 (mk-test
   "bind-flat-multi"
-  (mk-bind
-    (list 1 2)
-    (fn (x) (list x (* x 10))))
+  (stream-take
+    10
+    (mk-bind
+      (s-cons 1 (s-cons 2 mzero))
+      (fn (x) (s-cons x (s-cons (* x 10) mzero)))))
   (list 1 10 2 20))
 
 (mk-test
   "bind-fail-prunes-some"
-  (mk-bind
-    (list 1 2 3)
-    (fn (x) (if (= x 2) (list) (list x))))
+  (stream-take
+    10
+    (mk-bind
+      (s-cons 1 (s-cons 2 (s-cons 3 mzero)))
+      (fn (x) (if (= x 2) mzero (unit x)))))
   (list 1 3))
 
 ;; --- core goals: succeed / fail ---
 
-(mk-test "succeed-yields-singleton" (succeed empty-s) (list empty-s))
+(mk-test
+  "succeed-yields-singleton"
+  (stream-take 5 (succeed empty-s))
+  (list empty-s))
 
-(mk-test "fail-yields-mzero" (fail empty-s) (list))
+(mk-test "fail-yields-mzero" (stream-take 5 (fail empty-s)) (list))
 
 ;; --- == ---
 
 (mk-test
   "eq-ground-success"
-  (mk-unified? (first ((== 1 1) empty-s)))
-  true)
+  (stream-take 5 ((== 1 1) empty-s))
+  (list empty-s))
 
-(mk-test "eq-ground-failure" ((== 1 2) empty-s) (list))
+(mk-test
+  "eq-ground-failure"
+  (stream-take 5 ((== 1 2) empty-s))
+  (list))
 
 (mk-test
   "eq-binds-var"
   (let
     ((x (mk-var "x")))
-    (mk-walk x (first ((== x 7) empty-s))))
+    (mk-walk
+      x
+      (first (stream-take 5 ((== x 7) empty-s)))))
   7)
 
 (mk-test
   "eq-list-success"
   (let
     ((x (mk-var "x")))
-    (mk-walk x (first ((== x (list 1 2)) empty-s))))
+    (mk-walk
+      x
+      (first
+        (stream-take
+          5
+          ((== x (list 1 2)) empty-s)))))
   (list 1 2))
 
 (mk-test
   "eq-list-mismatch-fails"
-  ((== (list 1 2) (list 1 3)) empty-s)
+  (stream-take
+    5
+    ((== (list 1 2) (list 1 3)) empty-s))
   (list))
 
 ;; --- conj2 / mk-conj ---
@@ -128,7 +157,7 @@
   (let
     ((x (mk-var "x")) (y (mk-var "y")))
     (let
-      ((s (first ((conj2 (== x 1) (== y 2)) empty-s))))
+      ((s (first (stream-take 5 ((conj2 (== x 1) (== y 2)) empty-s)))))
       (list (mk-walk x s) (mk-walk y s))))
   (list 1 2))
 
@@ -136,16 +165,24 @@
   "conj2-conflict-empty"
   (let
     ((x (mk-var "x")))
-    ((conj2 (== x 1) (== x 2)) empty-s))
+    (stream-take
+      5
+      ((conj2 (== x 1) (== x 2)) empty-s)))
   (list))
 
-(mk-test "conj-empty-is-succeed" ((mk-conj) empty-s) (list empty-s))
+(mk-test
+  "conj-empty-is-succeed"
+  (stream-take 5 ((mk-conj) empty-s))
+  (list empty-s))
 
 (mk-test
   "conj-single-is-goal"
   (let
     ((x (mk-var "x")))
-    (mk-walk x (first ((mk-conj (== x 99)) empty-s))))
+    (mk-walk
+      x
+      (first
+        (stream-take 5 ((mk-conj (== x 99)) empty-s)))))
   99)
 
 (mk-test
@@ -153,7 +190,7 @@
   (let
     ((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z")))
     (let
-      ((s (first ((mk-conj (== x 1) (== y 2) (== z 3)) empty-s))))
+      ((s (first (stream-take 5 ((mk-conj (== x 1) (== y 2) (== z 3)) empty-s)))))
       (list (mk-walk x s) (mk-walk y s) (mk-walk z s))))
   (list 1 2 3))
 
@@ -177,7 +214,10 @@
       (map (fn (s) (mk-walk q s)) res)))
   (list 5))
 
-(mk-test "disj-empty-is-fail" ((mk-disj) empty-s) (list))
+(mk-test
+  "disj-empty-is-fail"
+  (stream-take 5 ((mk-disj) empty-s))
+  (list))
 
 (mk-test
   "disj-three-clauses"
@@ -188,7 +228,7 @@
       (map (fn (s) (mk-walk q s)) res)))
   (list "a" "b" "c"))
 
-;; --- conj/disj nesting (distributivity check) ---
+;; --- conj/disj nesting ---
 
 (mk-test
   "disj-of-conj"
@@ -199,18 +239,22 @@
       (map (fn (s) (list (mk-walk x s) (mk-walk y s))) res)))
   (list (list 1 2) (list 3 4)))
 
-;; --- ==-check (occurs-checked equality goal) ---
+;; --- ==-check ---
 
 (mk-test
   "eq-check-no-occurs-fails"
-  (let ((x (mk-var "x"))) ((==-check x (list 1 x)) empty-s))
+  (let
+    ((x (mk-var "x")))
+    (stream-take 5 ((==-check x (list 1 x)) empty-s)))
   (list))
 
 (mk-test
   "eq-check-no-occurs-non-occurring-succeeds"
   (let
     ((x (mk-var "x")))
-    (mk-walk x (first ((==-check x 5) empty-s))))
+    (mk-walk
+      x
+      (first (stream-take 5 ((==-check x 5) empty-s)))))
   5)
 
 (mk-tests-run!)

lib/minikanren/tests/relations.sx

@@ -0,0 +1,175 @@
+;; lib/minikanren/tests/relations.sx — Phase 4 standard relations.
+;;
+;; Includes the classic miniKanren canaries: appendo forwards / backwards /
+;; bidirectionally, membero, listo enumeration.
+
+;; --- nullo / pairo ---
+
+(mk-test
+  "nullo-empty-succeeds"
+  (run* q (nullo (list)))
+  (list (make-symbol "_.0")))
+
+(mk-test "nullo-non-empty-fails" (run* q (nullo (list 1))) (list))
+
+(mk-test
+  "pairo-non-empty-succeeds"
+  (run* q (pairo (list 1 2)))
+  (list (make-symbol "_.0")))
+
+(mk-test "pairo-empty-fails" (run* q (pairo (list))) (list))
+
+;; --- caro / cdro / firsto / resto ---
+
+(mk-test
+  "caro-extracts-head"
+  (run* q (caro (list 1 2 3) q))
+  (list 1))
+
+(mk-test
+  "cdro-extracts-tail"
+  (run* q (cdro (list 1 2 3) q))
+  (list (list 2 3)))
+
+(mk-test
+  "firsto-alias-of-caro"
+  (run* q (firsto (list 10 20) q))
+  (list 10))
+
+(mk-test
+  "resto-alias-of-cdro"
+  (run* q (resto (list 10 20) q))
+  (list (list 20)))
+
+(mk-test
+  "caro-cdro-build"
+  (run*
+    q
+    (fresh
+      (h t)
+      (caro (list 1 2 3) h)
+      (cdro (list 1 2 3) t)
+      (== q (list h t))))
+  (list (list 1 (list 2 3))))
+
+;; --- conso ---
+
+(mk-test
+  "conso-forward"
+  (run* q (conso 0 (list 1 2 3) q))
+  (list (list 0 1 2 3)))
+
+(mk-test
+  "conso-extract-head"
+  (run*
+    q
+    (conso
+      q
+      (list 2 3)
+      (list 1 2 3)))
+  (list 1))
+
+(mk-test
+  "conso-extract-tail"
+  (run* q (conso 1 q (list 1 2 3)))
+  (list (list 2 3)))
+
+;; --- listo ---
+
+(mk-test
+  "listo-empty-succeeds"
+  (run* q (listo (list)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "listo-finite-list-succeeds"
+  (run* q (listo (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "listo-enumerates-shapes"
+  (run 3 q (listo q))
+  (list
+    (list)
+    (list (make-symbol "_.0"))
+    (list (make-symbol "_.0") (make-symbol "_.1"))))
+
+;; --- appendo: the canary ---
+
+(mk-test
+  "appendo-forward-simple"
+  (run*
+    q
+    (appendo (list 1 2) (list 3 4) q))
+  (list (list 1 2 3 4)))
+
+(mk-test
+  "appendo-forward-empty-l"
+  (run* q (appendo (list) (list 3 4) q))
+  (list (list 3 4)))
+
+(mk-test
+  "appendo-forward-empty-s"
+  (run* q (appendo (list 1 2) (list) q))
+  (list (list 1 2)))
+
+(mk-test
+  "appendo-recovers-tail"
+  (run*
+    q
+    (appendo
+      (list 1 2)
+      q
+      (list 1 2 3 4)))
+  (list (list 3 4)))
+
+(mk-test
+  "appendo-recovers-prefix"
+  (run*
+    q
+    (appendo
+      q
+      (list 3 4)
+      (list 1 2 3 4)))
+  (list (list 1 2)))
+
+(mk-test
+  "appendo-backward-all-splits"
+  (run*
+    q
+    (fresh
+      (l s)
+      (appendo l s (list 1 2 3))
+      (== q (list l s))))
+  (list
+    (list (list) (list 1 2 3))
+    (list (list 1) (list 2 3))
+    (list (list 1 2) (list 3))
+    (list (list 1 2 3) (list))))
+
+(mk-test
+  "appendo-empty-empty-empty"
+  (run* q (appendo (list) (list) q))
+  (list (list)))
+
+;; --- membero ---
+
+(mk-test
+  "membero-element-present"
+  (run
+    1
+    q
+    (membero 2 (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "membero-element-absent-empty"
+  (run* q (membero 99 (list 1 2 3)))
+  (list))
+
+(mk-test
+  "membero-enumerates"
+  (run* q (membero q (list "a" "b" "c")))
+  (list "a" "b" "c"))
+
+(mk-tests-run!)