haskell: Phase 17 — import declarations anywhere among top-level decls

hk-collect-module-body previously ran a fixed import-loop at the start and then a separate decl-loop; merged into a single hk-body-step dispatcher that routes `import` to the imports list and everything else to hk-parse-decl. Both call sites (initial step + post-semicolon loop) use the dispatcher. The eval side reads imports as a list (not by AST position) so mid-stream imports feed into hk-bind-decls! unchanged. tests/parse-extras.sx 12 → 17: very-top, mid-stream, post-main, two-imports-different-positions, unqualified-mid-file. Regression sweep clean: eval 66/0, exceptions 14/0, typecheck 15/0, records 14/0, ioref 13/0, map 26/0, set 17/0. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
haskell: Phase 17 — expression type annotations (x :: Int) (parse + desugar pass-through)
2026-05-10 19:11:36 +00:00 · 2026-05-08 23:12:35 +00:00 · 2026-05-08 22:41:22 +00:00 · 2026-05-08 07:06:28 +00:00 · 2026-05-08 00:17:46 +00:00 · 2026-05-07 20:35:28 +00:00
160 changed files with 6646 additions and 9279 deletions
--- a/lib/apl/parser.sx
+++ b/lib/apl/parser.sx
@@ -25,8 +25,9 @@
 ; Glyph classification sets
 ; ============================================================

-(define apl-parse-op-glyphs
-  (list "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@"))
+(define
+  apl-parse-op-glyphs
+  (list "/" "⌿" "\\" "⍀" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@"))

 (define
  apl-parse-fn-glyphs
@@ -82,22 +83,48 @@
    "⍎"
    "⍕"))

-(define apl-quad-fn-names (list "⎕FMT"))
+(define apl-quad-fn-names (list "⎕FMT" "⎕←"))

-(define
-  apl-parse-op-glyph?
-  (fn (v) (some (fn (g) (= g v)) apl-parse-op-glyphs)))
+(define apl-known-fn-names (list))

 ; ============================================================
 ; Token accessors
 ; ============================================================

+(define
+  apl-collect-fn-bindings
+  (fn
+    (stmt-groups)
+    (set! apl-known-fn-names (list))
+    (for-each
+      (fn
+        (toks)
+        (when
+          (and
+            (>= (len toks) 3)
+            (= (tok-type (nth toks 0)) :name)
+            (= (tok-type (nth toks 1)) :assign)
+            (= (tok-type (nth toks 2)) :lbrace))
+          (set!
+            apl-known-fn-names
+            (cons (tok-val (nth toks 0)) apl-known-fn-names))))
+      stmt-groups)))
+
+(define
+  apl-parse-op-glyph?
+  (fn (v) (some (fn (g) (= g v)) apl-parse-op-glyphs)))
+
 (define
  apl-parse-fn-glyph?
  (fn (v) (some (fn (g) (= g v)) apl-parse-fn-glyphs)))

 (define tok-type (fn (tok) (get tok :type)))

+; ============================================================
+; Collect trailing operators starting at index i
+; Returns {:ops (op ...) :end new-i}
+; ============================================================
+
 (define tok-val (fn (tok) (get tok :value)))

 (define
@@ -107,8 +134,8 @@
    (and (= (tok-type tok) :glyph) (apl-parse-op-glyph? (tok-val tok)))))

 ; ============================================================
-; Collect trailing operators starting at index i
-; Returns {:ops (op ...) :end new-i}
+; Build a derived-fn node by chaining operators left-to-right
+; (+/¨  →  (:derived-fn "¨" (:derived-fn "/" (:fn-glyph "+"))))
 ; ============================================================

 (define
@@ -119,15 +146,17 @@
      (and (= (tok-type tok) :glyph) (apl-parse-fn-glyph? (tok-val tok)))
      (and
        (= (tok-type tok) :name)
-        (some (fn (q) (= q (tok-val tok))) apl-quad-fn-names)))))
+        (or
+          (some (fn (q) (= q (tok-val tok))) apl-quad-fn-names)
+          (some (fn (q) (= q (tok-val tok))) apl-known-fn-names))))))
+
+; ============================================================
+; Find matching close bracket/paren/brace
+; Returns the index of the matching close token
+; ============================================================

 (define collect-ops (fn (tokens i) (collect-ops-loop tokens i (list))))

-; ============================================================
-; Build a derived-fn node by chaining operators left-to-right
-; (+/¨  →  (:derived-fn "¨" (:derived-fn "/" (:fn-glyph "+"))))
-; ============================================================
-
 (define
  collect-ops-loop
  (fn
@@ -143,8 +172,10 @@
          {:end i :ops acc})))))

 ; ============================================================
-; Find matching close bracket/paren/brace
-; Returns the index of the matching close token
+; Segment collection: scan tokens left-to-right, building
+; a list of {:kind "val"/"fn" :node ast} segments.
+; Operators following function glyphs are merged into
+; derived-fn nodes during this pass.
 ; ============================================================

 (define
@@ -163,12 +194,20 @@
    (find-matching-close-loop tokens start open-type close-type 1)))

 ; ============================================================
-; Segment collection: scan tokens left-to-right, building
-; a list of {:kind "val"/"fn" :node ast} segments.
-; Operators following function glyphs are merged into
-; derived-fn nodes during this pass.
+; Build tree from segment list
+;
+; The segments are in left-to-right order.
+; APL evaluates right-to-left, so the LEFTMOST function is
+; the outermost (last-evaluated) node.
+;
+; Patterns:
+;   [val]              → val node
+;   [fn val ...]       → (:monad fn (build-tree rest))
+;   [val fn val ...]   → (:dyad fn val (build-tree rest))
+;   [val val ...]      → (:vec val1 val2 ...) — strand
 ; ============================================================

+; Find the index of the first function segment (returns -1 if none)
 (define
  find-matching-close-loop
  (fn
@@ -208,21 +247,9 @@
  collect-segments
  (fn (tokens) (collect-segments-loop tokens 0 (list))))

-; ============================================================
-; Build tree from segment list
-;
-; The segments are in left-to-right order.
-; APL evaluates right-to-left, so the LEFTMOST function is
-; the outermost (last-evaluated) node.
-;
-; Patterns:
-;   [val]              → val node
-;   [fn val ...]       → (:monad fn (build-tree rest))
-;   [val fn val ...]   → (:dyad fn val (build-tree rest))
-;   [val val ...]      → (:vec val1 val2 ...) — strand
-; ============================================================
-
-; Find the index of the first function segment (returns -1 if none)
+; Build an array node from 0..n value segments
+; If n=1 → return that segment's node
+; If n>1 → return (:vec node1 node2 ...)
 (define
  collect-segments-loop
  (fn
@@ -242,24 +269,38 @@
            ((= tt :str)
              (collect-segments-loop tokens (+ i 1) (append acc {:kind "val" :node (list :str tv)})))
            ((= tt :name)
-              (if
-                (some (fn (q) (= q tv)) apl-quad-fn-names)
-                (let
-                  ((op-result (collect-ops tokens (+ i 1))))
+              (cond
+                ((some (fn (q) (= q tv)) apl-quad-fn-names)
                  (let
-                    ((ops (get op-result :ops)) (ni (get op-result :end)))
+                    ((op-result (collect-ops tokens (+ i 1))))
                    (let
-                      ((fn-node (build-derived-fn (list :fn-glyph tv) ops)))
-                      (collect-segments-loop
-                        tokens
-                        ni
-                        (append acc {:kind "fn" :node fn-node})))))
-                (let
-                  ((br (maybe-bracket (list :name tv) tokens (+ i 1))))
-                  (collect-segments-loop
-                    tokens
-                    (nth br 1)
-                    (append acc {:kind "val" :node (nth br 0)})))))
+                      ((ops (get op-result :ops))
+                        (ni (get op-result :end)))
+                      (let
+                        ((fn-node (build-derived-fn (list :fn-glyph tv) ops)))
+                        (collect-segments-loop
+                          tokens
+                          ni
+                          (append acc {:kind "fn" :node fn-node}))))))
+                ((some (fn (q) (= q tv)) apl-known-fn-names)
+                  (let
+                    ((op-result (collect-ops tokens (+ i 1))))
+                    (let
+                      ((ops (get op-result :ops))
+                        (ni (get op-result :end)))
+                      (let
+                        ((fn-node (build-derived-fn (list :fn-name tv) ops)))
+                        (collect-segments-loop
+                          tokens
+                          ni
+                          (append acc {:kind "fn" :node fn-node}))))))
+                (else
+                  (let
+                    ((br (maybe-bracket (list :name tv) tokens (+ i 1))))
+                    (collect-segments-loop
+                      tokens
+                      (nth br 1)
+                      (append acc {:kind "val" :node (nth br 0)}))))))
            ((= tt :lparen)
              (let
                ((end (find-matching-close tokens (+ i 1) :lparen :rparen)))
@@ -267,11 +308,23 @@
                  ((inner-tokens (slice tokens (+ i 1) end))
                    (after (+ end 1)))
                  (let
-                    ((br (maybe-bracket (parse-apl-expr inner-tokens) tokens after)))
-                    (collect-segments-loop
-                      tokens
-                      (nth br 1)
-                      (append acc {:kind "val" :node (nth br 0)}))))))
+                    ((inner-segs (collect-segments inner-tokens)))
+                    (if
+                      (and
+                        (>= (len inner-segs) 2)
+                        (every? (fn (s) (= (get s :kind) "fn")) inner-segs))
+                      (let
+                        ((train-node (cons :train (map (fn (s) (get s :node)) inner-segs))))
+                        (collect-segments-loop
+                          tokens
+                          after
+                          (append acc {:kind "fn" :node train-node})))
+                      (let
+                        ((br (maybe-bracket (parse-apl-expr inner-tokens) tokens after)))
+                        (collect-segments-loop
+                          tokens
+                          (nth br 1)
+                          (append acc {:kind "val" :node (nth br 0)}))))))))
            ((= tt :lbrace)
              (let
                ((end (find-matching-close tokens (+ i 1) :lbrace :rbrace)))
@@ -346,9 +399,12 @@

 (define find-first-fn (fn (segs) (find-first-fn-loop segs 0)))

-; Build an array node from 0..n value segments
-; If n=1 → return that segment's node
-; If n>1 → return (:vec node1 node2 ...)
+
+; ============================================================
+; Split token list on statement separators (diamond / newline)
+; Only splits at depth 0 (ignores separators inside { } or ( ) )
+; ============================================================
+
 (define
  find-first-fn-loop
  (fn
@@ -370,10 +426,9 @@
      (get (first segs) :node)
      (cons :vec (map (fn (s) (get s :node)) segs)))))

-
 ; ============================================================
-; Split token list on statement separators (diamond / newline)
-; Only splits at depth 0 (ignores separators inside { } or ( ) )
+; Parse a dfn body (tokens between { and })
+; Handles guard expressions: cond : expr
 ; ============================================================

 (define
@@ -408,11 +463,6 @@
  split-statements
  (fn (tokens) (split-statements-loop tokens (list) (list) 0)))

-; ============================================================
-; Parse a dfn body (tokens between { and })
-; Handles guard expressions: cond : expr
-; ============================================================
-
 (define
  split-statements-loop
  (fn
@@ -467,6 +517,10 @@
      ((stmt-groups (split-statements tokens)))
      (let ((stmts (map parse-dfn-stmt stmt-groups))) (cons :dfn stmts)))))

+; ============================================================
+; Parse a single statement (assignment or expression)
+; ============================================================
+
 (define
  parse-dfn-stmt
  (fn
@@ -483,12 +537,17 @@
            (parse-apl-expr body-tokens)))
        (parse-stmt tokens)))))

+; ============================================================
+; Parse an expression from a flat token list
+; ============================================================
+
 (define
  find-top-level-colon
  (fn (tokens i) (find-top-level-colon-loop tokens i 0)))

 ; ============================================================
-; Parse a single statement (assignment or expression)
+; Main entry point
+; parse-apl: string → AST
 ; ============================================================

 (define
@@ -508,10 +567,6 @@
          ((and (= tt :colon) (= depth 0)) i)
          (true (find-top-level-colon-loop tokens (+ i 1) depth)))))))

-; ============================================================
-; Parse an expression from a flat token list
-; ============================================================
-
 (define
  parse-stmt
  (fn
@@ -526,11 +581,6 @@
        (parse-apl-expr (slice tokens 2)))
      (parse-apl-expr tokens))))

-; ============================================================
-; Main entry point
-; parse-apl: string → AST
-; ============================================================
-
 (define
  parse-apl-expr
  (fn
@@ -547,13 +597,52 @@
      ((tokens (apl-tokenize src)))
      (let
        ((stmt-groups (split-statements tokens)))
-        (if
-          (= (len stmt-groups) 0)
-          nil
+        (begin
+          (apl-collect-fn-bindings stmt-groups)
          (if
-            (= (len stmt-groups) 1)
-            (parse-stmt (first stmt-groups))
-            (cons :program (map parse-stmt stmt-groups))))))))
+            (= (len stmt-groups) 0)
+            nil
+            (if
+              (= (len stmt-groups) 1)
+              (parse-stmt (first stmt-groups))
+              (cons :program (map parse-stmt stmt-groups)))))))))
+
+(define
+  split-bracket-loop
+  (fn
+    (tokens current acc depth)
+    (if
+      (= (len tokens) 0)
+      (append acc (list current))
+      (let
+        ((tok (first tokens)) (more (rest tokens)))
+        (let
+          ((tt (tok-type tok)))
+          (cond
+            ((or (= tt :lparen) (= tt :lbrace) (= tt :lbracket))
+              (split-bracket-loop
+                more
+                (append current (list tok))
+                acc
+                (+ depth 1)))
+            ((or (= tt :rparen) (= tt :rbrace) (= tt :rbracket))
+              (split-bracket-loop
+                more
+                (append current (list tok))
+                acc
+                (- depth 1)))
+            ((and (= tt :semi) (= depth 0))
+              (split-bracket-loop
+                more
+                (list)
+                (append acc (list current))
+                depth))
+            (else
+              (split-bracket-loop more (append current (list tok)) acc depth))))))))
+
+(define
+  split-bracket-content
+  (fn (tokens) (split-bracket-loop tokens (list) (list) 0)))

 (define
  maybe-bracket
@@ -569,8 +658,17 @@
          ((inner-tokens (slice tokens (+ after 1) end))
            (next-after (+ end 1)))
          (let
-            ((idx-expr (parse-apl-expr inner-tokens)))
-            (let
-              ((indexed (list :dyad (list :fn-glyph "⌷") idx-expr val-node)))
-              (maybe-bracket indexed tokens next-after)))))
+            ((sections (split-bracket-content inner-tokens)))
+            (if
+              (= (len sections) 1)
+              (let
+                ((idx-expr (parse-apl-expr inner-tokens)))
+                (let
+                  ((indexed (list :dyad (list :fn-glyph "⌷") idx-expr val-node)))
+                  (maybe-bracket indexed tokens next-after)))
+              (let
+                ((axis-exprs (map (fn (toks) (if (= (len toks) 0) :all (parse-apl-expr toks))) sections)))
+                (let
+                  ((indexed (cons :bracket (cons val-node axis-exprs))))
+                  (maybe-bracket indexed tokens next-after)))))))
      (list val-node after))))
--- a/lib/apl/runtime.sx
+++ b/lib/apl/runtime.sx
@@ -883,7 +883,7 @@
      (let
        ((sub (apl-permutations (- n 1))))
        (reduce
-          (fn (acc p) (append acc (apl-insert-everywhere n p)))
+          (fn (acc p) (append (apl-insert-everywhere n p) acc))
          (list)
          sub)))))

@@ -985,6 +985,38 @@
        (some (fn (c) (= c 0)) codes)
        (some (fn (c) (= c (nth e 1))) codes)))))

+(define
+  apl-cartesian
+  (fn
+    (lists)
+    (if
+      (= (len lists) 0)
+      (list (list))
+      (let
+        ((rest-prods (apl-cartesian (rest lists))))
+        (reduce
+          (fn (acc x) (append acc (map (fn (p) (cons x p)) rest-prods)))
+          (list)
+          (first lists))))))
+
+(define
+  apl-bracket-multi
+  (fn
+    (axes arr)
+    (let
+      ((shape (get arr :shape)) (ravel (get arr :ravel)))
+      (let
+        ((rank (len shape)) (strides (apl-strides shape)))
+        (let
+          ((axis-info (map (fn (i) (let ((a (nth axes i))) (cond ((= a nil) {:idxs (range 0 (nth shape i)) :scalar? false}) ((= (len (get a :shape)) 0) {:idxs (list (- (first (get a :ravel)) apl-io)) :scalar? true}) (else {:idxs (map (fn (x) (- x apl-io)) (get a :ravel)) :scalar? false})))) (range 0 rank))))
+          (let
+            ((cells (apl-cartesian (map (fn (a) (get a :idxs)) axis-info))))
+            (let
+              ((result-ravel (map (fn (cell) (let ((flat (reduce + 0 (map (fn (i) (* (nth cell i) (nth strides i))) (range 0 rank))))) (nth ravel flat))) cells)))
+              (let
+                ((result-shape (filter (fn (x) (>= x 0)) (map (fn (i) (let ((a (nth axis-info i))) (if (get a :scalar?) -1 (len (get a :idxs))))) (range 0 rank)))))
+                (make-array result-shape result-ravel)))))))))
+
 (define
  apl-reduce
  (fn
--- a/lib/apl/test.sh
+++ b/lib/apl/test.sh
@@ -39,6 +39,7 @@ cat > "$TMPFILE" << 'EPOCHS'
 (load "lib/apl/tests/idioms.sx")
 (load "lib/apl/tests/eval-ops.sx")
 (load "lib/apl/tests/pipeline.sx")
+(load "lib/apl/tests/programs-e2e.sx")
 (epoch 4)
 (eval "(list apl-test-pass apl-test-fail)")
 EPOCHS
--- a/lib/apl/tests/pipeline.sx
+++ b/lib/apl/tests/pipeline.sx
@@ -178,3 +178,137 @@
  "apl-run \"(⍳5)[3] × 7\" → 21"
  (mkrv (apl-run "(⍳5)[3] × 7"))
  (list 21))
+
+(apl-test "decimal: 3.7 → 3.7" (mkrv (apl-run "3.7")) (list 3.7))
+
+(apl-test "decimal: ¯2.5 → -2.5" (mkrv (apl-run "¯2.5")) (list -2.5))
+
+(apl-test "decimal: 1.5 + 2.5 → 4" (mkrv (apl-run "1.5 + 2.5")) (list 4))
+
+(apl-test "decimal: ⌊3.7 → 3" (mkrv (apl-run "⌊ 3.7")) (list 3))
+
+(apl-test "decimal: ⌈3.7 → 4" (mkrv (apl-run "⌈ 3.7")) (list 4))
+
+(apl-test
+  "⎕← scalar passthrough"
+  (mkrv (apl-run "⎕← 42"))
+  (list 42))
+
+(apl-test
+  "⎕← vector passthrough"
+  (mkrv (apl-run "⎕← 1 2 3"))
+  (list 1 2 3))
+
+(apl-test
+  "string: 'abc' → 3-char vector"
+  (mkrv (apl-run "'abc'"))
+  (list "a" "b" "c"))
+
+(apl-test "string: 'a' is rank-0 scalar" (mksh (apl-run "'a'")) (list))
+
+(apl-test "string: 'hello' shape (5)" (mksh (apl-run "'hello'")) (list 5))
+
+(apl-test
+  "named-fn: f ← {⍺+⍵} ⋄ 3 f 4 → 7"
+  (mkrv (apl-run "f ← {⍺+⍵} ⋄ 3 f 4"))
+  (list 7))
+
+(apl-test
+  "named-fn monadic: sq ← {⍵×⍵} ⋄ sq 7 → 49"
+  (mkrv (apl-run "sq ← {⍵×⍵} ⋄ sq 7"))
+  (list 49))
+
+(apl-test
+  "named-fn dyadic: hyp ← {((⍺×⍺)+⍵×⍵)} ⋄ 3 hyp 4 → 25"
+  (mkrv (apl-run "hyp ← {((⍺×⍺)+⍵×⍵)} ⋄ 3 hyp 4"))
+  (list 25))
+
+(apl-test
+  "named-fn: dbl ← {⍵+⍵} ⋄ dbl ⍳5"
+  (mkrv (apl-run "dbl ← {⍵+⍵} ⋄ dbl ⍳5"))
+  (list 2 4 6 8 10))
+
+(apl-test
+  "named-fn factorial via ∇ recursion"
+  (mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 5"))
+  (list 120))
+
+(apl-test
+  "named-fn used twice in expr: dbl ← {⍵+⍵} ⋄ (dbl 3) + dbl 4"
+  (mkrv (apl-run "dbl ← {⍵+⍵} ⋄ (dbl 3) + dbl 4"))
+  (list 14))
+
+(apl-test
+  "named-fn with vector arg: neg ← {-⍵} ⋄ neg 1 2 3"
+  (mkrv (apl-run "neg ← {-⍵} ⋄ neg 1 2 3"))
+  (list -1 -2 -3))
+
+(apl-test
+  "multi-axis: M[2;2] → center"
+  (mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[2;2]"))
+  (list 5))
+
+(apl-test
+  "multi-axis: M[1;] → first row"
+  (mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[1;]"))
+  (list 1 2 3))
+
+(apl-test
+  "multi-axis: M[;2] → second column"
+  (mkrv (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[;2]"))
+  (list 2 5 8))
+
+(apl-test
+  "multi-axis: M[1 2;1 2] → 2x2 block"
+  (mkrv (apl-run "M ← (2 3) ⍴ ⍳6 ⋄ M[1 2;1 2]"))
+  (list 1 2 4 5))
+
+(apl-test
+  "multi-axis: M[1 2;1 2] shape (2 2)"
+  (mksh (apl-run "M ← (2 3) ⍴ ⍳6 ⋄ M[1 2;1 2]"))
+  (list 2 2))
+
+(apl-test
+  "multi-axis: M[;] full matrix"
+  (mkrv (apl-run "M ← (2 2) ⍴ 10 20 30 40 ⋄ M[;]"))
+  (list 10 20 30 40))
+
+(apl-test
+  "multi-axis: M[1;] shape collapsed"
+  (mksh (apl-run "M ← (3 3) ⍴ ⍳9 ⋄ M[1;]"))
+  (list 3))
+
+(apl-test
+  "multi-axis: select all rows of column 3"
+  (mkrv (apl-run "M ← (4 3) ⍴ 1 2 3 4 5 6 7 8 9 10 11 12 ⋄ M[;3]"))
+  (list 3 6 9 12))
+
+(apl-test
+  "train: mean = (+/÷≢) on 1..5"
+  (mkrv (apl-run "(+/÷≢) 1 2 3 4 5"))
+  (list 3))
+
+(apl-test
+  "train: mean of 2 4 6 8 10"
+  (mkrv (apl-run "(+/÷≢) 2 4 6 8 10"))
+  (list 6))
+
+(apl-test
+  "train 2-atop: (- ⌊) 5 → -5"
+  (mkrv (apl-run "(- ⌊) 5"))
+  (list -5))
+
+(apl-test
+  "train 3-fork dyadic: 2(+×-)5 → -21"
+  (mkrv (apl-run "2 (+ × -) 5"))
+  (list -21))
+
+(apl-test
+  "train: range = (⌈/-⌊/) on vector"
+  (mkrv (apl-run "(⌈/-⌊/) 3 1 4 1 5 9 2 6"))
+  (list 8))
+
+(apl-test
+  "train: mean of ⍳10 has shape ()"
+  (mksh (apl-run "(+/÷≢) ⍳10"))
+  (list))
--- a/lib/apl/tests/programs-e2e.sx
+++ b/lib/apl/tests/programs-e2e.sx
@@ -0,0 +1,96 @@
+; End-to-end tests of the classic-program archetypes — running APL
+; source through the full pipeline (tokenize → parse → eval-ast → runtime).
+;
+; These mirror the algorithms documented in lib/apl/tests/programs/*.apl
+; but use forms our pipeline supports today (named functions instead of
+; the inline ⍵← rebinding idiom; multi-stmt over single one-liners).
+
+(define mkrv (fn (arr) (get arr :ravel)))
+(define mksh (fn (arr) (get arr :shape)))
+
+; ---------- factorial via ∇ recursion (cf. n-queens style) ----------
+
+(apl-test
+  "e2e: factorial 5! = 120"
+  (mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 5"))
+  (list 120))
+
+(apl-test
+  "e2e: factorial 7! = 5040"
+  (mkrv (apl-run "fact ← {0=⍵:1 ⋄ ⍵×∇⍵-1} ⋄ fact 7"))
+  (list 5040))
+
+(apl-test
+  "e2e: factorial via ×/⍳N (no recursion)"
+  (mkrv (apl-run "fact ← {×/⍳⍵} ⋄ fact 6"))
+  (list 720))
+
+; ---------- sum / triangular numbers (sum-1..N) ----------
+
+(apl-test
+  "e2e: triangular(10) = 55"
+  (mkrv (apl-run "tri ← {+/⍳⍵} ⋄ tri 10"))
+  (list 55))
+
+(apl-test
+  "e2e: triangular(100) = 5050"
+  (mkrv (apl-run "tri ← {+/⍳⍵} ⋄ tri 100"))
+  (list 5050))
+
+; ---------- sum of squares ----------
+
+(apl-test
+  "e2e: sum-of-squares 1..5 = 55"
+  (mkrv (apl-run "ss ← {+/⍵×⍵} ⋄ ss ⍳5"))
+  (list 55))
+
+(apl-test
+  "e2e: sum-of-squares 1..10 = 385"
+  (mkrv (apl-run "ss ← {+/⍵×⍵} ⋄ ss ⍳10"))
+  (list 385))
+
+; ---------- divisor-counting (prime-sieve building blocks) ----------
+
+(apl-test
+  "e2e: divisor counts 1..5 via outer mod"
+  (mkrv (apl-run "P ← ⍳ 5 ⋄ +⌿ 0 = P ∘.| P"))
+  (list 1 2 2 3 2))
+
+(apl-test
+  "e2e: divisor counts 1..10"
+  (mkrv (apl-run "P ← ⍳ 10 ⋄ +⌿ 0 = P ∘.| P"))
+  (list 1 2 2 3 2 4 2 4 3 4))
+
+(apl-test
+  "e2e: prime-mask 1..10 (count==2)"
+  (mkrv (apl-run "P ← ⍳ 10 ⋄ 2 = +⌿ 0 = P ∘.| P"))
+  (list 0 1 1 0 1 0 1 0 0 0))
+
+; ---------- monadic primitives chained ----------
+
+(apl-test
+  "e2e: sum of |abs| = 15"
+  (mkrv (apl-run "+/|¯1 ¯2 ¯3 ¯4 ¯5"))
+  (list 15))
+
+(apl-test
+  "e2e: max of squares 1..6"
+  (mkrv (apl-run "⌈/(⍳6)×⍳6"))
+  (list 36))
+
+; ---------- nested named functions ----------
+
+(apl-test
+  "e2e: compose dbl and sq via two named fns"
+  (mkrv (apl-run "dbl ← {⍵+⍵} ⋄ sq ← {⍵×⍵} ⋄ sq dbl 3"))
+  (list 36))
+
+(apl-test
+  "e2e: max-of-two as named dyadic fn"
+  (mkrv (apl-run "mx ← {⍺⌈⍵} ⋄ 5 mx 3"))
+  (list 5))
+
+(apl-test
+  "e2e: sqrt-via-newton 1 step from 1 → 2.5"
+  (mkrv (apl-run "step ← {(⍵+⍺÷⍵)÷2} ⋄ 4 step 1"))
+  (list 2.5))
--- a/lib/apl/tests/programs.sx
+++ b/lib/apl/tests/programs.sx
@@ -252,6 +252,8 @@

 (apl-test "queens 7 → 40 solutions" (mkrv (apl-queens 7)) (list 40))

+(apl-test "queens 8 → 92 solutions" (mkrv (apl-queens 8)) (list 92))
+
 (apl-test "permutations of 3 has 6" (len (apl-permutations 3)) 6)

 (apl-test "permutations of 4 has 24" (len (apl-permutations 4)) 24)
--- a/lib/apl/tokenizer.sx
+++ b/lib/apl/tokenizer.sx
@@ -2,7 +2,7 @@
  (list "+" "-" "×" "÷" "*" "⍟" "⌈" "⌊" "|" "!" "?" "○" "~" "<" "≤" "=" "≥" ">" "≠"
        "≢" "≡" "∊" "∧" "∨" "⍱" "⍲" "," "⍪" "⍴" "⌽" "⊖" "⍉" "↑" "↓" "⊂" "⊃" "⊆"
        "∪" "∩" "⍳" "⍸" "⌷" "⍋" "⍒" "⊥" "⊤" "⊣" "⊢" "⍎" "⍕"
-        "⍺" "⍵" "∇" "/" "\\" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@" "¯"))
+        "⍺" "⍵" "∇" "/" "⌿" "\\" "⍀" "¨" "⍨" "∘" "." "⍣" "⍤" "⍥" "@" "¯"))

 (define apl-glyph?
  (fn (ch)
@@ -138,12 +138,22 @@
                 (begin
                   (consume! "¯")
                   (let ((digits (read-digits! "")))
-                     (tok-push! :num (- 0 (parse-int digits 0))))
+                     (if (and (< pos src-len) (= (cur-byte) ".")
+                              (< (+ pos 1) src-len) (apl-digit? (nth source (+ pos 1))))
+                       (begin (advance!)
+                              (let ((frac (read-digits! "")))
+                                (tok-push! :num (- 0 (string->number (str digits "." frac))))))
+                       (tok-push! :num (- 0 (parse-int digits 0)))))
                   (scan!)))
                ((apl-digit? ch)
                 (begin
                   (let ((digits (read-digits! "")))
-                     (tok-push! :num (parse-int digits 0)))
+                     (if (and (< pos src-len) (= (cur-byte) ".")
+                              (< (+ pos 1) src-len) (apl-digit? (nth source (+ pos 1))))
+                       (begin (advance!)
+                              (let ((frac (read-digits! "")))
+                                (tok-push! :num (string->number (str digits "." frac)))))
+                       (tok-push! :num (parse-int digits 0))))
                   (scan!)))
                ((= ch "'")
                 (begin
@@ -155,7 +165,9 @@
                 (let ((start pos))
                   (begin
                     (if (cur-sw? "⎕") (consume! "⎕") (advance!))
-                     (read-ident-cont!)
+                     (if (and (< pos src-len) (cur-sw? "←"))
+                       (consume! "←")
+                       (read-ident-cont!))
                     (tok-push! :name (slice source start pos))
                     (scan!))))
                (true
--- a/lib/apl/transpile.sx
+++ b/lib/apl/transpile.sx
@@ -40,6 +40,7 @@
      ((= g "⍋") apl-grade-up)
      ((= g "⍒") apl-grade-down)
      ((= g "⎕FMT") apl-quad-fmt)
+      ((= g "⎕←") apl-quad-print)
      (else (error "no monadic fn for glyph")))))

 (define
@@ -97,6 +98,15 @@
      ((tag (first node)))
      (cond
        ((= tag :num) (apl-scalar (nth node 1)))
+        ((= tag :str)
+          (let
+            ((s (nth node 1)))
+            (if
+              (= (len s) 1)
+              (apl-scalar s)
+              (make-array
+                (list (len s))
+                (map (fn (i) (slice s i (+ i 1))) (range 0 (len s)))))))
        ((= tag :vec)
          (let
            ((items (rest node)))
@@ -139,6 +149,16 @@
                (apl-eval-ast rhs env)))))
        ((= tag :program) (apl-eval-stmts (rest node) env))
        ((= tag :dfn) node)
+        ((= tag :bracket)
+          (let
+            ((arr-expr (nth node 1)) (axis-exprs (rest (rest node))))
+            (let
+              ((arr (apl-eval-ast arr-expr env))
+                (axes
+                  (map
+                    (fn (a) (if (= a :all) nil (apl-eval-ast a env)))
+                    axis-exprs)))
+              (apl-bracket-multi axes arr))))
        (else (error (list "apl-eval-ast: unknown node tag" tag node)))))))

 (define
@@ -419,6 +439,36 @@
                  ((f (apl-resolve-dyadic inner env)))
                  (fn (arr) (apl-commute f arr))))
              (else (error "apl-resolve-monadic: unsupported op")))))
+        ((= tag :fn-name)
+          (let
+            ((nm (nth fn-node 1)))
+            (let
+              ((bound (get env nm)))
+              (if
+                (and
+                  (list? bound)
+                  (> (len bound) 0)
+                  (= (first bound) :dfn))
+                (fn (arg) (apl-call-dfn-m bound arg))
+                (error "apl-resolve-monadic: name not bound to dfn")))))
+        ((= tag :train)
+          (let
+            ((fns (rest fn-node)))
+            (let
+              ((n (len fns)))
+              (cond
+                ((= n 2)
+                  (let
+                    ((g (apl-resolve-monadic (nth fns 0) env))
+                      (h (apl-resolve-monadic (nth fns 1) env)))
+                    (fn (arg) (g (h arg)))))
+                ((= n 3)
+                  (let
+                    ((f (apl-resolve-monadic (nth fns 0) env))
+                      (g (apl-resolve-dyadic (nth fns 1) env))
+                      (h (apl-resolve-monadic (nth fns 2) env)))
+                    (fn (arg) (g (f arg) (h arg)))))
+                (else (error "monadic train arity not 2 or 3"))))))
        (else (error "apl-resolve-monadic: unknown fn-node tag"))))))

 (define
@@ -442,6 +492,18 @@
                  ((f (apl-resolve-dyadic inner env)))
                  (fn (a b) (apl-commute-dyadic f a b))))
              (else (error "apl-resolve-dyadic: unsupported op")))))
+        ((= tag :fn-name)
+          (let
+            ((nm (nth fn-node 1)))
+            (let
+              ((bound (get env nm)))
+              (if
+                (and
+                  (list? bound)
+                  (> (len bound) 0)
+                  (= (first bound) :dfn))
+                (fn (a b) (apl-call-dfn bound a b))
+                (error "apl-resolve-dyadic: name not bound to dfn")))))
        ((= tag :outer)
          (let
            ((inner (nth fn-node 2)))
@@ -455,6 +517,24 @@
              ((f (apl-resolve-dyadic f-node env))
                (g (apl-resolve-dyadic g-node env)))
              (fn (a b) (apl-inner f g a b)))))
+        ((= tag :train)
+          (let
+            ((fns (rest fn-node)))
+            (let
+              ((n (len fns)))
+              (cond
+                ((= n 2)
+                  (let
+                    ((g (apl-resolve-monadic (nth fns 0) env))
+                      (h (apl-resolve-dyadic (nth fns 1) env)))
+                    (fn (a b) (g (h a b)))))
+                ((= n 3)
+                  (let
+                    ((f (apl-resolve-dyadic (nth fns 0) env))
+                      (g (apl-resolve-dyadic (nth fns 1) env))
+                      (h (apl-resolve-dyadic (nth fns 2) env)))
+                    (fn (a b) (g (f a b) (h a b)))))
+                (else (error "dyadic train arity not 2 or 3"))))))
        (else (error "apl-resolve-dyadic: unknown fn-node tag"))))))

 (define apl-run (fn (src) (apl-eval-ast (parse-apl src) {})))
--- a/lib/guest/hm.sx
+++ b/lib/guest/hm.sx
@@ -0,0 +1,180 @@
+;; lib/guest/hm.sx — Hindley-Milner type-inference foundations.
+;;
+;; Builds on lib/guest/match.sx (terms + unify) and ast.sx (canonical
+;; AST shapes). This file ships the ALGEBRA — types, schemes, free
+;; type-vars, generalize / instantiate, substitution composition — so a
+;; full Algorithm W (or J) can be assembled on top either inside this
+;; file or in a host-specific consumer (haskell/infer.sx,
+;; lib/ocaml/types.sx, …).
+;;
+;; Per the brief the second consumer for this step is OCaml-on-SX
+;; Phase 5 (paired sequencing). Until that lands, the algebra is the
+;; deliverable; the host-flavoured assembly (lambda / app / let
+;; inference rules with substitution threading) lives in the host.
+;;
+;; Types
+;; -----
+;; A type is a canonical match.sx term — type variables use mk-var,
+;; type constructors use mk-ctor:
+;;   (hm-tv NAME)              type variable
+;;   (hm-arrow A B)             A -> B
+;;   (hm-con NAME ARGS)         named n-ary constructor
+;;   (hm-int) / (hm-bool) / (hm-string)   primitive constructors
+;;
+;; Schemes
+;; -------
+;;   (hm-scheme VARS TYPE)        ∀ VARS . TYPE
+;;   (hm-monotype TYPE)           empty quantifier
+;;   (hm-scheme? S) (hm-scheme-vars S) (hm-scheme-type S)
+;;
+;; Free type variables
+;; -------------------
+;;   (hm-ftv TYPE)                names occurring in TYPE
+;;   (hm-ftv-scheme S)            free names (minus quantifiers)
+;;   (hm-ftv-env ENV)             free across an env (name -> scheme)
+;;
+;; Substitution
+;; ------------
+;;   (hm-apply SUBST TYPE)        substitute through a type
+;;   (hm-apply-scheme SUBST S)    leaves bound vars alone
+;;   (hm-apply-env SUBST ENV)
+;;   (hm-compose S2 S1)           apply S1 then S2
+;;
+;; Generalize / Instantiate
+;; ------------------------
+;;   (hm-generalize TYPE ENV)      → scheme over ftv(t) - ftv(env)
+;;   (hm-instantiate SCHEME COUNTER) → fresh-var instance
+;;   (hm-fresh-tv COUNTER)         → (:var "tN"), bumps COUNTER
+;;
+;; Inference (literal only — the rest of Algorithm W lives in the host)
+;; --------------------------------------------------------------------
+;;   (hm-infer-literal EXPR)       → {:subst {} :type T}
+;;
+;; A complete Algorithm W consumes this kit by assembling lambda / app
+;; / let rules in the host language file.
+
+(define hm-tv     (fn (name) (list :var name)))
+(define hm-con    (fn (name args) (list :ctor name args)))
+(define hm-arrow  (fn (a b) (hm-con "->" (list a b))))
+(define hm-int    (fn () (hm-con "Int" (list))))
+(define hm-bool   (fn () (hm-con "Bool" (list))))
+(define hm-string (fn () (hm-con "String" (list))))
+
+(define hm-scheme        (fn (vars t) (list :scheme vars t)))
+(define hm-monotype      (fn (t) (hm-scheme (list) t)))
+(define hm-scheme?       (fn (s) (and (list? s) (not (empty? s)) (= (first s) :scheme))))
+(define hm-scheme-vars   (fn (s) (nth s 1)))
+(define hm-scheme-type   (fn (s) (nth s 2)))
+
+(define
+  hm-fresh-tv
+  (fn (counter)
+    (let ((n (first counter)))
+      (begin
+        (set-nth! counter 0 (+ n 1))
+        (hm-tv (str "t" (+ n 1)))))))
+
+(define
+  hm-ftv-acc
+  (fn (t acc)
+    (cond
+      ((is-var? t)
+        (if (some (fn (n) (= n (var-name t))) acc) acc (cons (var-name t) acc)))
+      ((is-ctor? t)
+        (let ((a acc))
+          (begin
+            (for-each (fn (x) (set! a (hm-ftv-acc x a))) (ctor-args t))
+            a)))
+      (:else acc))))
+
+(define hm-ftv (fn (t) (hm-ftv-acc t (list))))
+
+(define
+  hm-ftv-scheme
+  (fn (s)
+    (let ((qs (hm-scheme-vars s))
+          (all (hm-ftv (hm-scheme-type s))))
+      (filter (fn (n) (not (some (fn (q) (= q n)) qs))) all))))
+
+(define
+  hm-ftv-env
+  (fn (env)
+    (let ((acc (list)))
+      (begin
+        (for-each
+          (fn (k)
+            (for-each
+              (fn (n)
+                (when (not (some (fn (m) (= m n)) acc))
+                  (set! acc (cons n acc))))
+              (hm-ftv-scheme (get env k))))
+          (keys env))
+        acc))))
+
+(define hm-apply (fn (subst t) (walk* t subst)))
+
+(define
+  hm-apply-scheme
+  (fn (subst s)
+    (let ((qs (hm-scheme-vars s))
+          (d {}))
+      (begin
+        (for-each
+          (fn (k)
+            (when (not (some (fn (q) (= q k)) qs))
+              (dict-set! d k (get subst k))))
+          (keys subst))
+        (hm-scheme qs (walk* (hm-scheme-type s) d))))))
+
+(define
+  hm-apply-env
+  (fn (subst env)
+    (let ((d {}))
+      (begin
+        (for-each
+          (fn (k) (dict-set! d k (hm-apply-scheme subst (get env k))))
+          (keys env))
+        d))))
+
+(define
+  hm-compose
+  (fn (s2 s1)
+    (let ((d {}))
+      (begin
+        (for-each (fn (k) (dict-set! d k (walk* (get s1 k) s2))) (keys s1))
+        (for-each
+          (fn (k) (when (not (has-key? d k)) (dict-set! d k (get s2 k))))
+          (keys s2))
+        d))))
+
+(define
+  hm-generalize
+  (fn (t env)
+    (let ((tvars (hm-ftv t))
+          (evars (hm-ftv-env env)))
+      (let ((qs (filter (fn (n) (not (some (fn (m) (= m n)) evars))) tvars)))
+        (hm-scheme qs t)))))
+
+(define
+  hm-instantiate
+  (fn (s counter)
+    (let ((qs (hm-scheme-vars s))
+          (subst {}))
+      (begin
+        (for-each
+          (fn (q) (set! subst (assoc subst q (hm-fresh-tv counter))))
+          qs)
+        (walk* (hm-scheme-type s) subst)))))
+
+;; Literal inference — the only AST kind whose typing rule is closed
+;; in the kit. Lambda / app / let live in host code so the host's own
+;; AST conventions stay untouched.
+(define
+  hm-infer-literal
+  (fn (expr)
+    (let ((v (ast-literal-value expr)))
+      (cond
+        ((number? v)  {:subst {} :type (hm-int)})
+        ((string? v)  {:subst {} :type (hm-string)})
+        ((boolean? v) {:subst {} :type (hm-bool)})
+        (:else (error (str "hm-infer-literal: unknown kind: " v)))))))
--- a/lib/guest/layout.sx
+++ b/lib/guest/layout.sx
@@ -0,0 +1,145 @@
+;; lib/guest/layout.sx — configurable off-side / layout-sensitive lexer.
+;;
+;; Inserts virtual open / close / separator tokens based on indentation.
+;; Configurable enough to encode either the Haskell 98 layout rule (let /
+;; where / do / of opens a virtual brace at the next token's column) or
+;; a Python-ish indent / dedent rule (a colon at the end of a line opens
+;; a block at the next non-blank line's column).
+;;
+;; Token shape (input + output)
+;; ----------------------------
+;; Each token is a dict {:type :value :line :col …}. The kit reads
+;; only :type / :value / :line / :col and passes everything else
+;; through. The input stream MUST be free of newline filler tokens
+;; (preprocess them away with your tokenizer) — line breaks are detected
+;; by comparing :line of consecutive tokens.
+;;
+;; Config
+;; ------
+;;   :open-keywords    list of strings; a token whose :value matches
+;;                     opens a new layout block at the next token's
+;;                     column (Haskell: let/where/do/of).
+;;   :open-trailing-fn (fn (tok) -> bool) — alternative trigger that
+;;                     fires AFTER the token is emitted. Use for
+;;                     Python-style trailing `:`.
+;;   :open-token / :close-token / :sep-token
+;;                     templates {:type :value} merged with :line and
+;;                     :col when virtual tokens are emitted.
+;;   :explicit-open?   (fn (tok) -> bool) — if the next token after a
+;;                     trigger satisfies this, suppress virtual layout
+;;                     for that block (Haskell: `{`).
+;;   :module-prelude?  if true, wrap whole input in an implicit block
+;;                     at the first token's column (Haskell yes,
+;;                     Python no).
+;;
+;; Public entry
+;; ------------
+;;   (layout-pass cfg tokens) -> tokens with virtual layout inserted.
+
+(define
+  layout-mk-virtual
+  (fn (template line col)
+    (assoc (assoc template :line line) :col col)))
+
+(define
+  layout-is-open-kw?
+  (fn (tok open-kws)
+    (and (= (get tok :type) "reserved")
+         (some (fn (k) (= k (get tok :value))) open-kws))))
+
+(define
+  layout-pass
+  (fn (cfg tokens)
+    (let ((open-kws (get cfg :open-keywords))
+          (trailing-fn (get cfg :open-trailing-fn))
+          (open-tmpl (get cfg :open-token))
+          (close-tmpl (get cfg :close-token))
+          (sep-tmpl (get cfg :sep-token))
+          (mod-prelude? (get cfg :module-prelude?))
+          (expl?-fn (get cfg :explicit-open?))
+          (out (list))
+          (stack (list))
+          (n (len tokens))
+          (i 0)
+          (prev-line -1)
+          (pending-open false)
+          (just-opened false))
+      (define
+        emit-closes-while-greater
+        (fn (col line)
+          (when (and (not (empty? stack)) (> (first stack) col))
+            (do
+              (append! out (layout-mk-virtual close-tmpl line col))
+              (set! stack (rest stack))
+              (emit-closes-while-greater col line)))))
+      (define
+        emit-pending-open
+        (fn (line col)
+          (do
+            (append! out (layout-mk-virtual open-tmpl line col))
+            (set! stack (cons col stack))
+            (set! pending-open false)
+            (set! just-opened true))))
+      (define
+        layout-step
+        (fn ()
+          (when (< i n)
+            (let ((tok (nth tokens i)))
+              (let ((line (get tok :line)) (col (get tok :col)))
+                (cond
+                  (pending-open
+                    (cond
+                      ((and (not (= expl?-fn nil)) (expl?-fn tok))
+                        (do
+                          (set! pending-open false)
+                          (append! out tok)
+                          (set! prev-line line)
+                          (set! i (+ i 1))
+                          (layout-step)))
+                      (:else
+                        (do
+                          (emit-pending-open line col)
+                          (layout-step)))))
+                  (:else
+                    (let ((on-fresh-line? (and (> prev-line 0) (> line prev-line))))
+                      (do
+                        (when on-fresh-line?
+                          (let ((stack-before stack))
+                            (begin
+                              (emit-closes-while-greater col line)
+                              (when (and (not (empty? stack))
+                                         (= (first stack) col)
+                                         (not just-opened)
+                                         ;; suppress separator if a dedent fired
+                                         ;; — the dedent is itself the separator
+                                         (= (len stack) (len stack-before)))
+                                (append! out (layout-mk-virtual sep-tmpl line col))))))
+                        (set! just-opened false)
+                        (append! out tok)
+                        (set! prev-line line)
+                        (set! i (+ i 1))
+                        (cond
+                          ((layout-is-open-kw? tok open-kws)
+                            (set! pending-open true))
+                          ((and (not (= trailing-fn nil)) (trailing-fn tok))
+                            (set! pending-open true)))
+                        (layout-step))))))))))
+      (begin
+        ;; Module prelude: implicit layout block at the first token's column.
+        (when (and mod-prelude? (> n 0))
+          (let ((tok (nth tokens 0)))
+            (do
+              (append! out (layout-mk-virtual open-tmpl (get tok :line) (get tok :col)))
+              (set! stack (cons (get tok :col) stack))
+              (set! just-opened true))))
+        (layout-step)
+        ;; EOF: close every remaining block.
+        (define close-rest
+          (fn ()
+            (when (not (empty? stack))
+              (do
+                (append! out (layout-mk-virtual close-tmpl 0 0))
+                (set! stack (rest stack))
+                (close-rest)))))
+        (close-rest)
+        out))))
--- a/lib/guest/tests/hm.sx
+++ b/lib/guest/tests/hm.sx
@@ -0,0 +1,89 @@
+;; lib/guest/tests/hm.sx — exercises lib/guest/hm.sx algebra.
+
+(define ghm-test-pass 0)
+(define ghm-test-fail 0)
+(define ghm-test-fails (list))
+
+(define
+  ghm-test
+  (fn (name actual expected)
+    (if (= actual expected)
+      (set! ghm-test-pass (+ ghm-test-pass 1))
+      (begin
+        (set! ghm-test-fail (+ ghm-test-fail 1))
+        (append! ghm-test-fails {:name name :expected expected :actual actual})))))
+
+;; ── Type constructors ─────────────────────────────────────────────
+(ghm-test "tv"           (hm-tv "a") (list :var "a"))
+(ghm-test "int"          (hm-int)    (list :ctor "Int" (list)))
+(ghm-test "arrow"        (ctor-head (hm-arrow (hm-int) (hm-bool))) "->")
+(ghm-test "arrow-args-len" (len (ctor-args (hm-arrow (hm-int) (hm-bool)))) 2)
+
+;; ── Schemes ───────────────────────────────────────────────────────
+(ghm-test "scheme-vars"  (hm-scheme-vars (hm-scheme (list "a") (hm-tv "a"))) (list "a"))
+(ghm-test "monotype-vars" (hm-scheme-vars (hm-monotype (hm-int))) (list))
+(ghm-test "scheme?-yes"  (hm-scheme? (hm-monotype (hm-int))) true)
+(ghm-test "scheme?-no"   (hm-scheme? (hm-int)) false)
+
+;; ── Fresh tyvars ──────────────────────────────────────────────────
+(ghm-test "fresh-1"
+  (let ((c (list 0))) (var-name (hm-fresh-tv c))) "t1")
+(ghm-test "fresh-bumps"
+  (let ((c (list 5))) (begin (hm-fresh-tv c) (first c))) 6)
+
+;; ── Free type variables ──────────────────────────────────────────
+(ghm-test "ftv-int"      (hm-ftv (hm-int)) (list))
+(ghm-test "ftv-tv"       (hm-ftv (hm-tv "a")) (list "a"))
+(ghm-test "ftv-arrow"
+  (len (hm-ftv (hm-arrow (hm-tv "a") (hm-arrow (hm-tv "b") (hm-tv "a"))))) 2)
+(ghm-test "ftv-scheme-quantified"
+  (hm-ftv-scheme (hm-scheme (list "a") (hm-arrow (hm-tv "a") (hm-tv "b")))) (list "b"))
+(ghm-test "ftv-env"
+  (let ((env (assoc {} "f" (hm-monotype (hm-arrow (hm-tv "x") (hm-tv "y"))))))
+    (len (hm-ftv-env env))) 2)
+
+;; ── Substitution / apply / compose ───────────────────────────────
+(ghm-test "apply-tv"
+  (hm-apply (assoc {} "a" (hm-int)) (hm-tv "a")) (hm-int))
+(ghm-test "apply-arrow"
+  (ctor-head
+    (hm-apply (assoc {} "a" (hm-int))
+              (hm-arrow (hm-tv "a") (hm-tv "b")))) "->")
+(ghm-test "compose-1-then-2"
+  (var-name
+    (hm-apply
+      (hm-compose (assoc {} "b" (hm-tv "c")) (assoc {} "a" (hm-tv "b")))
+      (hm-tv "a"))) "c")
+
+;; ── Generalize / Instantiate ─────────────────────────────────────
+;;   forall a. a -> a   instantiated twice yields fresh vars each time
+(ghm-test "generalize-id"
+  (len (hm-scheme-vars (hm-generalize (hm-arrow (hm-tv "a") (hm-tv "a")) {}))) 1)
+
+(ghm-test "generalize-skips-env"
+  ;; ftv(t)={a,b}, ftv(env)={a}, qs={b}
+  (let ((env (assoc {} "x" (hm-monotype (hm-tv "a")))))
+    (len (hm-scheme-vars
+           (hm-generalize (hm-arrow (hm-tv "a") (hm-tv "b")) env)))) 1)
+
+(ghm-test "instantiate-fresh"
+  (let ((s (hm-scheme (list "a") (hm-arrow (hm-tv "a") (hm-tv "a"))))
+        (c (list 0)))
+    (let ((t1 (hm-instantiate s c)) (t2 (hm-instantiate s c)))
+      (not (= (var-name (first (ctor-args t1)))
+              (var-name (first (ctor-args t2)))))))
+  true)
+
+;; ── Inference (literal only) ─────────────────────────────────────
+(ghm-test "infer-int"
+  (ctor-head (get (hm-infer-literal (ast-literal 42)) :type)) "Int")
+(ghm-test "infer-string"
+  (ctor-head (get (hm-infer-literal (ast-literal "hi")) :type)) "String")
+(ghm-test "infer-bool"
+  (ctor-head (get (hm-infer-literal (ast-literal true)) :type)) "Bool")
+
+(define ghm-tests-run!
+  (fn ()
+    {:passed ghm-test-pass
+     :failed ghm-test-fail
+     :total  (+ ghm-test-pass ghm-test-fail)}))
--- a/lib/guest/tests/layout.sx
+++ b/lib/guest/tests/layout.sx
@@ -0,0 +1,180 @@
+;; lib/guest/tests/layout.sx — synthetic Python-ish off-side fixture.
+;;
+;; Exercises lib/guest/layout.sx with a config different from Haskell's
+;; (no module-prelude, layout opens via trailing `:` not via reserved
+;; keyword) to prove the kit isn't Haskell-shaped.
+
+(define glayout-test-pass 0)
+(define glayout-test-fail 0)
+(define glayout-test-fails (list))
+
+(define
+  glayout-test
+  (fn (name actual expected)
+    (if (= actual expected)
+      (set! glayout-test-pass (+ glayout-test-pass 1))
+      (begin
+        (set! glayout-test-fail (+ glayout-test-fail 1))
+        (append! glayout-test-fails {:name name :expected expected :actual actual})))))
+
+;; Convenience: build a token from {type value line col}.
+(define
+  glayout-tok
+  (fn (ty val line col)
+    {:type ty :value val :line line :col col}))
+
+;; Project a token list to ((type value) ...) for compact comparison.
+(define
+  glayout-shape
+  (fn (toks)
+    (map (fn (t) (list (get t :type) (get t :value))) toks)))
+
+;; ── Haskell-flavour: keyword opens block ─────────────────────────
+(define
+  glayout-haskell-cfg
+  {:open-keywords (list "let" "where" "do" "of")
+   :open-trailing-fn nil
+   :open-token   {:type "vlbrace" :value "{"}
+   :close-token  {:type "vrbrace" :value "}"}
+   :sep-token    {:type "vsemi"   :value ";"}
+   :module-prelude? false
+   :explicit-open? (fn (tok) (= (get tok :type) "lbrace"))})
+
+;;   do
+;;     a
+;;     b
+;;   c       ← outside the do-block
+(glayout-test "haskell-do-block"
+  (glayout-shape
+    (layout-pass
+      glayout-haskell-cfg
+      (list (glayout-tok "reserved" "do" 1 1)
+            (glayout-tok "ident" "a" 2 3)
+            (glayout-tok "ident" "b" 3 3)
+            (glayout-tok "ident" "c" 4 1))))
+  (list (list "reserved" "do")
+        (list "vlbrace" "{")
+        (list "ident" "a")
+        (list "vsemi" ";")
+        (list "ident" "b")
+        (list "vrbrace" "}")
+        (list "ident" "c")))
+
+;; Explicit `{` after `do` suppresses virtual layout.
+(glayout-test "haskell-explicit-brace"
+  (glayout-shape
+    (layout-pass
+      glayout-haskell-cfg
+      (list (glayout-tok "reserved" "do" 1 1)
+            (glayout-tok "lbrace" "{" 1 4)
+            (glayout-tok "ident" "a" 1 6)
+            (glayout-tok "rbrace" "}" 1 8))))
+  (list (list "reserved" "do")
+        (list "lbrace" "{")
+        (list "ident" "a")
+        (list "rbrace" "}")))
+
+;; Single-statement do-block on the same line.
+(glayout-test "haskell-do-inline"
+  (glayout-shape
+    (layout-pass
+      glayout-haskell-cfg
+      (list (glayout-tok "reserved" "do" 1 1)
+            (glayout-tok "ident" "a" 1 4))))
+  (list (list "reserved" "do")
+        (list "vlbrace" "{")
+        (list "ident" "a")
+        (list "vrbrace" "}")))
+
+;; Module-prelude: wrap whole input in implicit layout block at first
+;; tok's column.
+(glayout-test "haskell-module-prelude"
+  (glayout-shape
+    (layout-pass
+      (assoc glayout-haskell-cfg :module-prelude? true)
+      (list (glayout-tok "ident" "x" 1 1)
+            (glayout-tok "ident" "y" 2 1)
+            (glayout-tok "ident" "z" 3 1))))
+  (list (list "vlbrace" "{")
+        (list "ident" "x")
+        (list "vsemi" ";")
+        (list "ident" "y")
+        (list "vsemi" ";")
+        (list "ident" "z")
+        (list "vrbrace" "}")))
+
+;; ── Python-flavour: trailing `:` opens block ─────────────────────
+(define
+  glayout-python-cfg
+  {:open-keywords (list)
+   :open-trailing-fn (fn (tok) (and (= (get tok :type) "punct")
+                                    (= (get tok :value) ":")))
+   :open-token   {:type "indent" :value "INDENT"}
+   :close-token  {:type "dedent" :value "DEDENT"}
+   :sep-token    {:type "newline" :value "NEWLINE"}
+   :module-prelude? false
+   :explicit-open? nil})
+
+;;   if x:
+;;       a
+;;       b
+;;   c
+(glayout-test "python-if-block"
+  (glayout-shape
+    (layout-pass
+      glayout-python-cfg
+      (list (glayout-tok "reserved" "if" 1 1)
+            (glayout-tok "ident" "x" 1 4)
+            (glayout-tok "punct" ":" 1 5)
+            (glayout-tok "ident" "a" 2 5)
+            (glayout-tok "ident" "b" 3 5)
+            (glayout-tok "ident" "c" 4 1))))
+  (list (list "reserved" "if")
+        (list "ident" "x")
+        (list "punct" ":")
+        (list "indent" "INDENT")
+        (list "ident" "a")
+        (list "newline" "NEWLINE")
+        (list "ident" "b")
+        (list "dedent" "DEDENT")
+        (list "ident" "c")))
+
+;; Nested Python-style blocks.
+;;   def f():
+;;       if x:
+;;           a
+;;       b
+(glayout-test "python-nested"
+  (glayout-shape
+    (layout-pass
+      glayout-python-cfg
+      (list (glayout-tok "reserved" "def" 1 1)
+            (glayout-tok "ident" "f" 1 5)
+            (glayout-tok "punct" "(" 1 6)
+            (glayout-tok "punct" ")" 1 7)
+            (glayout-tok "punct" ":" 1 8)
+            (glayout-tok "reserved" "if" 2 5)
+            (glayout-tok "ident" "x" 2 8)
+            (glayout-tok "punct" ":" 2 9)
+            (glayout-tok "ident" "a" 3 9)
+            (glayout-tok "ident" "b" 4 5))))
+  (list (list "reserved" "def")
+        (list "ident" "f")
+        (list "punct" "(")
+        (list "punct" ")")
+        (list "punct" ":")
+        (list "indent" "INDENT")
+        (list "reserved" "if")
+        (list "ident" "x")
+        (list "punct" ":")
+        (list "indent" "INDENT")
+        (list "ident" "a")
+        (list "dedent" "DEDENT")
+        (list "ident" "b")
+        (list "dedent" "DEDENT")))
+
+(define glayout-tests-run!
+  (fn ()
+    {:passed glayout-test-pass
+     :failed glayout-test-fail
+     :total  (+ glayout-test-pass glayout-test-fail)}))
--- a/lib/haskell/conformance.conf
+++ b/lib/haskell/conformance.conf
@@ -14,6 +14,8 @@ PRELOADS=(
  lib/haskell/runtime.sx
  lib/haskell/match.sx
  lib/haskell/eval.sx
+  lib/haskell/map.sx
+  lib/haskell/set.sx
  lib/haskell/testlib.sx
 )

@@ -36,6 +38,24 @@ SUITES=(
  "matrix:lib/haskell/tests/program-matrix.sx"
  "wordcount:lib/haskell/tests/program-wordcount.sx"
  "powers:lib/haskell/tests/program-powers.sx"
+  "caesar:lib/haskell/tests/program-caesar.sx"
+  "runlength-str:lib/haskell/tests/program-runlength-str.sx"
+  "showadt:lib/haskell/tests/program-showadt.sx"
+  "showio:lib/haskell/tests/program-showio.sx"
+  "partial:lib/haskell/tests/program-partial.sx"
+  "statistics:lib/haskell/tests/program-statistics.sx"
+  "newton:lib/haskell/tests/program-newton.sx"
+  "wordfreq:lib/haskell/tests/program-wordfreq.sx"
+  "mapgraph:lib/haskell/tests/program-mapgraph.sx"
+  "uniquewords:lib/haskell/tests/program-uniquewords.sx"
+  "setops:lib/haskell/tests/program-setops.sx"
+  "shapes:lib/haskell/tests/program-shapes.sx"
+  "person:lib/haskell/tests/program-person.sx"
+  "config:lib/haskell/tests/program-config.sx"
+  "counter:lib/haskell/tests/program-counter.sx"
+  "accumulate:lib/haskell/tests/program-accumulate.sx"
+  "safediv:lib/haskell/tests/program-safediv.sx"
+  "trycatch:lib/haskell/tests/program-trycatch.sx"
 )

 emit_scoreboard_json() {
--- a/lib/haskell/desugar.sx
+++ b/lib/haskell/desugar.sx
@@ -131,119 +131,281 @@
        (let
          ((tag (first node)))
          (cond
-            ;; Transformations
            ((= tag "where")
              (list
-                :let
-                (map hk-desugar (nth node 2))
+                :let (map hk-desugar (nth node 2))
                (hk-desugar (nth node 1))))
            ((= tag "guarded") (hk-guards-to-if (nth node 1)))
            ((= tag "list-comp")
-              (hk-lc-desugar
-                (hk-desugar (nth node 1))
-                (nth node 2)))
-
-            ;; Expression nodes
+              (hk-lc-desugar (hk-desugar (nth node 1)) (nth node 2)))
            ((= tag "app")
              (list
-                :app
-                (hk-desugar (nth node 1))
+                :app (hk-desugar (nth node 1))
                (hk-desugar (nth node 2))))
+            ((= tag "p-rec")
+              (let
+                ((cname (nth node 1))
+                  (field-pats (nth node 2))
+                  (field-order (hk-record-field-names cname)))
+                (cond
+                  ((nil? field-order)
+                    (raise (str "p-rec: no record info for " cname)))
+                  (:else
+                    (list
+                      :p-con
+                      cname
+                      (map
+                        (fn
+                          (fname)
+                          (let
+                            ((p (hk-find-rec-pair field-pats fname)))
+                            (cond
+                              ((nil? p) (list :p-wild))
+                              (:else (hk-desugar (nth p 1))))))
+                        field-order))))))
+            ((= tag "rec-update")
+              (list
+                :rec-update
+                (hk-desugar (nth node 1))
+                (map
+                  (fn (p) (list (first p) (hk-desugar (nth p 1))))
+                  (nth node 2))))
+            ((= tag "rec-create")
+              (let
+                ((cname (nth node 1))
+                  (field-pairs (nth node 2))
+                  (field-order (hk-record-field-names cname)))
+                (cond
+                  ((nil? field-order)
+                    (raise (str "rec-create: no record info for " cname)))
+                  (:else
+                    (let
+                      ((acc (list :con cname)))
+                      (begin
+                        (for-each
+                          (fn
+                            (fname)
+                            (let
+                              ((pair
+                                  (hk-find-rec-pair field-pairs fname)))
+                              (cond
+                                ((nil? pair)
+                                  (raise
+                                    (str
+                                      "rec-create: missing field "
+                                      fname
+                                      " for "
+                                      cname)))
+                                (:else
+                                  (set!
+                                    acc
+                                    (list
+                                      :app
+                                      acc
+                                      (hk-desugar (nth pair 1))))))))
+                          field-order)
+                        acc))))))
            ((= tag "op")
              (list
-                :op
-                (nth node 1)
+                :op (nth node 1)
                (hk-desugar (nth node 2))
                (hk-desugar (nth node 3))))
+            ((= tag "type-ann") (hk-desugar (nth node 1)))
            ((= tag "neg") (list :neg (hk-desugar (nth node 1))))
            ((= tag "if")
              (list
-                :if
-                (hk-desugar (nth node 1))
+                :if (hk-desugar (nth node 1))
                (hk-desugar (nth node 2))
                (hk-desugar (nth node 3))))
-            ((= tag "tuple")
-              (list :tuple (map hk-desugar (nth node 1))))
-            ((= tag "list")
-              (list :list (map hk-desugar (nth node 1))))
+            ((= tag "tuple") (list :tuple (map hk-desugar (nth node 1))))
+            ((= tag "list") (list :list (map hk-desugar (nth node 1))))
            ((= tag "range")
              (list
-                :range
-                (hk-desugar (nth node 1))
+                :range (hk-desugar (nth node 1))
                (hk-desugar (nth node 2))))
            ((= tag "range-step")
              (list
-                :range-step
-                (hk-desugar (nth node 1))
+                :range-step (hk-desugar (nth node 1))
                (hk-desugar (nth node 2))
                (hk-desugar (nth node 3))))
            ((= tag "lambda")
-              (list
-                :lambda
-                (nth node 1)
-                (hk-desugar (nth node 2))))
+              (list :lambda (nth node 1) (hk-desugar (nth node 2))))
            ((= tag "let")
              (list
-                :let
-                (map hk-desugar (nth node 1))
+                :let (map hk-desugar (nth node 1))
                (hk-desugar (nth node 2))))
            ((= tag "case")
              (list
-                :case
-                (hk-desugar (nth node 1))
+                :case (hk-desugar (nth node 1))
                (map hk-desugar (nth node 2))))
            ((= tag "alt")
-              (list :alt (nth node 1) (hk-desugar (nth node 2))))
+              (list :alt (hk-desugar (nth node 1)) (hk-desugar (nth node 2))))
            ((= tag "do") (hk-desugar-do (nth node 1)))
            ((= tag "sect-left")
-              (list
-                :sect-left
-                (nth node 1)
-                (hk-desugar (nth node 2))))
+              (list :sect-left (nth node 1) (hk-desugar (nth node 2))))
            ((= tag "sect-right")
-              (list
-                :sect-right
-                (nth node 1)
-                (hk-desugar (nth node 2))))
-
-            ;; Top-level
+              (list :sect-right (nth node 1) (hk-desugar (nth node 2))))
            ((= tag "program")
-              (list :program (map hk-desugar (nth node 1))))
+              (list :program (map hk-desugar (hk-expand-records (nth node 1)))))
            ((= tag "module")
              (list
-                :module
-                (nth node 1)
+                :module (nth node 1)
                (nth node 2)
                (nth node 3)
-                (map hk-desugar (nth node 4))))
-
-            ;; Decls carrying a body
+                (map hk-desugar (hk-expand-records (nth node 4)))))
            ((= tag "fun-clause")
              (list
-                :fun-clause
-                (nth node 1)
-                (nth node 2)
+                :fun-clause (nth node 1)
+                (map hk-desugar (nth node 2))
                (hk-desugar (nth node 3))))
+            ((= tag "instance-decl")
+              (list
+                :instance-decl (nth node 1)
+                (nth node 2)
+                (map hk-desugar (nth node 3))))
            ((= tag "pat-bind")
-              (list
-                :pat-bind
-                (nth node 1)
-                (hk-desugar (nth node 2))))
+              (list :pat-bind (nth node 1) (hk-desugar (nth node 2))))
            ((= tag "bind")
-              (list
-                :bind
-                (nth node 1)
-                (hk-desugar (nth node 2))))
-
-            ;; Everything else: leaf literals, vars, cons, patterns,
-            ;; types, imports, type-sigs, data / newtype / fixity, …
+              (list :bind (nth node 1) (hk-desugar (nth node 2))))
            (:else node)))))))

 ;; Convenience — tokenize + layout + parse + desugar.
-(define
-  hk-core
-  (fn (src) (hk-desugar (hk-parse-top src))))
+(define hk-record-fields (dict))

 (define
-  hk-core-expr
-  (fn (src) (hk-desugar (hk-parse src))))
+  hk-register-record-fields!
+  (fn (cname fields) (dict-set! hk-record-fields cname fields)))
+
+(define
+  hk-record-field-names
+  (fn
+    (cname)
+    (if (has-key? hk-record-fields cname) (get hk-record-fields cname) nil)))
+
+(define
+  hk-record-field-index
+  (fn
+    (cname fname)
+    (let
+      ((fields (hk-record-field-names cname)))
+      (cond
+        ((nil? fields) -1)
+        (:else
+          (let
+            ((i 0) (idx -1))
+            (begin
+              (for-each
+                (fn
+                  (f)
+                  (begin (when (= f fname) (set! idx i)) (set! i (+ i 1))))
+                fields)
+              idx)))))))
+
+(define
+  hk-find-rec-pair
+  (fn
+    (pairs name)
+    (cond
+      ((empty? pairs) nil)
+      ((= (first (first pairs)) name) (first pairs))
+      (:else (hk-find-rec-pair (rest pairs) name)))))
+
+(define
+  hk-record-accessors
+  (fn
+    (cname rec-fields)
+    (let
+      ((n (len rec-fields)) (i 0) (out (list)))
+      (define
+        hk-ra-loop
+        (fn
+          ()
+          (when
+            (< i n)
+            (let
+              ((field (nth rec-fields i)))
+              (let
+                ((fname (first field)) (j 0) (pats (list)))
+                (define
+                  hk-pat-loop
+                  (fn
+                    ()
+                    (when
+                      (< j n)
+                      (begin
+                        (append!
+                          pats
+                          (if
+                            (= j i)
+                            (list "p-var" "__rec_field")
+                            (list "p-wild")))
+                        (set! j (+ j 1))
+                        (hk-pat-loop)))))
+                (hk-pat-loop)
+                (append!
+                  out
+                  (list
+                    "fun-clause"
+                    fname
+                    (list (list "p-con" cname pats))
+                    (list "var" "__rec_field")))
+                (set! i (+ i 1))
+                (hk-ra-loop))))))
+      (hk-ra-loop)
+      out)))
+
+(define
+  hk-expand-records
+  (fn
+    (decls)
+    (let
+      ((out (list)))
+      (for-each
+        (fn
+          (d)
+          (cond
+            ((and (list? d) (= (first d) "data"))
+              (let
+                ((dname (nth d 1))
+                  (tvars (nth d 2))
+                  (cons-list (nth d 3))
+                  (deriving (if (> (len d) 4) (nth d 4) (list)))
+                  (new-cons (list))
+                  (accessors (list)))
+                (begin
+                  (for-each
+                    (fn
+                      (c)
+                      (cond
+                        ((= (first c) "con-rec")
+                          (let
+                            ((cname (nth c 1)) (rec-fields (nth c 2)))
+                            (begin
+                              (hk-register-record-fields!
+                                cname
+                                (map (fn (f) (first f)) rec-fields))
+                              (append!
+                                new-cons
+                                (list
+                                  "con-def"
+                                  cname
+                                  (map (fn (f) (nth f 1)) rec-fields)))
+                              (for-each
+                                (fn (a) (append! accessors a))
+                                (hk-record-accessors cname rec-fields)))))
+                        (:else (append! new-cons c))))
+                    cons-list)
+                  (append!
+                    out
+                    (if
+                      (empty? deriving)
+                      (list "data" dname tvars new-cons)
+                      (list "data" dname tvars new-cons deriving)))
+                  (for-each (fn (a) (append! out a)) accessors))))
+            (:else (append! out d))))
+        decls)
+      out)))
+
+(define hk-core (fn (src) (hk-desugar (hk-parse-top src))))
+
+(define hk-core-expr (fn (src) (hk-desugar (hk-parse src))))
--- a/lib/haskell/eval.sx
+++ b/lib/haskell/eval.sx
--- a/lib/haskell/map.sx
+++ b/lib/haskell/map.sx
@@ -0,0 +1,520 @@
+;; map.sx — Phase 11 Data.Map: weight-balanced BST in pure SX.
+;;
+;; Algorithm: Adams's weight-balanced tree (the same family as Haskell's
+;; Data.Map). Each node tracks its size; rotations maintain the invariant
+;;
+;;     size(small-side) * delta >= size(large-side)        (delta = 3)
+;;
+;; with single or double rotations chosen by the gamma ratio (gamma = 2).
+;; The size field is an Int and is included so `size`, `lookup`, etc. are
+;; O(log n) on both extremes of the tree.
+;;
+;; Representation:
+;;   Empty → ("Map-Empty")
+;;   Node  → ("Map-Node" key val left right size)
+;;
+;; All operations are pure SX — no mutation of nodes once constructed.
+;; The user-facing Haskell layer (Phase 11 next iteration) wraps these
+;; for `import Data.Map as Map`.
+
+;; ── Constructors ────────────────────────────────────────────
+(define hk-map-empty (list "Map-Empty"))
+
+(define
+  hk-map-node
+  (fn
+    (k v l r)
+    (list "Map-Node" k v l r (+ 1 (+ (hk-map-size l) (hk-map-size r))))))
+
+;; ── Predicates and accessors ────────────────────────────────
+(define hk-map-empty? (fn (m) (and (list? m) (= (first m) "Map-Empty"))))
+
+(define hk-map-node? (fn (m) (and (list? m) (= (first m) "Map-Node"))))
+
+(define
+  hk-map-size
+  (fn (m) (cond ((hk-map-empty? m) 0) (:else (nth m 5)))))
+
+(define hk-map-key (fn (m) (nth m 1)))
+(define hk-map-val (fn (m) (nth m 2)))
+(define hk-map-left (fn (m) (nth m 3)))
+(define hk-map-right (fn (m) (nth m 4)))
+
+;; ── Weight-balanced rotations ───────────────────────────────
+;; delta and gamma per Adams 1992 / Haskell Data.Map.
+
+(define hk-map-delta 3)
+(define hk-map-gamma 2)
+
+(define
+  hk-map-single-l
+  (fn
+    (k v l r)
+    (let
+      ((rk (hk-map-key r))
+        (rv (hk-map-val r))
+        (rl (hk-map-left r))
+        (rr (hk-map-right r)))
+      (hk-map-node rk rv (hk-map-node k v l rl) rr))))
+
+(define
+  hk-map-single-r
+  (fn
+    (k v l r)
+    (let
+      ((lk (hk-map-key l))
+        (lv (hk-map-val l))
+        (ll (hk-map-left l))
+        (lr (hk-map-right l)))
+      (hk-map-node lk lv ll (hk-map-node k v lr r)))))
+
+(define
+  hk-map-double-l
+  (fn
+    (k v l r)
+    (let
+      ((rk (hk-map-key r))
+        (rv (hk-map-val r))
+        (rl (hk-map-left r))
+        (rr (hk-map-right r))
+        (rlk (hk-map-key (hk-map-left r)))
+        (rlv (hk-map-val (hk-map-left r)))
+        (rll (hk-map-left (hk-map-left r)))
+        (rlr (hk-map-right (hk-map-left r))))
+      (hk-map-node
+        rlk
+        rlv
+        (hk-map-node k v l rll)
+        (hk-map-node rk rv rlr rr)))))
+
+(define
+  hk-map-double-r
+  (fn
+    (k v l r)
+    (let
+      ((lk (hk-map-key l))
+        (lv (hk-map-val l))
+        (ll (hk-map-left l))
+        (lr (hk-map-right l))
+        (lrk (hk-map-key (hk-map-right l)))
+        (lrv (hk-map-val (hk-map-right l)))
+        (lrl (hk-map-left (hk-map-right l)))
+        (lrr (hk-map-right (hk-map-right l))))
+      (hk-map-node
+        lrk
+        lrv
+        (hk-map-node lk lv ll lrl)
+        (hk-map-node k v lrr r)))))
+
+;; ── Balanced node constructor ──────────────────────────────
+;; Use this in place of hk-map-node when one side may have grown
+;; or shrunk by one and we need to restore the weight invariant.
+(define
+  hk-map-balance
+  (fn
+    (k v l r)
+    (let
+      ((sl (hk-map-size l)) (sr (hk-map-size r)))
+      (cond
+        ((<= (+ sl sr) 1) (hk-map-node k v l r))
+        ((> sr (* hk-map-delta sl))
+          (let
+            ((rl (hk-map-left r)) (rr (hk-map-right r)))
+            (cond
+              ((< (hk-map-size rl) (* hk-map-gamma (hk-map-size rr)))
+                (hk-map-single-l k v l r))
+              (:else (hk-map-double-l k v l r)))))
+        ((> sl (* hk-map-delta sr))
+          (let
+            ((ll (hk-map-left l)) (lr (hk-map-right l)))
+            (cond
+              ((< (hk-map-size lr) (* hk-map-gamma (hk-map-size ll)))
+                (hk-map-single-r k v l r))
+              (:else (hk-map-double-r k v l r)))))
+        (:else (hk-map-node k v l r))))))
+
+(define
+  hk-map-singleton
+  (fn (k v) (hk-map-node k v hk-map-empty hk-map-empty)))
+
+(define
+  hk-map-insert
+  (fn
+    (k v m)
+    (cond
+      ((hk-map-empty? m) (hk-map-singleton k v))
+      (:else
+        (let
+          ((mk (hk-map-key m)))
+          (cond
+            ((< k mk)
+              (hk-map-balance
+                mk
+                (hk-map-val m)
+                (hk-map-insert k v (hk-map-left m))
+                (hk-map-right m)))
+            ((> k mk)
+              (hk-map-balance
+                mk
+                (hk-map-val m)
+                (hk-map-left m)
+                (hk-map-insert k v (hk-map-right m))))
+            (:else (hk-map-node k v (hk-map-left m) (hk-map-right m)))))))))
+
+(define
+  hk-map-lookup
+  (fn
+    (k m)
+    (cond
+      ((hk-map-empty? m) (list "Nothing"))
+      (:else
+        (let
+          ((mk (hk-map-key m)))
+          (cond
+            ((< k mk) (hk-map-lookup k (hk-map-left m)))
+            ((> k mk) (hk-map-lookup k (hk-map-right m)))
+            (:else (list "Just" (hk-map-val m)))))))))
+
+(define
+  hk-map-member
+  (fn
+    (k m)
+    (cond
+      ((hk-map-empty? m) false)
+      (:else
+        (let
+          ((mk (hk-map-key m)))
+          (cond
+            ((< k mk) (hk-map-member k (hk-map-left m)))
+            ((> k mk) (hk-map-member k (hk-map-right m)))
+            (:else true)))))))
+
+(define hk-map-null hk-map-empty?)
+
+(define
+  hk-map-find-min
+  (fn
+    (m)
+    (cond
+      ((hk-map-empty? (hk-map-left m))
+        (list (hk-map-key m) (hk-map-val m)))
+      (:else (hk-map-find-min (hk-map-left m))))))
+
+(define
+  hk-map-delete-min
+  (fn
+    (m)
+    (cond
+      ((hk-map-empty? (hk-map-left m)) (hk-map-right m))
+      (:else
+        (hk-map-balance
+          (hk-map-key m)
+          (hk-map-val m)
+          (hk-map-delete-min (hk-map-left m))
+          (hk-map-right m))))))
+
+(define
+  hk-map-find-max
+  (fn
+    (m)
+    (cond
+      ((hk-map-empty? (hk-map-right m))
+        (list (hk-map-key m) (hk-map-val m)))
+      (:else (hk-map-find-max (hk-map-right m))))))
+
+(define
+  hk-map-delete-max
+  (fn
+    (m)
+    (cond
+      ((hk-map-empty? (hk-map-right m)) (hk-map-left m))
+      (:else
+        (hk-map-balance
+          (hk-map-key m)
+          (hk-map-val m)
+          (hk-map-left m)
+          (hk-map-delete-max (hk-map-right m)))))))
+
+(define
+  hk-map-glue
+  (fn
+    (l r)
+    (cond
+      ((hk-map-empty? l) r)
+      ((hk-map-empty? r) l)
+      ((> (hk-map-size l) (hk-map-size r))
+        (let
+          ((mp (hk-map-find-max l)))
+          (hk-map-balance (first mp) (nth mp 1) (hk-map-delete-max l) r)))
+      (:else
+        (let
+          ((mp (hk-map-find-min r)))
+          (hk-map-balance (first mp) (nth mp 1) l (hk-map-delete-min r)))))))
+
+(define
+  hk-map-delete
+  (fn
+    (k m)
+    (cond
+      ((hk-map-empty? m) m)
+      (:else
+        (let
+          ((mk (hk-map-key m)))
+          (cond
+            ((< k mk)
+              (hk-map-balance
+                mk
+                (hk-map-val m)
+                (hk-map-delete k (hk-map-left m))
+                (hk-map-right m)))
+            ((> k mk)
+              (hk-map-balance
+                mk
+                (hk-map-val m)
+                (hk-map-left m)
+                (hk-map-delete k (hk-map-right m))))
+            (:else (hk-map-glue (hk-map-left m) (hk-map-right m)))))))))
+
+(define
+  hk-map-from-list
+  (fn
+    (pairs)
+    (reduce
+      (fn (acc p) (hk-map-insert (first p) (nth p 1) acc))
+      hk-map-empty
+      pairs)))
+
+(define
+  hk-map-to-asc-list
+  (fn
+    (m)
+    (cond
+      ((hk-map-empty? m) (list))
+      (:else
+        (append
+          (hk-map-to-asc-list (hk-map-left m))
+          (cons
+            (list (hk-map-key m) (hk-map-val m))
+            (hk-map-to-asc-list (hk-map-right m))))))))
+
+(define hk-map-to-list hk-map-to-asc-list)
+
+(define
+  hk-map-keys
+  (fn
+    (m)
+    (cond
+      ((hk-map-empty? m) (list))
+      (:else
+        (append
+          (hk-map-keys (hk-map-left m))
+          (cons (hk-map-key m) (hk-map-keys (hk-map-right m))))))))
+
+(define
+  hk-map-elems
+  (fn
+    (m)
+    (cond
+      ((hk-map-empty? m) (list))
+      (:else
+        (append
+          (hk-map-elems (hk-map-left m))
+          (cons (hk-map-val m) (hk-map-elems (hk-map-right m))))))))
+
+(define
+  hk-map-union-with
+  (fn
+    (f m1 m2)
+    (reduce
+      (fn
+        (acc p)
+        (let
+          ((k (first p)) (v (nth p 1)))
+          (let
+            ((look (hk-map-lookup k acc)))
+            (cond
+              ((= (first look) "Just")
+                (hk-map-insert k (f (nth look 1) v) acc))
+              (:else (hk-map-insert k v acc))))))
+      m1
+      (hk-map-to-asc-list m2))))
+
+(define
+  hk-map-intersection-with
+  (fn
+    (f m1 m2)
+    (reduce
+      (fn
+        (acc p)
+        (let
+          ((k (first p)) (v1 (nth p 1)))
+          (let
+            ((look (hk-map-lookup k m2)))
+            (cond
+              ((= (first look) "Just")
+                (hk-map-insert k (f v1 (nth look 1)) acc))
+              (:else acc)))))
+      hk-map-empty
+      (hk-map-to-asc-list m1))))
+
+(define
+  hk-map-difference
+  (fn
+    (m1 m2)
+    (reduce
+      (fn
+        (acc p)
+        (let
+          ((k (first p)) (v (nth p 1)))
+          (cond ((hk-map-member k m2) acc) (:else (hk-map-insert k v acc)))))
+      hk-map-empty
+      (hk-map-to-asc-list m1))))
+
+(define
+  hk-map-foldl-with-key
+  (fn
+    (f acc m)
+    (cond
+      ((hk-map-empty? m) acc)
+      (:else
+        (let
+          ((acc1 (hk-map-foldl-with-key f acc (hk-map-left m))))
+          (let
+            ((acc2 (f acc1 (hk-map-key m) (hk-map-val m))))
+            (hk-map-foldl-with-key f acc2 (hk-map-right m))))))))
+
+(define
+  hk-map-foldr-with-key
+  (fn
+    (f acc m)
+    (cond
+      ((hk-map-empty? m) acc)
+      (:else
+        (let
+          ((acc1 (hk-map-foldr-with-key f acc (hk-map-right m))))
+          (let
+            ((acc2 (f (hk-map-key m) (hk-map-val m) acc1)))
+            (hk-map-foldr-with-key f acc2 (hk-map-left m))))))))
+
+(define
+  hk-map-map-with-key
+  (fn
+    (f m)
+    (cond
+      ((hk-map-empty? m) m)
+      (:else
+        (list
+          "Map-Node"
+          (hk-map-key m)
+          (f (hk-map-key m) (hk-map-val m))
+          (hk-map-map-with-key f (hk-map-left m))
+          (hk-map-map-with-key f (hk-map-right m))
+          (hk-map-size m))))))
+
+(define
+  hk-map-filter-with-key
+  (fn
+    (p m)
+    (hk-map-foldr-with-key
+      (fn (k v acc) (cond ((p k v) (hk-map-insert k v acc)) (:else acc)))
+      hk-map-empty
+      m)))
+
+(define
+  hk-map-adjust
+  (fn
+    (f k m)
+    (cond
+      ((hk-map-empty? m) m)
+      (:else
+        (let
+          ((mk (hk-map-key m)))
+          (cond
+            ((< k mk)
+              (hk-map-node
+                mk
+                (hk-map-val m)
+                (hk-map-adjust f k (hk-map-left m))
+                (hk-map-right m)))
+            ((> k mk)
+              (hk-map-node
+                mk
+                (hk-map-val m)
+                (hk-map-left m)
+                (hk-map-adjust f k (hk-map-right m))))
+            (:else
+              (hk-map-node
+                mk
+                (f (hk-map-val m))
+                (hk-map-left m)
+                (hk-map-right m)))))))))
+
+(define
+  hk-map-insert-with
+  (fn
+    (f k v m)
+    (cond
+      ((hk-map-empty? m) (hk-map-singleton k v))
+      (:else
+        (let
+          ((mk (hk-map-key m)))
+          (cond
+            ((< k mk)
+              (hk-map-balance
+                mk
+                (hk-map-val m)
+                (hk-map-insert-with f k v (hk-map-left m))
+                (hk-map-right m)))
+            ((> k mk)
+              (hk-map-balance
+                mk
+                (hk-map-val m)
+                (hk-map-left m)
+                (hk-map-insert-with f k v (hk-map-right m))))
+            (:else
+              (hk-map-node
+                mk
+                (f v (hk-map-val m))
+                (hk-map-left m)
+                (hk-map-right m)))))))))
+
+(define
+  hk-map-insert-with-key
+  (fn
+    (f k v m)
+    (cond
+      ((hk-map-empty? m) (hk-map-singleton k v))
+      (:else
+        (let
+          ((mk (hk-map-key m)))
+          (cond
+            ((< k mk)
+              (hk-map-balance
+                mk
+                (hk-map-val m)
+                (hk-map-insert-with-key f k v (hk-map-left m))
+                (hk-map-right m)))
+            ((> k mk)
+              (hk-map-balance
+                mk
+                (hk-map-val m)
+                (hk-map-left m)
+                (hk-map-insert-with-key f k v (hk-map-right m))))
+            (:else
+              (hk-map-node
+                mk
+                (f k v (hk-map-val m))
+                (hk-map-left m)
+                (hk-map-right m)))))))))
+
+(define
+  hk-map-alter
+  (fn
+    (f k m)
+    (let
+      ((look (hk-map-lookup k m)))
+      (let
+        ((res (f look)))
+        (cond
+          ((= (first res) "Nothing") (hk-map-delete k m))
+          (:else (hk-map-insert k (nth res 1) m)))))))
--- a/lib/haskell/match.sx
+++ b/lib/haskell/match.sx
@@ -87,45 +87,41 @@
                  ((nil? res) nil)
                  (:else (assoc res (nth pat 1) val)))))
            (:else
-              (let ((fv (hk-force val)))
+              (let
+                ((fv (hk-force val)))
                (cond
                  ((= tag "p-int")
-                    (if
-                      (and (number? fv) (= fv (nth pat 1)))
-                      env
-                      nil))
+                    (if (and (number? fv) (= fv (nth pat 1))) env nil))
                  ((= tag "p-float")
-                    (if
-                      (and (number? fv) (= fv (nth pat 1)))
-                      env
-                      nil))
+                    (if (and (number? fv) (= fv (nth pat 1))) env nil))
                  ((= tag "p-string")
-                    (if
-                      (and (string? fv) (= fv (nth pat 1)))
-                      env
-                      nil))
+                    (if (and (string? fv) (= fv (nth pat 1))) env nil))
                  ((= tag "p-char")
-                    (if
-                      (and (string? fv) (= fv (nth pat 1)))
-                      env
-                      nil))
+                    (if (and (string? fv) (= fv (nth pat 1))) env nil))
                  ((= tag "p-con")
                    (let
                      ((pat-name (nth pat 1)) (pat-args (nth pat 2)))
                      (cond
+                        ((and (= pat-name ":") (hk-str? fv) (not (hk-str-null? fv)))
+                          (let
+                            ((str-head (hk-str-head fv))
+                              (str-tail (hk-str-tail fv)))
+                            (let
+                              ((head-pat (nth pat-args 0))
+                                (tail-pat (nth pat-args 1)))
+                              (let
+                                ((res (hk-match head-pat str-head env)))
+                                (cond
+                                  ((nil? res) nil)
+                                  (:else (hk-match tail-pat str-tail res)))))))
                        ((not (hk-is-con-val? fv)) nil)
                        ((not (= (hk-val-con-name fv) pat-name)) nil)
                        (:else
                          (let
                            ((val-args (hk-val-con-args fv)))
                            (cond
-                              ((not (= (len pat-args) (len val-args)))
-                                nil)
-                              (:else
-                                (hk-match-all
-                                  pat-args
-                                  val-args
-                                  env))))))))
+                              ((not (= (len val-args) (len pat-args))) nil)
+                              (:else (hk-match-all pat-args val-args env))))))))
                  ((= tag "p-tuple")
                    (let
                      ((items (nth pat 1)))
@@ -134,13 +130,8 @@
                        ((not (= (hk-val-con-name fv) "Tuple")) nil)
                        ((not (= (len (hk-val-con-args fv)) (len items)))
                          nil)
-                        (:else
-                          (hk-match-all
-                            items
-                            (hk-val-con-args fv)
-                            env)))))
-                  ((= tag "p-list")
-                    (hk-match-list-pat (nth pat 1) fv env))
+                        (:else (hk-match-all items (hk-val-con-args fv) env)))))
+                  ((= tag "p-list") (hk-match-list-pat (nth pat 1) fv env))
                  (:else nil))))))))))

 (define
@@ -161,17 +152,26 @@
  hk-match-list-pat
  (fn
    (items val env)
-    (let ((fv (hk-force val)))
+    (let
+      ((fv (hk-force val)))
      (cond
        ((empty? items)
          (if
-            (and
-              (hk-is-con-val? fv)
-              (= (hk-val-con-name fv) "[]"))
+            (or
+              (and (hk-is-con-val? fv) (= (hk-val-con-name fv) "[]"))
+              (and (hk-str? fv) (hk-str-null? fv)))
            env
            nil))
        (:else
          (cond
+            ((and (hk-str? fv) (not (hk-str-null? fv)))
+              (let
+                ((h (hk-str-head fv)) (t (hk-str-tail fv)))
+                (let
+                  ((res (hk-match (first items) h env)))
+                  (cond
+                    ((nil? res) nil)
+                    (:else (hk-match-list-pat (rest items) t res))))))
            ((not (hk-is-con-val? fv)) nil)
            ((not (= (hk-val-con-name fv) ":")) nil)
            (:else
@@ -183,11 +183,7 @@
                    ((res (hk-match (first items) h env)))
                    (cond
                      ((nil? res) nil)
-                      (:else
-                        (hk-match-list-pat
-                          (rest items)
-                          t
-                          res)))))))))))))
+                      (:else (hk-match-list-pat (rest items) t res)))))))))))))

 ;; ── Convenience: parse a pattern from source for tests ─────
 ;; (Uses the parser's case-alt entry — `case _ of pat -> 0` —
--- a/lib/haskell/parser.sx
+++ b/lib/haskell/parser.sx
@@ -208,9 +208,19 @@
              ((= (get t "type") "char")
                (do (hk-advance!) (list :char (get t "value"))))
              ((= (get t "type") "varid")
-                (do (hk-advance!) (list :var (get t "value"))))
+                (do
+                  (hk-advance!)
+                  (cond
+                    ((hk-match? "lbrace" nil)
+                      (hk-parse-rec-update (list :var (get t "value"))))
+                    (:else (list :var (get t "value"))))))
              ((= (get t "type") "conid")
-                (do (hk-advance!) (list :con (get t "value"))))
+                (do
+                  (hk-advance!)
+                  (cond
+                    ((hk-match? "lbrace" nil)
+                      (hk-parse-rec-create (get t "value")))
+                    (:else (list :con (get t "value"))))))
              ((= (get t "type") "qvarid")
                (do (hk-advance!) (list :var (get t "value"))))
              ((= (get t "type") "qconid")
@@ -265,38 +275,47 @@
                            (list :sect-right op-name expr-e))))))
                  (:else
                    (let
-                      ((first-e (hk-parse-expr-inner))
-                        (items (list))
-                        (is-tuple false))
-                      (append! items first-e)
-                      (define
-                        hk-tup-loop
-                        (fn
-                          ()
-                          (when
-                            (hk-match? "comma" nil)
-                            (do
-                              (hk-advance!)
-                              (set! is-tuple true)
-                              (append! items (hk-parse-expr-inner))
-                              (hk-tup-loop)))))
-                      (hk-tup-loop)
+                      ((first-e (hk-parse-expr-inner)))
                      (cond
-                        ((hk-match? "rparen" nil)
+                        ((hk-match? "reservedop" "::")
                          (do
                            (hk-advance!)
-                            (if is-tuple (list :tuple items) first-e)))
+                            (let
+                              ((ann-type (hk-parse-type)))
+                              (hk-expect! "rparen" nil)
+                              (list :type-ann first-e ann-type))))
                        (:else
                          (let
-                            ((op-info2 (hk-section-op-info)))
+                            ((items (list)) (is-tuple false))
+                            (append! items first-e)
+                            (define
+                              hk-tup-loop
+                              (fn
+                                ()
+                                (when
+                                  (hk-match? "comma" nil)
+                                  (do
+                                    (hk-advance!)
+                                    (set! is-tuple true)
+                                    (append! items (hk-parse-expr-inner))
+                                    (hk-tup-loop)))))
+                            (hk-tup-loop)
                            (cond
-                              ((and (not (nil? op-info2)) (not is-tuple) (let ((after2 (hk-peek-at (get op-info2 "len")))) (and (not (nil? after2)) (= (get after2 "type") "rparen"))))
-                                (let
-                                  ((op-name (get op-info2 "name")))
-                                  (hk-consume-op!)
+                              ((hk-match? "rparen" nil)
+                                (do
                                  (hk-advance!)
-                                  (list :sect-left op-name first-e)))
-                              (:else (hk-err "expected ')' after expression"))))))))))))))
+                                  (if is-tuple (list :tuple items) first-e)))
+                              (:else
+                                (let
+                                  ((op-info2 (hk-section-op-info)))
+                                  (cond
+                                    ((and (not (nil? op-info2)) (not is-tuple) (let ((after2 (hk-peek-at (get op-info2 "len")))) (and (not (nil? after2)) (= (get after2 "type") "rparen"))))
+                                      (let
+                                        ((op-name (get op-info2 "name")))
+                                        (hk-consume-op!)
+                                        (hk-advance!)
+                                        (list :sect-left op-name first-e)))
+                                    (:else (hk-err "expected ')' after expression")))))))))))))))))
      (define
        hk-comp-qual-is-gen?
        (fn
@@ -456,6 +475,90 @@
                    (do
                      (hk-expect! "rbracket" nil)
                      (list :list (list first-e))))))))))
+      (define
+        hk-parse-rec-create
+        (fn
+          (cname)
+          (begin
+            (hk-expect! "lbrace" nil)
+            (let
+              ((fields (list)))
+              (define
+                hk-rc-loop
+                (fn
+                  ()
+                  (when
+                    (hk-match? "varid" nil)
+                    (let
+                      ((fname (get (hk-advance!) "value")))
+                      (begin
+                        (hk-expect! "reservedop" "=")
+                        (let
+                          ((fexpr (hk-parse-expr-inner)))
+                          (begin
+                            (append! fields (list fname fexpr))
+                            (when
+                              (hk-match? "comma" nil)
+                              (begin (hk-advance!) (hk-rc-loop))))))))))
+              (hk-rc-loop)
+              (hk-expect! "rbrace" nil)
+              (list :rec-create cname fields)))))
+      (define
+        hk-parse-rec-update
+        (fn
+          (rec-expr)
+          (begin
+            (hk-expect! "lbrace" nil)
+            (let
+              ((fields (list)))
+              (define
+                hk-ru-loop
+                (fn
+                  ()
+                  (when
+                    (hk-match? "varid" nil)
+                    (let
+                      ((fname (get (hk-advance!) "value")))
+                      (begin
+                        (hk-expect! "reservedop" "=")
+                        (let
+                          ((fexpr (hk-parse-expr-inner)))
+                          (begin
+                            (append! fields (list fname fexpr))
+                            (when
+                              (hk-match? "comma" nil)
+                              (begin (hk-advance!) (hk-ru-loop))))))))))
+              (hk-ru-loop)
+              (hk-expect! "rbrace" nil)
+              (list :rec-update rec-expr fields)))))
+      (define
+        hk-parse-rec-pat
+        (fn
+          (cname)
+          (begin
+            (hk-expect! "lbrace" nil)
+            (let
+              ((field-pats (list)))
+              (define
+                hk-rp-loop
+                (fn
+                  ()
+                  (when
+                    (hk-match? "varid" nil)
+                    (let
+                      ((fname (get (hk-advance!) "value")))
+                      (begin
+                        (hk-expect! "reservedop" "=")
+                        (let
+                          ((fpat (hk-parse-pat)))
+                          (begin
+                            (append! field-pats (list fname fpat))
+                            (when
+                              (hk-match? "comma" nil)
+                              (begin (hk-advance!) (hk-rp-loop))))))))))
+              (hk-rp-loop)
+              (hk-expect! "rbrace" nil)
+              (list :p-rec cname field-pats)))))
      (define
        hk-parse-fexp
        (fn
@@ -696,7 +799,12 @@
                    (:else
                      (do (hk-advance!) (list :p-var (get t "value")))))))
              ((= (get t "type") "conid")
-                (do (hk-advance!) (list :p-con (get t "value") (list))))
+                (do
+                  (hk-advance!)
+                  (cond
+                    ((hk-match? "lbrace" nil)
+                      (hk-parse-rec-pat (get t "value")))
+                    (:else (list :p-con (get t "value") (list))))))
              ((= (get t "type") "qconid")
                (do (hk-advance!) (list :p-con (get t "value") (list))))
              ((= (get t "type") "lparen") (hk-parse-paren-pat))
@@ -762,16 +870,24 @@
            (cond
              ((and (not (nil? t)) (or (= (get t "type") "conid") (= (get t "type") "qconid")))
                (let
-                  ((name (get (hk-advance!) "value")) (args (list)))
-                  (define
-                    hk-pca-loop
-                    (fn
-                      ()
-                      (when
-                        (hk-apat-start? (hk-peek))
-                        (do (append! args (hk-parse-apat)) (hk-pca-loop)))))
-                  (hk-pca-loop)
-                  (list :p-con name args)))
+                  ((name (get (hk-advance!) "value")))
+                  (cond
+                    ((hk-match? "lbrace" nil)
+                      (hk-parse-rec-pat name))
+                    (:else
+                      (let
+                        ((args (list)))
+                        (define
+                          hk-pca-loop
+                          (fn
+                            ()
+                            (when
+                              (hk-apat-start? (hk-peek))
+                              (do
+                                (append! args (hk-parse-apat))
+                                (hk-pca-loop)))))
+                        (hk-pca-loop)
+                        (list :p-con name args))))))
              (:else (hk-parse-apat))))))
      (define
        hk-parse-pat
@@ -1212,16 +1328,47 @@
            (not (hk-match? "conid" nil))
            (hk-err "expected constructor name"))
          (let
-            ((name (get (hk-advance!) "value")) (fields (list)))
-            (define
-              hk-cd-loop
-              (fn
-                ()
-                (when
-                  (hk-atype-start? (hk-peek))
-                  (do (append! fields (hk-parse-atype)) (hk-cd-loop)))))
-            (hk-cd-loop)
-            (list :con-def name fields))))
+            ((name (get (hk-advance!) "value")))
+            (cond
+              ((hk-match? "lbrace" nil)
+                (begin
+                  (hk-advance!)
+                  (let
+                    ((rec-fields (list)))
+                    (define
+                      hk-rec-loop
+                      (fn
+                        ()
+                        (when
+                          (hk-match? "varid" nil)
+                          (let
+                            ((fname (get (hk-advance!) "value")))
+                            (begin
+                              (hk-expect! "reservedop" "::")
+                              (let
+                                ((ftype (hk-parse-type)))
+                                (begin
+                                  (append! rec-fields (list fname ftype))
+                                  (when
+                                    (hk-match? "comma" nil)
+                                    (begin (hk-advance!) (hk-rec-loop))))))))))
+                    (hk-rec-loop)
+                    (hk-expect! "rbrace" nil)
+                    (list :con-rec name rec-fields))))
+              (:else
+                (let
+                  ((fields (list)))
+                  (define
+                    hk-cd-loop
+                    (fn
+                      ()
+                      (when
+                        (hk-atype-start? (hk-peek))
+                        (begin
+                          (append! fields (hk-parse-atype))
+                          (hk-cd-loop)))))
+                  (hk-cd-loop)
+                  (list :con-def name fields)))))))
      (define
        hk-parse-tvars
        (fn
@@ -1586,10 +1733,18 @@
                  (= (hk-peek-type) "eof")
                  (hk-match? "vrbrace" nil)
                  (hk-match? "rbrace" nil))))
+            (define
+              hk-body-step
+              (fn
+                ()
+                (cond
+                  ((hk-match? "reserved" "import")
+                    (append! imports (hk-parse-import)))
+                  (:else (append! decls (hk-parse-decl))))))
            (when
              (not (hk-body-at-end?))
              (do
-                (append! decls (hk-parse-decl))
+                (hk-body-step)
                (define
                  hk-body-loop
                  (fn
@@ -1600,7 +1755,7 @@
                        (hk-advance!)
                        (when
                          (not (hk-body-at-end?))
-                          (append! decls (hk-parse-decl)))
+                          (hk-body-step))
                        (hk-body-loop)))))
                (hk-body-loop)))
            (list imports decls))))
--- a/lib/haskell/runtime.sx
+++ b/lib/haskell/runtime.sx
@@ -12,12 +12,7 @@

 (define
  hk-register-con!
-  (fn
-    (cname arity type-name)
-    (dict-set!
-      hk-constructors
-      cname
-      {:arity arity :type type-name})))
+  (fn (cname arity type-name) (dict-set! hk-constructors cname {:arity arity :type type-name})))

 (define hk-is-con? (fn (name) (has-key? hk-constructors name)))

@@ -48,26 +43,15 @@
  (fn
    (data-node)
    (let
-      ((type-name (nth data-node 1))
-        (cons-list (nth data-node 3)))
+      ((type-name (nth data-node 1)) (cons-list (nth data-node 3)))
      (for-each
-        (fn
-          (cd)
-          (hk-register-con!
-            (nth cd 1)
-            (len (nth cd 2))
-            type-name))
+        (fn (cd) (hk-register-con! (nth cd 1) (len (nth cd 2)) type-name))
        cons-list))))

 ;; (:newtype NAME TVARS CNAME FIELD)
 (define
  hk-register-newtype!
-  (fn
-    (nt-node)
-    (hk-register-con!
-      (nth nt-node 3)
-      1
-      (nth nt-node 1))))
+  (fn (nt-node) (hk-register-con! (nth nt-node 3) 1 (nth nt-node 1))))

 ;; Walk a decls list, registering every `data` / `newtype` decl.
 (define
@@ -78,15 +62,9 @@
      (fn
        (d)
        (cond
-          ((and
-              (list? d)
-              (not (empty? d))
-              (= (first d) "data"))
+          ((and (list? d) (not (empty? d)) (= (first d) "data"))
            (hk-register-data! d))
-          ((and
-              (list? d)
-              (not (empty? d))
-              (= (first d) "newtype"))
+          ((and (list? d) (not (empty? d)) (= (first d) "newtype"))
            (hk-register-newtype! d))
          (:else nil)))
      decls)))
@@ -99,16 +77,12 @@
      ((nil? ast) nil)
      ((not (list? ast)) nil)
      ((empty? ast) nil)
-      ((= (first ast) "program")
-        (hk-register-decls! (nth ast 1)))
-      ((= (first ast) "module")
-        (hk-register-decls! (nth ast 4)))
+      ((= (first ast) "program") (hk-register-decls! (nth ast 1)))
+      ((= (first ast) "module") (hk-register-decls! (nth ast 4)))
      (:else nil))))

 ;; Convenience: source → AST → desugar → register.
-(define
-  hk-load-source!
-  (fn (src) (hk-register-program! (hk-core src))))
+(define hk-load-source! (fn (src) (hk-register-program! (hk-core src))))

 ;; ── Built-in constructors pre-registered ─────────────────────
 ;; Bool — used implicitly by `if`, comparison operators.
@@ -122,9 +96,55 @@
 ;; Standard Prelude types — pre-registered so expression-level
 ;; programs can use them without a `data` decl.
 (hk-register-con! "Nothing" 0 "Maybe")
-(hk-register-con! "Just"    1 "Maybe")
-(hk-register-con! "Left"    1 "Either")
-(hk-register-con! "Right"   1 "Either")
+(hk-register-con! "Just" 1 "Maybe")
+(hk-register-con! "Left" 1 "Either")
+(hk-register-con! "Right" 1 "Either")
 (hk-register-con! "LT" 0 "Ordering")
 (hk-register-con! "EQ" 0 "Ordering")
 (hk-register-con! "GT" 0 "Ordering")
+(hk-register-con! "SomeException" 1 "SomeException")
+
+(define
+  hk-str?
+  (fn (v) (or (string? v) (and (dict? v) (has-key? v "hk-str")))))
+
+(define
+  hk-str-head
+  (fn
+    (v)
+    (if
+      (string? v)
+      (char-code (char-at v 0))
+      (char-code (char-at (get v "hk-str") (get v "hk-off"))))))
+
+(define
+  hk-str-tail
+  (fn
+    (v)
+    (let
+      ((buf (if (string? v) v (get v "hk-str")))
+        (off (if (string? v) 1 (+ (get v "hk-off") 1))))
+      (if (>= off (string-length buf)) (list "[]") {:hk-off off :hk-str buf}))))
+
+(define
+  hk-str-null?
+  (fn
+    (v)
+    (if
+      (string? v)
+      (= (string-length v) 0)
+      (>= (get v "hk-off") (string-length (get v "hk-str"))))))
+
+(define
+  hk-str-to-native
+  (fn
+    (v)
+    (if
+      (string? v)
+      v
+      (let
+        ((buf (get v "hk-str")) (off (get v "hk-off")))
+        (reduce
+          (fn (acc i) (str acc (char-at buf i)))
+          ""
+          (range off (string-length buf)))))))
--- a/lib/haskell/scoreboard.json
+++ b/lib/haskell/scoreboard.json
@@ -1,6 +1,6 @@
 {
-  "date": "2026-05-06",
-  "total_pass": 156,
+  "date": "2026-05-08",
+  "total_pass": 285,
  "total_fail": 0,
  "programs": {
    "fib": {"pass": 2, "fail": 0},
@@ -9,7 +9,7 @@
    "nqueens": {"pass": 2, "fail": 0},
    "calculator": {"pass": 5, "fail": 0},
    "collatz": {"pass": 11, "fail": 0},
-    "palindrome": {"pass": 8, "fail": 0},
+    "palindrome": {"pass": 12, "fail": 0},
    "maybe": {"pass": 12, "fail": 0},
    "fizzbuzz": {"pass": 12, "fail": 0},
    "anagram": {"pass": 9, "fail": 0},
@@ -19,7 +19,25 @@
    "primes": {"pass": 12, "fail": 0},
    "zipwith": {"pass": 9, "fail": 0},
    "matrix": {"pass": 8, "fail": 0},
-    "wordcount": {"pass": 7, "fail": 0},
-    "powers": {"pass": 14, "fail": 0}
+    "wordcount": {"pass": 10, "fail": 0},
+    "powers": {"pass": 14, "fail": 0},
+    "caesar": {"pass": 8, "fail": 0},
+    "runlength-str": {"pass": 9, "fail": 0},
+    "showadt": {"pass": 5, "fail": 0},
+    "showio": {"pass": 5, "fail": 0},
+    "partial": {"pass": 7, "fail": 0},
+    "statistics": {"pass": 5, "fail": 0},
+    "newton": {"pass": 5, "fail": 0},
+    "wordfreq": {"pass": 7, "fail": 0},
+    "mapgraph": {"pass": 6, "fail": 0},
+    "uniquewords": {"pass": 4, "fail": 0},
+    "setops": {"pass": 8, "fail": 0},
+    "shapes": {"pass": 5, "fail": 0},
+    "person": {"pass": 7, "fail": 0},
+    "config": {"pass": 10, "fail": 0},
+    "counter": {"pass": 7, "fail": 0},
+    "accumulate": {"pass": 8, "fail": 0},
+    "safediv": {"pass": 8, "fail": 0},
+    "trycatch": {"pass": 8, "fail": 0}
  }
 }
--- a/lib/haskell/scoreboard.md
+++ b/lib/haskell/scoreboard.md
@@ -1,6 +1,6 @@
 # Haskell-on-SX Scoreboard

-Updated 2026-05-06 · Phase 6 (prelude extras + 18 programs)
+Updated 2026-05-08 · Phase 6 (prelude extras + 18 programs)

 | Program | Tests | Status |
 |---------|-------|--------|
@@ -10,7 +10,7 @@ Updated 2026-05-06 · Phase 6 (prelude extras + 18 programs)
 | nqueens.hs | 2/2 | ✓ |
 | calculator.hs | 5/5 | ✓ |
 | collatz.hs | 11/11 | ✓ |
-| palindrome.hs | 8/8 | ✓ |
+| palindrome.hs | 12/12 | ✓ |
 | maybe.hs | 12/12 | ✓ |
 | fizzbuzz.hs | 12/12 | ✓ |
 | anagram.hs | 9/9 | ✓ |
@@ -20,6 +20,24 @@ Updated 2026-05-06 · Phase 6 (prelude extras + 18 programs)
 | primes.hs | 12/12 | ✓ |
 | zipwith.hs | 9/9 | ✓ |
 | matrix.hs | 8/8 | ✓ |
-| wordcount.hs | 7/7 | ✓ |
+| wordcount.hs | 10/10 | ✓ |
 | powers.hs | 14/14 | ✓ |
-| **Total** | **156/156** | **18/18 programs** |
+| caesar.hs | 8/8 | ✓ |
+| runlength-str.hs | 9/9 | ✓ |
+| showadt.hs | 5/5 | ✓ |
+| showio.hs | 5/5 | ✓ |
+| partial.hs | 7/7 | ✓ |
+| statistics.hs | 5/5 | ✓ |
+| newton.hs | 5/5 | ✓ |
+| wordfreq.hs | 7/7 | ✓ |
+| mapgraph.hs | 6/6 | ✓ |
+| uniquewords.hs | 4/4 | ✓ |
+| setops.hs | 8/8 | ✓ |
+| shapes.hs | 5/5 | ✓ |
+| person.hs | 7/7 | ✓ |
+| config.hs | 10/10 | ✓ |
+| counter.hs | 7/7 | ✓ |
+| accumulate.hs | 8/8 | ✓ |
+| safediv.hs | 8/8 | ✓ |
+| trycatch.hs | 8/8 | ✓ |
+| **Total** | **285/285** | **36/36 programs** |
--- a/lib/haskell/set.sx
+++ b/lib/haskell/set.sx
@@ -0,0 +1,62 @@
+;; set.sx — Phase 12 Data.Set: wraps Data.Map with unit values.
+;;
+;; A Set is a Map from key to (). All set operations delegate to the map
+;; ops, ignoring the value side. Storage representation matches Data.Map:
+;;
+;;   Empty → ("Map-Empty")
+;;   Node  → ("Map-Node" key () left right size)
+;;
+;; Tradeoff: trivial maintenance burden, slight overhead per node from
+;; the unused value slot. Faster path forward than re-implementing the
+;; weight-balanced BST.
+;;
+;; Functions live in this file; the Haskell-level `import Data.Set` /
+;; `import qualified Data.Set as Set` wiring (next Phase 12 box) binds
+;; them under the chosen alias.
+
+(define hk-set-unit (list "Tuple"))
+
+(define hk-set-empty hk-map-empty)
+
+(define hk-set-singleton (fn (k) (hk-map-singleton k hk-set-unit)))
+
+(define hk-set-insert (fn (k s) (hk-map-insert k hk-set-unit s)))
+
+(define hk-set-delete hk-map-delete)
+(define hk-set-member hk-map-member)
+(define hk-set-size hk-map-size)
+(define hk-set-null hk-map-null)
+(define hk-set-to-asc-list hk-map-keys)
+(define hk-set-to-list hk-map-keys)
+
+(define
+  hk-set-from-list
+  (fn (xs) (reduce (fn (acc k) (hk-set-insert k acc)) hk-set-empty xs)))
+
+(define
+  hk-set-union
+  (fn (a b) (hk-map-union-with (fn (x y) hk-set-unit) a b)))
+
+(define
+  hk-set-intersection
+  (fn (a b) (hk-map-intersection-with (fn (x y) hk-set-unit) a b)))
+
+(define hk-set-difference hk-map-difference)
+
+(define
+  hk-set-is-subset-of
+  (fn (a b) (= (hk-map-size (hk-map-difference a b)) 0)))
+
+(define
+  hk-set-filter
+  (fn (p s) (hk-map-filter-with-key (fn (k v) (p k)) s)))
+
+(define hk-set-map (fn (f s) (hk-set-from-list (map f (hk-map-keys s)))))
+
+(define
+  hk-set-foldr
+  (fn (f z s) (hk-map-foldr-with-key (fn (k v acc) (f k acc)) z s)))
+
+(define
+  hk-set-foldl
+  (fn (f z s) (hk-map-foldl-with-key (fn (acc k v) (f acc k)) z s)))
--- a/lib/haskell/test.sh
+++ b/lib/haskell/test.sh
@@ -55,6 +55,8 @@ for FILE in "${FILES[@]}"; do
 (load "lib/haskell/runtime.sx")
 (load "lib/haskell/match.sx")
 (load "lib/haskell/eval.sx")
+(load "lib/haskell/map.sx")
+(load "lib/haskell/set.sx")
 $INFER_LOAD
 (load "lib/haskell/testlib.sx")
 (epoch 2)
@@ -98,6 +100,8 @@ EPOCHS
 (load "lib/haskell/runtime.sx")
 (load "lib/haskell/match.sx")
 (load "lib/haskell/eval.sx")
+(load "lib/haskell/map.sx")
+(load "lib/haskell/set.sx")
 $INFER_LOAD
 (load "lib/haskell/testlib.sx")
 (epoch 2)
--- a/lib/haskell/testlib.sx
+++ b/lib/haskell/testlib.sx
@@ -56,3 +56,21 @@
        (append!
          hk-test-fails
          {:actual actual :expected expected :name name})))))
+
+(define
+  hk-test-error
+  (fn
+    (name thunk expected-substring)
+    (let
+      ((caught (guard (e (true (if (string? e) e (str e)))) (begin (thunk) nil))))
+      (cond
+        ((nil? caught)
+          (do
+            (set! hk-test-fail (+ hk-test-fail 1))
+            (append! hk-test-fails {:actual "no error raised" :expected (str "error containing: " expected-substring) :name name})))
+        ((>= (index-of caught expected-substring) 0)
+          (set! hk-test-pass (+ hk-test-pass 1)))
+        (:else
+          (do
+            (set! hk-test-fail (+ hk-test-fail 1))
+            (append! hk-test-fails {:actual caught :expected (str "error containing: " expected-substring) :name name})))))))
--- a/lib/haskell/tests/class-defaults.sx
+++ b/lib/haskell/tests/class-defaults.sx
@@ -0,0 +1,86 @@
+;; class-defaults.sx — Phase 13: class default method implementations.
+
+;; ── Eq default: myNeq derived from myEq via `not (myEq x y)` ──
+(define
+  hk-myeq-source
+  "class MyEq a where\n  myEq :: a -> a -> Bool\n  myNeq :: a -> a -> Bool\n  myNeq x y = not (myEq x y)\ninstance MyEq Int where\n  myEq x y = x == y\n")
+
+(hk-test
+  "Eq default: myNeq 3 5 = True (no explicit myNeq in instance)"
+  (hk-deep-force (hk-run (str hk-myeq-source "main = myNeq 3 5\n")))
+  (list "True"))
+
+(hk-test
+  "Eq default: myNeq 3 3 = False"
+  (hk-deep-force (hk-run (str hk-myeq-source "main = myNeq 3 3\n")))
+  (list "False"))
+
+(hk-test
+  "Eq default: myEq still works in same instance"
+  (hk-deep-force (hk-run (str hk-myeq-source "main = myEq 7 7\n")))
+  (list "True"))
+
+;; ── Override path: instance can still provide the method explicitly. ──
+(hk-test
+  "Default override: instance-provided beats class default"
+  (hk-deep-force
+    (hk-run
+      "class Hi a where\n  greet :: a -> String\n  greet x = \"default\"\ninstance Hi Bool where\n  greet x = \"override\"\nmain = greet True"))
+  "override")
+
+(hk-test
+  "Default fallback: empty instance picks default"
+  (hk-deep-force
+    (hk-run
+      "class Hi a where\n  greet :: a -> String\n  greet x = \"default\"\ninstance Hi Bool where\nmain = greet True"))
+  "default")
+
+(define
+  hk-myord-source
+  "class MyOrd a where\n  myCmp :: a -> a -> Bool\n  myMax :: a -> a -> a\n  myMin :: a -> a -> a\n  myMax a b = if myCmp a b then a else b\n  myMin a b = if myCmp a b then b else a\ninstance MyOrd Int where\n  myCmp x y = x >= y\n")
+
+(hk-test
+  "Ord default: myMax 3 5 = 5"
+  (hk-deep-force (hk-run (str hk-myord-source "main = myMax 3 5\n")))
+  5)
+
+(hk-test
+  "Ord default: myMax 8 2 = 8"
+  (hk-deep-force (hk-run (str hk-myord-source "main = myMax 8 2\n")))
+  8)
+
+(hk-test
+  "Ord default: myMin 3 5 = 3"
+  (hk-deep-force (hk-run (str hk-myord-source "main = myMin 3 5\n")))
+  3)
+
+(hk-test
+  "Ord default: myMin 8 2 = 2"
+  (hk-deep-force (hk-run (str hk-myord-source "main = myMin 8 2\n")))
+  2)
+
+(hk-test
+  "Ord default: myMax of equals returns first"
+  (hk-deep-force (hk-run (str hk-myord-source "main = myMax 4 4\n")))
+  4)
+
+(define
+  hk-mynum-source
+  "class MyNum a where\n  mySub :: a -> a -> a\n  myLt :: a -> a -> Bool\n  myNegate :: a -> a\n  myAbs :: a -> a\n  myNegate x = mySub (mySub x x) x\n  myAbs x = if myLt x (mySub x x) then myNegate x else x\ninstance MyNum Int where\n  mySub x y = x - y\n  myLt x y = x < y\n")
+
+(hk-test
+  "Num default: myNegate 5 = -5"
+  (hk-deep-force (hk-run (str hk-mynum-source "main = myNegate 5\n")))
+  -5)
+
+(hk-test
+  "Num default: myAbs (myNegate 7) = 7"
+  (hk-deep-force (hk-run (str hk-mynum-source "main = myAbs (myNegate 7)\n")))
+  7)
+
+(hk-test
+  "Num default: myAbs 9 = 9"
+  (hk-deep-force (hk-run (str hk-mynum-source "main = myAbs 9\n")))
+  9)
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/deriving.sx
+++ b/lib/haskell/tests/deriving.sx
@@ -12,14 +12,14 @@
  "deriving Show: constructor with arg"
  (hk-deep-force
    (hk-run "data Wrapper = Wrap Int deriving (Show)\nmain = show (Wrap 42)"))
-  "(Wrap 42)")
+  "Wrap 42")

 (hk-test
  "deriving Show: nested constructors"
  (hk-deep-force
    (hk-run
      "data Tree = Leaf | Node Int Tree Tree deriving (Show)\nmain = show (Node 1 Leaf Leaf)"))
-  "(Node 1 Leaf Leaf)")
+  "Node 1 Leaf Leaf")

 (hk-test
  "deriving Show: second constructor"
@@ -30,6 +30,31 @@

 ;; ─── Eq ──────────────────────────────────────────────────────────────────────

+(hk-test
+  "deriving Show: nested ADT wraps inner constructor in parens"
+  (hk-deep-force
+    (hk-run
+      "data Tree = Leaf | Node Int Tree Tree deriving (Show)\nmain = show (Node 1 Leaf (Node 2 Leaf Leaf))"))
+  "Node 1 Leaf (Node 2 Leaf Leaf)")
+
+(hk-test
+  "deriving Show: Maybe Maybe wraps inner Just"
+  (hk-deep-force (hk-run "main = show (Just (Just 3))"))
+  "Just (Just 3)")
+
+(hk-test
+  "deriving Show: negative argument wrapped in parens"
+  (hk-deep-force (hk-run "main = show (Just (negate 3))"))
+  "Just (-3)")
+
+(hk-test
+  "deriving Show: list element does not need parens"
+  (hk-deep-force
+    (hk-run "data Box = Box [Int] deriving (Show)\nmain = show (Box [1,2,3])"))
+  "Box [1,2,3]")
+
+;; ─── combined Eq + Show ───────────────────────────────────────────────────────
+
 (hk-test
  "deriving Eq: same constructor"
  (hk-deep-force
@@ -58,14 +83,12 @@
      "data Color = Red | Green | Blue deriving (Eq)\nmain = show (Red /= Blue)"))
  "True")

-;; ─── combined Eq + Show ───────────────────────────────────────────────────────
-
 (hk-test
-  "deriving Eq Show: combined in parens"
+  "deriving Eq Show: combined"
  (hk-deep-force
    (hk-run
      "data Shape = Circle Int | Square Int deriving (Eq, Show)\nmain = show (Circle 5)"))
-  "(Circle 5)")
+  "Circle 5")

 (hk-test
  "deriving Eq Show: eq on constructor with arg"
--- a/lib/haskell/tests/errors.sx
+++ b/lib/haskell/tests/errors.sx
@@ -0,0 +1,99 @@
+;; errors.sx — Phase 9 error / undefined / partial-fn coverage via hk-test-error.
+
+;; ── error builtin ────────────────────────────────────────────
+(define
+  hk-as-list
+  (fn
+    (xs)
+    (cond
+      ((and (list? xs) (= (first xs) "[]")) (list))
+      ((and (list? xs) (= (first xs) ":"))
+        (cons (nth xs 1) (hk-as-list (nth xs 2))))
+      (:else xs))))
+
+(hk-test-error
+  "error: raises with literal message"
+  (fn () (hk-deep-force (hk-run "main = error \"boom\"")))
+  "hk-error: boom")
+
+(hk-test-error
+  "error: raises with computed message"
+  (fn () (hk-deep-force (hk-run "main = error (\"oops: \" ++ show 42)")))
+  "hk-error: oops: 42")
+
+;; ── undefined ────────────────────────────────────────────────
+(hk-test-error
+  "error: nested in if branch (only fires when forced)"
+  (fn
+    ()
+    (hk-deep-force (hk-run "main = if 1 == 1 then error \"taken\" else 0")))
+  "taken")
+
+(hk-test-error
+  "undefined: raises Prelude.undefined"
+  (fn () (hk-deep-force (hk-run "main = undefined")))
+  "Prelude.undefined")
+
+;; The non-strict path: undefined doesn't fire when not forced.
+(hk-test-error
+  "undefined: forced via arithmetic"
+  (fn () (hk-deep-force (hk-run "main = undefined + 1")))
+  "Prelude.undefined")
+
+;; ── partial functions ───────────────────────────────────────
+(hk-test
+  "undefined: lazy, not forced when discarded"
+  (hk-deep-force (hk-run "main = let _ = undefined in 5"))
+  5)
+
+(hk-test-error
+  "head []: raises Prelude.head: empty list"
+  (fn () (hk-deep-force (hk-run "main = head []")))
+  "Prelude.head: empty list")
+
+(hk-test-error
+  "tail []: raises Prelude.tail: empty list"
+  (fn () (hk-deep-force (hk-run "main = tail []")))
+  "Prelude.tail: empty list")
+
+;; head and tail still work on non-empty lists.
+(hk-test-error
+  "fromJust Nothing: raises Maybe.fromJust: Nothing"
+  (fn () (hk-deep-force (hk-run "main = fromJust Nothing")))
+  "Maybe.fromJust: Nothing")
+
+(hk-test
+  "head [42]: still works"
+  (hk-deep-force (hk-run "main = head [42]"))
+  42)
+
+;; ── error in IO context ─────────────────────────────────────
+(hk-test
+  "tail [1,2,3]: still works"
+  (hk-as-list (hk-deep-force (hk-run "main = tail [1,2,3]")))
+  (list 2 3))
+
+(hk-test
+  "hk-run-io: error in main lands in io-lines"
+  (let
+    ((lines (hk-run-io "main = error \"caught here\"")))
+    (>= (index-of (str lines) "caught here") 0))
+  true)
+
+;; ── hk-test-error helper itself ─────────────────────────────
+(hk-test
+  "hk-run-io: putStrLn before error preserves earlier output"
+  (let
+    ((lines (hk-run-io "main = do { putStrLn \"first\"; error \"died\"; putStrLn \"never\" }")))
+    (and
+      (>= (index-of (str lines) "first") 0)
+      (>= (index-of (str lines) "died") 0)))
+  true)
+
+;; hk-as-list helper for converting a forced Haskell cons into an SX list.
+(hk-test-error
+  "hk-test-error: matches partial substring inside wrapped exception"
+  (fn () (hk-deep-force (hk-run "main = error \"unique-marker-xyz\"")))
+  "unique-marker-xyz")
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/eval.sx
+++ b/lib/haskell/tests/eval.sx
@@ -231,16 +231,82 @@
  1)

 ;; ── Laziness: app args evaluate only when forced ──
+(hk-test
+  "error builtin: raises with hk-error prefix"
+  (guard
+    (e (true (>= (index-of e "hk-error: boom") 0)))
+    (begin (hk-deep-force (hk-run "main = error \"boom\"")) false))
+  true)
+
+(hk-test
+  "error builtin: raises with computed message"
+  (guard
+    (e (true (>= (index-of e "hk-error: oops: 42") 0)))
+    (begin
+      (hk-deep-force (hk-run "main = error (\"oops: \" ++ show 42)"))
+      false))
+  true)
+
+(hk-test
+  "undefined: raises hk-error with Prelude.undefined message"
+  (guard
+    (e (true (>= (index-of e "hk-error: Prelude.undefined") 0)))
+    (begin (hk-deep-force (hk-run "main = undefined")) false))
+  true)
+
+(hk-test
+  "undefined: lazy — only fires when forced"
+  (hk-deep-force (hk-run "main = if True then 42 else undefined"))
+  42)
+
+(hk-test
+  "head []: raises Prelude.head: empty list"
+  (guard
+    (e (true (>= (index-of e "Prelude.head: empty list") 0)))
+    (begin (hk-deep-force (hk-run "main = head []")) false))
+  true)
+
+(hk-test
+  "tail []: raises Prelude.tail: empty list"
+  (guard
+    (e (true (>= (index-of e "Prelude.tail: empty list") 0)))
+    (begin (hk-deep-force (hk-run "main = tail []")) false))
+  true)
+
+;; ── not / id built-ins ──
+(hk-test
+  "fromJust Nothing: raises Maybe.fromJust: Nothing"
+  (guard
+    (e (true (>= (index-of e "Maybe.fromJust: Nothing") 0)))
+    (begin (hk-deep-force (hk-run "main = fromJust Nothing")) false))
+  true)
+(hk-test
+  "fromJust (Just 5) = 5"
+  (hk-deep-force (hk-run "main = fromJust (Just 5)"))
+  5)
+(hk-test
+  "head [42] = 42 (still works for non-empty)"
+  (hk-deep-force (hk-run "main = head [42]"))
+  42)
+
+(hk-test-error
+  "hk-test-error helper: catches matching error"
+  (fn () (hk-deep-force (hk-run "main = error \"boom\"")))
+  "hk-error: boom")
+
+(hk-test-error
+  "hk-test-error helper: catches head [] error"
+  (fn () (hk-deep-force (hk-run "main = head []")))
+  "Prelude.head: empty list")
+
 (hk-test
  "second arg never forced"
-  (hk-eval-expr-source
-    "(\\x y -> x) 1 (error \"never\")")
+  (hk-eval-expr-source "(\\x y -> x) 1 (error \"never\")")
  1)

 (hk-test
  "first arg never forced"
-  (hk-eval-expr-source
-    "(\\x y -> y) (error \"never\") 99")
+  (hk-eval-expr-source "(\\x y -> y) (error \"never\") 99")
  99)

 (hk-test
@@ -251,9 +317,7 @@

 (hk-test
  "lazy: const drops its second argument"
-  (hk-prog-val
-    "const x y = x\nresult = const 5 (error \"boom\")"
-    "result")
+  (hk-prog-val "const x y = x\nresult = const 5 (error \"boom\")" "result")
  5)

 (hk-test
@@ -270,9 +334,10 @@
    "result")
  (list "True"))

-;; ── not / id built-ins ──
 (hk-test "not True" (hk-eval-expr-source "not True") (list "False"))
+
 (hk-test "not False" (hk-eval-expr-source "not False") (list "True"))
+
 (hk-test "id" (hk-eval-expr-source "id 42") 42)

 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/exceptions.sx
+++ b/lib/haskell/tests/exceptions.sx
@@ -0,0 +1,105 @@
+;; Phase 16 — Exception handling unit tests.
+
+(hk-test
+  "catch — success path returns the action result"
+  (hk-deep-force
+    (hk-run
+      "main = catch (return 42) (\\(SomeException m) -> return 0)"))
+  (list "IO" 42))
+
+(hk-test
+  "catch — error caught, handler receives message"
+  (hk-deep-force
+    (hk-run
+      "main = catch (error \"boom\") (\\(SomeException m) -> return m)"))
+  (list "IO" "boom"))
+
+(hk-test
+  "try — success returns Right v"
+  (hk-deep-force
+    (hk-run "main = try (return 42)"))
+  (list "IO" (list "Right" 42)))
+
+(hk-test
+  "try — error returns Left (SomeException msg)"
+  (hk-deep-force
+    (hk-run "main = try (error \"oops\")"))
+  (list "IO" (list "Left" (list "SomeException" "oops"))))
+
+(hk-test
+  "handle — flip catch — caught error message"
+  (hk-deep-force
+    (hk-run
+      "main = handle (\\(SomeException m) -> return m) (error \"hot\")"))
+  (list "IO" "hot"))
+
+(hk-test
+  "throwIO + catch — handler sees the SomeException"
+  (hk-deep-force
+    (hk-run
+      "main = catch (throwIO (SomeException \"bang\")) (\\(SomeException m) -> return m)"))
+  (list "IO" "bang"))
+
+(hk-test
+  "throwIO + try — Left side"
+  (hk-deep-force
+    (hk-run
+      "main = try (throwIO (SomeException \"x\"))"))
+  (list "IO" (list "Left" (list "SomeException" "x"))))
+
+(hk-test
+  "evaluate — pure value returns IO v"
+  (hk-deep-force
+    (hk-run "main = evaluate (1 + 2 + 3)"))
+  (list "IO" 6))
+
+(hk-test
+  "evaluate — error surfaces as catchable exception"
+  (hk-deep-force
+    (hk-run
+      "main = catch (evaluate (error \"deep\")) (\\(SomeException m) -> return m)"))
+  (list "IO" "deep"))
+
+(hk-test
+  "nested catch — inner handler runs first"
+  (hk-deep-force
+    (hk-run
+      "main = catch (catch (error \"inner\") (\\(SomeException m) -> error (m ++ \"-rethrown\"))) (\\(SomeException m) -> return m)"))
+  (list "IO" "inner-rethrown"))
+
+(hk-test
+  "catch chain — handler can succeed inside IO"
+  (hk-deep-force
+    (hk-run
+      "main = do { x <- catch (error \"e1\") (\\(SomeException m) -> return 100); return (x + 1) }"))
+  (list "IO" 101))
+
+(hk-test
+  "try then bind on Right"
+  (hk-deep-force
+    (hk-run
+      "branch (Right v) = return (v * 2)
+branch (Left _) = return 0
+main = do { r <- try (return 21); branch r }"))
+  (list "IO" 42))
+
+(hk-test
+  "try then bind on Left"
+  (hk-deep-force
+    (hk-run
+      "branch (Right _) = return \"ok\"
+branch (Left (SomeException m)) = return m
+main = do { r <- try (error \"failed\"); branch r }"))
+  (list "IO" "failed"))
+
+(hk-test
+  "catch — handler can use closed-over IORef"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef
+main = do
+  r <- IORef.newIORef 0
+  catch (error \"x\") (\\(SomeException m) -> IORef.writeIORef r 7)
+  v <- IORef.readIORef r
+  return v"))
+  (list "IO" 7))
--- a/lib/haskell/tests/instance-where.sx
+++ b/lib/haskell/tests/instance-where.sx
@@ -0,0 +1,31 @@
+;; instance-where.sx — Phase 13: where-clauses inside instance bodies.
+
+(hk-test
+  "instance method body with where-helper (Bool)"
+  (hk-deep-force
+    (hk-run
+      "class Greet a where\n  greet :: a -> String\ninstance Greet Bool where\n  greet x = mkMsg x\n    where mkMsg True = \"yes\"\n          mkMsg False = \"no\"\nmain = greet True"))
+  "yes")
+
+(hk-test
+  "instance method body with where-helper (False branch)"
+  (hk-deep-force
+    (hk-run
+      "class Greet a where\n  greet :: a -> String\ninstance Greet Bool where\n  greet x = mkMsg x\n    where mkMsg True = \"yes\"\n          mkMsg False = \"no\"\nmain = greet False"))
+  "no")
+
+(hk-test
+  "instance method body with where-binding referenced multiple times"
+  (hk-deep-force
+    (hk-run
+      "class Twice a where\n  twice :: a -> Int\ninstance Twice Int where\n  twice x = h + h\n    where h = x + 1\nmain = twice 5"))
+  12)
+
+(hk-test
+  "instance method body with multi-binding where"
+  (hk-deep-force
+    (hk-run
+      "class Calc a where\n  calc :: a -> Int\ninstance Calc Int where\n  calc x = a + b\n    where a = x * 2\n          b = x + 1\nmain = calc 3"))
+  10)
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/io-input.sx
+++ b/lib/haskell/tests/io-input.sx
@@ -64,12 +64,11 @@

 (hk-test
  "readFile error on missing file"
-  (guard
-    (e (true (>= (index-of e "file not found") 0)))
-    (begin
-      (set! hk-vfs (dict))
-      (hk-run-io "main = readFile \"no.txt\" >>= putStrLn")
-      false))
+  (begin
+    (set! hk-vfs (dict))
+    (let
+      ((lines (hk-run-io "main = readFile \"no.txt\" >>= putStrLn")))
+      (>= (index-of (str lines) "file not found") 0)))
  true)

 (hk-test
--- a/lib/haskell/tests/ioref.sx
+++ b/lib/haskell/tests/ioref.sx
@@ -0,0 +1,94 @@
+;; Phase 15 — IORef unit tests.
+
+(hk-test
+  "newIORef + readIORef returns initial value"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nmain = do { r <- IORef.newIORef 42; v <- IORef.readIORef r; return v }"))
+  (list "IO" 42))
+
+(hk-test
+  "writeIORef updates the cell"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nmain = do { r <- IORef.newIORef 0; IORef.writeIORef r 99; v <- IORef.readIORef r; return v }"))
+  (list "IO" 99))
+
+(hk-test
+  "writeIORef returns IO ()"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nmain = do { r <- IORef.newIORef 0; IORef.writeIORef r 1 }"))
+  (list "IO" (list "Tuple")))
+
+(hk-test
+  "modifyIORef applies a function"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nmain = do { r <- IORef.newIORef 5; IORef.modifyIORef r (\\x -> x * 2); v <- IORef.readIORef r; return v }"))
+  (list "IO" 10))
+
+(hk-test
+  "modifyIORef' (strict) applies a function"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nmain = do { r <- IORef.newIORef 7; IORef.modifyIORef' r (\\x -> x + 3); v <- IORef.readIORef r; return v }"))
+  (list "IO" 10))
+
+(hk-test
+  "two reads return the same value"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nmain = do { r <- IORef.newIORef 11; a <- IORef.readIORef r; b <- IORef.readIORef r; return (a + b) }"))
+  (list "IO" 22))
+
+(hk-test
+  "shared ref across do-steps: write then read"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nmain = do { r <- IORef.newIORef 1; IORef.writeIORef r 2; IORef.writeIORef r 3; v <- IORef.readIORef r; return v }"))
+  (list "IO" 3))
+
+(hk-test
+  "two refs are independent"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nmain = do { r1 <- IORef.newIORef 1; r2 <- IORef.newIORef 2; IORef.writeIORef r1 10; a <- IORef.readIORef r1; b <- IORef.readIORef r2; return (a + b) }"))
+  (list "IO" 12))
+
+(hk-test
+  "string-valued IORef"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nmain = do { r <- IORef.newIORef \"hi\"; IORef.writeIORef r \"bye\"; v <- IORef.readIORef r; return v }"))
+  (list "IO" "bye"))
+
+(hk-test
+  "list-valued IORef + cons"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nmain = do { r <- IORef.newIORef [1,2,3]; IORef.modifyIORef r (\\xs -> 0 : xs); v <- IORef.readIORef r; return v }"))
+  (list
+    "IO"
+    (list ":" 0 (list ":" 1 (list ":" 2 (list ":" 3 (list "[]")))))))
+
+(hk-test
+  "counter loop: increment N times"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nloop r 0 = return ()\nloop r n = do { IORef.modifyIORef r (\\x -> x + 1); loop r (n - 1) }\nmain = do { r <- IORef.newIORef 0; loop r 10; v <- IORef.readIORef r; return v }"))
+  (list "IO" 10))
+
+(hk-test
+  "modifyIORef' inside a loop"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\ngo r 0 = return ()\ngo r n = do { IORef.modifyIORef' r (\\x -> x + n); go r (n - 1) }\nmain = do { r <- IORef.newIORef 0; go r 5; v <- IORef.readIORef r; return v }"))
+  (list "IO" 15))
+
+(hk-test
+  "newIORef inside a function passed via parameter"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef\nbump r = IORef.modifyIORef r (\\x -> x + 100)\nmain = do { r <- IORef.newIORef 1; bump r; v <- IORef.readIORef r; return v }"))
+  (list "IO" 101))
--- a/lib/haskell/tests/map.sx
+++ b/lib/haskell/tests/map.sx
@@ -0,0 +1,196 @@
+;; map.sx — Phase 11 Data.Map unit tests.
+;;
+;; Tests both the SX-level `hk-map-*` helpers and the Haskell-level
+;; `Map.*` aliases bound by the import handler.
+
+(define
+  hk-as-list
+  (fn
+    (xs)
+    (cond
+      ((and (list? xs) (= (first xs) "[]")) (list))
+      ((and (list? xs) (= (first xs) ":"))
+        (cons (nth xs 1) (hk-as-list (nth xs 2))))
+      (:else xs))))
+
+;; ── SX-level (direct hk-map-*) ───────────────────────────────
+(hk-test
+  "hk-map-empty: size 0, null true"
+  (list (hk-map-size hk-map-empty) (hk-map-null hk-map-empty))
+  (list 0 true))
+
+(hk-test
+  "hk-map-singleton: lookup hit"
+  (let
+    ((m (hk-map-singleton 5 "five")))
+    (list (hk-map-size m) (hk-map-lookup 5 m)))
+  (list 1 (list "Just" "five")))
+
+(hk-test
+  "hk-map-insert: lookup hit on inserted"
+  (let ((m (hk-map-insert 1 "a" hk-map-empty))) (hk-map-lookup 1 m))
+  (list "Just" "a"))
+
+(hk-test
+  "hk-map-lookup: miss returns Nothing"
+  (hk-map-lookup 99 (hk-map-singleton 1 "a"))
+  (list "Nothing"))
+
+(hk-test
+  "hk-map-insert: overwrites existing key"
+  (let
+    ((m (hk-map-insert 1 "second" (hk-map-insert 1 "first" hk-map-empty))))
+    (hk-map-lookup 1 m))
+  (list "Just" "second"))
+
+(hk-test
+  "hk-map-delete: removes key"
+  (let
+    ((m (hk-map-insert 2 "b" (hk-map-insert 1 "a" hk-map-empty))))
+    (let
+      ((m2 (hk-map-delete 1 m)))
+      (list (hk-map-size m2) (hk-map-lookup 1 m2) (hk-map-lookup 2 m2))))
+  (list 1 (list "Nothing") (list "Just" "b")))
+
+(hk-test
+  "hk-map-delete: missing key is no-op"
+  (let ((m (hk-map-singleton 1 "a"))) (hk-map-size (hk-map-delete 99 m)))
+  1)
+
+(hk-test
+  "hk-map-member: true on existing"
+  (hk-map-member 1 (hk-map-singleton 1 "a"))
+  true)
+
+(hk-test
+  "hk-map-member: false on missing"
+  (hk-map-member 99 (hk-map-singleton 1 "a"))
+  false)
+
+(hk-test
+  "hk-map-from-list: builds map; keys sorted"
+  (hk-map-keys
+    (hk-map-from-list
+      (list (list 3 "c") (list 1 "a") (list 5 "e") (list 2 "b"))))
+  (list 1 2 3 5))
+
+(hk-test
+  "hk-map-from-list: duplicates — last wins"
+  (hk-map-lookup
+    1
+    (hk-map-from-list (list (list 1 "first") (list 1 "second"))))
+  (list "Just" "second"))
+
+(hk-test
+  "hk-map-to-asc-list: ordered traversal"
+  (hk-map-to-asc-list
+    (hk-map-from-list (list (list 3 "c") (list 1 "a") (list 2 "b"))))
+  (list (list 1 "a") (list 2 "b") (list 3 "c")))
+
+(hk-test
+  "hk-map-elems: in key order"
+  (hk-map-elems
+    (hk-map-from-list (list (list 3 30) (list 1 10) (list 2 20))))
+  (list 10 20 30))
+
+(hk-test
+  "hk-map-union-with: combines duplicates"
+  (hk-map-to-asc-list
+    (hk-map-union-with
+      (fn (a b) (str a "+" b))
+      (hk-map-from-list (list (list 1 "a") (list 2 "b")))
+      (hk-map-from-list (list (list 2 "B") (list 3 "c")))))
+  (list (list 1 "a") (list 2 "b+B") (list 3 "c")))
+
+(hk-test
+  "hk-map-intersection-with: keeps shared keys"
+  (hk-map-to-asc-list
+    (hk-map-intersection-with
+      +
+      (hk-map-from-list (list (list 1 10) (list 2 20)))
+      (hk-map-from-list (list (list 2 200) (list 3 30)))))
+  (list (list 2 220)))
+
+(hk-test
+  "hk-map-difference: drops m2 keys"
+  (hk-map-keys
+    (hk-map-difference
+      (hk-map-from-list (list (list 1 "a") (list 2 "b") (list 3 "c")))
+      (hk-map-from-list (list (list 2 "x")))))
+  (list 1 3))
+
+(hk-test
+  "hk-map-foldl-with-key: in-order accumulate"
+  (hk-map-foldl-with-key
+    (fn (acc k v) (str acc k v))
+    ""
+    (hk-map-from-list (list (list 3 "c") (list 1 "a") (list 2 "b"))))
+  "1a2b3c")
+
+(hk-test
+  "hk-map-map-with-key: transforms values"
+  (hk-map-to-asc-list
+    (hk-map-map-with-key
+      (fn (k v) (* k v))
+      (hk-map-from-list (list (list 2 10) (list 3 100)))))
+  (list (list 2 20) (list 3 300)))
+
+(hk-test
+  "hk-map-filter-with-key: keeps matches"
+  (hk-map-keys
+    (hk-map-filter-with-key
+      (fn (k v) (> k 1))
+      (hk-map-from-list (list (list 1 "a") (list 2 "b") (list 3 "c")))))
+  (list 2 3))
+
+(hk-test
+  "hk-map-adjust: applies f to existing"
+  (hk-map-lookup
+    1
+    (hk-map-adjust (fn (v) (* v 10)) 1 (hk-map-singleton 1 5)))
+  (list "Just" 50))
+
+(hk-test
+  "hk-map-insert-with: combines on existing"
+  (hk-map-lookup 1 (hk-map-insert-with + 1 5 (hk-map-singleton 1 10)))
+  (list "Just" 15))
+
+(hk-test
+  "hk-map-alter: Nothing → delete"
+  (hk-map-size
+    (hk-map-alter
+      (fn (mv) (list "Nothing"))
+      1
+      (hk-map-from-list (list (list 1 "a") (list 2 "b")))))
+  1)
+
+;; ── Haskell-level (Map.*) via import wiring ─────────────────
+(hk-test
+  "Map.size after Map.insert chain"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.Map as Map\nmain = Map.size (Map.insert 2 \"b\" (Map.insert 1 \"a\" Map.empty))"))
+  2)
+
+(hk-test
+  "Map.lookup hit"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.Map as Map\nmain = Map.lookup 1 (Map.insert 1 \"a\" Map.empty)"))
+  (list "Just" "a"))
+
+(hk-test
+  "Map.lookup miss"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.Map as Map\nmain = Map.lookup 99 (Map.insert 1 \"a\" Map.empty)"))
+  (list "Nothing"))
+
+(hk-test
+  "Map.member true"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.Map as Map\nmain = Map.member 5 (Map.insert 5 \"x\" Map.empty)"))
+  (list "True"))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/numerics.sx
+++ b/lib/haskell/tests/numerics.sx
@@ -0,0 +1,180 @@
+;; numerics.sx — Phase 10 numeric tower verification.
+;;
+;; Practical integer-precision limit in Haskell-on-SX:
+;;   • Raw SX `(* a b)` stays exact up to ±2^62 (≈ 4.6e18, OCaml int63).
+;;   • BUT the Haskell tokenizer/parser parses an integer literal as a float
+;;     once it exceeds 2^53 (≈ 9.007e15). Once any operand is a float, the
+;;     binop result is a float (and decimal-precision is lost past 2^53).
+;;   • Therefore: programs that stay below ~9e15 are exact; larger literals
+;;     or accumulated products silently become floats. `factorial 18` is the
+;;     last factorial that stays exact (6.4e15); `factorial 19` already floats.
+;;
+;; In Haskell terms, `Int` and `Integer` both currently map to SX number, so
+;; we don't yet support arbitrary-precision Integer. Documented; unbounded
+;; Integer is out of scope for Phase 10 — see Phase 11+ if it becomes needed.
+
+(define
+  hk-as-list
+  (fn
+    (xs)
+    (cond
+      ((and (list? xs) (= (first xs) "[]")) (list))
+      ((and (list? xs) (= (first xs) ":"))
+        (cons (nth xs 1) (hk-as-list (nth xs 2))))
+      (:else xs))))
+
+(hk-test
+  "factorial 10 = 3628800 (small, exact)"
+  (hk-deep-force
+    (hk-run "fact 0 = 1\nfact n = n * fact (n - 1)\nmain = fact 10"))
+  3628800)
+
+(hk-test
+  "factorial 15 = 1307674368000 (mid-range, exact)"
+  (hk-deep-force
+    (hk-run "fact 0 = 1\nfact n = n * fact (n - 1)\nmain = fact 15"))
+  1307674368000)
+
+(hk-test
+  "factorial 18 = 6402373705728000 (last exact factorial)"
+  (hk-deep-force
+    (hk-run "fact 0 = 1\nfact n = n * fact (n - 1)\nmain = fact 18"))
+  6402373705728000)
+
+(hk-test
+  "1000000 * 1000000 = 10^12 (exact)"
+  (hk-deep-force (hk-run "main = 1000000 * 1000000"))
+  1000000000000)
+
+(hk-test
+  "1000000000 * 1000000000 = 10^18 (exact, at boundary)"
+  (hk-deep-force (hk-run "main = 1000000000 * 1000000000"))
+  1e+18)
+
+(hk-test
+  "2^62 boundary: pow accumulates exactly"
+  (hk-deep-force
+    (hk-run "pow b 0 = 1\npow b n = b * pow b (n - 1)\nmain = pow 2 62"))
+  4.6116860184273879e+18)
+
+(hk-test
+  "show factorial 12 = 479001600 (whole, fits in 32-bit)"
+  (hk-deep-force
+    (hk-run "fact 0 = 1\nfact n = n * fact (n - 1)\nmain = show (fact 12)"))
+  "479001600")
+
+(hk-test
+  "negate large positive — preserves magnitude"
+  (hk-deep-force (hk-run "main = negate 1000000000000000000"))
+  -1e+18)
+
+(hk-test
+  "abs negative large — preserves magnitude"
+  (hk-deep-force (hk-run "main = abs (negate 1000000000000000000)"))
+  1e+18)
+
+(hk-test
+  "div on large ints"
+  (hk-deep-force (hk-run "main = div 1000000000000000000 1000000000"))
+  1000000000)
+
+(hk-test
+  "fromIntegral 42 = 42 (identity in our runtime)"
+  (hk-deep-force (hk-run "main = fromIntegral 42"))
+  42)
+
+(hk-test
+  "fromIntegral preserves negative"
+  (hk-deep-force (hk-run "main = fromIntegral (negate 7)"))
+  -7)
+
+(hk-test
+  "fromIntegral round-trips through arithmetic"
+  (hk-deep-force (hk-run "main = fromIntegral 5 + fromIntegral 3"))
+  8)
+
+(hk-test
+  "fromIntegral in a program (mixing with map)"
+  (hk-as-list (hk-deep-force (hk-run "main = map fromIntegral [1,2,3]")))
+  (list 1 2 3))
+
+(hk-test
+  "toInteger 100 = 100 (identity)"
+  (hk-deep-force (hk-run "main = toInteger 100"))
+  100)
+
+(hk-test
+  "fromInteger 7 = 7 (identity)"
+  (hk-deep-force (hk-run "main = fromInteger 7"))
+  7)
+
+(hk-test
+  "toInteger / fromInteger round-trip"
+  (hk-deep-force (hk-run "main = fromInteger (toInteger 42)"))
+  42)
+
+(hk-test
+  "toInteger preserves negative"
+  (hk-deep-force (hk-run "main = toInteger (negate 13)"))
+  -13)
+
+(hk-test
+  "show 3.14 = 3.14"
+  (hk-deep-force (hk-run "main = show 3.14"))
+  "3.14")
+
+(hk-test
+  "show 1.0e10 — whole-valued float renders as decimal (int/float ambiguity)"
+  (hk-deep-force (hk-run "main = show 1.0e10"))
+  "10000000000")
+
+(hk-test
+  "show 0.001 uses scientific form (sub-0.1)"
+  (hk-deep-force (hk-run "main = show 0.001"))
+  "1.0e-3")
+
+(hk-test
+  "show negative float"
+  (hk-deep-force (hk-run "main = show (negate 3.14)"))
+  "-3.14")
+
+(hk-test "sqrt 16 = 4" (hk-deep-force (hk-run "main = sqrt 16")) 4)
+
+(hk-test "floor 3.7 = 3" (hk-deep-force (hk-run "main = floor 3.7")) 3)
+
+(hk-test "ceiling 3.2 = 4" (hk-deep-force (hk-run "main = ceiling 3.2")) 4)
+
+(hk-test
+  "ceiling on whole = self"
+  (hk-deep-force (hk-run "main = ceiling 4"))
+  4)
+
+(hk-test "round 2.6 = 3" (hk-deep-force (hk-run "main = round 2.6")) 3)
+
+(hk-test
+  "truncate -3.7 = -3"
+  (hk-deep-force (hk-run "main = truncate (negate 3.7)"))
+  -3)
+
+(hk-test "recip 4.0 = 0.25" (hk-deep-force (hk-run "main = recip 4.0")) 0.25)
+
+(hk-test "1.0 / 4.0 = 0.25" (hk-deep-force (hk-run "main = 1.0 / 4.0")) 0.25)
+
+(hk-test
+  "fromRational 0.5 = 0.5 (identity)"
+  (hk-deep-force (hk-run "main = fromRational 0.5"))
+  0.5)
+
+(hk-test "pi ≈ 3.14159" (hk-deep-force (hk-run "main = pi")) 3.14159)
+
+(hk-test "exp 0 = 1" (hk-deep-force (hk-run "main = exp 0")) 1)
+
+(hk-test "sin 0 = 0" (hk-deep-force (hk-run "main = sin 0")) 0)
+
+(hk-test "cos 0 = 1" (hk-deep-force (hk-run "main = cos 0")) 1)
+
+(hk-test "2 ** 10 = 1024" (hk-deep-force (hk-run "main = 2 ** 10")) 1024)
+
+(hk-test "log (exp 5) ≈ 5" (hk-deep-force (hk-run "main = log (exp 5)")) 5)
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/parse-extras.sx
+++ b/lib/haskell/tests/parse-extras.sx
@@ -0,0 +1,102 @@
+;; Phase 17 — parser polish unit tests.
+
+(hk-test
+  "type-ann: literal int annotated"
+  (hk-deep-force (hk-run "main = (42 :: Int)"))
+  42)
+
+(hk-test
+  "type-ann: arithmetic annotated"
+  (hk-deep-force (hk-run "main = (1 + 2 :: Int)"))
+  3)
+
+(hk-test
+  "type-ann: function arg annotated"
+  (hk-deep-force
+    (hk-run "f x = x + 1\nmain = f (1 :: Int)"))
+  2)
+
+(hk-test
+  "type-ann: string annotated"
+  (hk-deep-force (hk-run "main = (\"hi\" :: String)"))
+  "hi")
+
+(hk-test
+  "type-ann: bool annotated"
+  (hk-deep-force (hk-run "main = (True :: Bool)"))
+  (list "True"))
+
+(hk-test
+  "type-ann: tuple annotated"
+  (hk-deep-force (hk-run "main = ((1, 2) :: (Int, Int))"))
+  (list "Tuple" 1 2))
+
+(hk-test
+  "type-ann: nested annotation in arithmetic"
+  (hk-deep-force (hk-run "main = (1 :: Int) + (2 :: Int)"))
+  3)
+
+(hk-test
+  "type-ann: function-typed annotation passes through eval"
+  (hk-deep-force
+    (hk-run "main = let f = ((\\x -> x + 1) :: Int -> Int) in f 5"))
+  6)
+
+(hk-test
+  "no regression: plain parens still work"
+  (hk-deep-force (hk-run "main = (5)"))
+  5)
+
+(hk-test
+  "no regression: 3-tuple still works"
+  (hk-deep-force (hk-run "main = (1, 2, 3)"))
+  (list "Tuple" 1 2 3))
+
+(hk-test
+  "no regression: section-left still works"
+  (hk-deep-force (hk-run "main = (3 +) 4"))
+  7)
+
+(hk-test
+  "no regression: section-right still works"
+  (hk-deep-force (hk-run "main = (+ 3) 4"))
+  7)
+
+(hk-test
+  "import: still works as the very first decl"
+  (hk-deep-force
+    (hk-run "import qualified Data.IORef as I
+main = do { r <- I.newIORef 7; I.readIORef r }"))
+  (list "IO" 7))
+
+(hk-test
+  "import: between decls — after main"
+  (hk-deep-force
+    (hk-run "main = do { r <- I.newIORef 11; I.readIORef r }
+import qualified Data.IORef as I"))
+  (list "IO" 11))
+
+(hk-test
+  "import: between two decls — uses helper after import"
+  (hk-deep-force
+    (hk-run "f x = x + 100
+import qualified Data.IORef as I
+main = do { r <- I.newIORef 5; I.modifyIORef r f; I.readIORef r }"))
+  (list "IO" 105))
+
+(hk-test
+  "import: two imports in different positions"
+  (hk-deep-force
+    (hk-run "import qualified Data.IORef as I
+helper x = x * 2
+import qualified Data.Map as M
+main = do { r <- I.newIORef (helper 21); I.readIORef r }"))
+  (list "IO" 42))
+
+(hk-test
+  "import: unqualified, mid-file"
+  (hk-deep-force
+    (hk-run "go x = x
+import Data.IORef
+main = go 9"))
+  9)
--- a/lib/haskell/tests/program-accumulate.sx
+++ b/lib/haskell/tests/program-accumulate.sx
@@ -0,0 +1,81 @@
+;; accumulate.hs — accumulate results into an IORef [Int] (Phase 15 conformance).
+
+(define
+  hk-accumulate-source
+  "import qualified Data.IORef as IORef\n\npush :: IORef [Int] -> Int -> IO ()\npush r x = IORef.modifyIORef r (\\xs -> x : xs)\n\npushAll :: IORef [Int] -> [Int] -> IO ()\npushAll r [] = return ()\npushAll r (x:xs) = do\n  push r x\n  pushAll r xs\n\nreadReversed :: IORef [Int] -> IO [Int]\nreadReversed r = do\n  xs <- IORef.readIORef r\n  return (reverse xs)\n\ndoubleEach :: IORef [Int] -> [Int] -> IO ()\ndoubleEach r [] = return ()\ndoubleEach r (x:xs) = do\n  push r (x * 2)\n  doubleEach r xs\n\nsumIntoRef :: IORef Int -> [Int] -> IO ()\nsumIntoRef r [] = return ()\nsumIntoRef r (x:xs) = do\n  IORef.modifyIORef r (\\acc -> acc + x)\n  sumIntoRef r xs\n\n")
+
+(hk-test
+  "accumulate.hs — push three then read length"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-accumulate-source
+        "main = do { r <- IORef.newIORef []; push r 1; push r 2; push r 3; xs <- IORef.readIORef r; return (length xs) }")))
+  (list "IO" 3))
+
+(hk-test
+  "accumulate.hs — pushAll preserves reverse order"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-accumulate-source
+        "main = do { r <- IORef.newIORef []; pushAll r [1,2,3,4]; xs <- IORef.readIORef r; return xs }")))
+  (list
+    "IO"
+    (list ":" 4 (list ":" 3 (list ":" 2 (list ":" 1 (list "[]")))))))
+
+(hk-test
+  "accumulate.hs — readReversed gives original order"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-accumulate-source
+        "main = do { r <- IORef.newIORef []; pushAll r [10,20,30]; readReversed r }")))
+  (list "IO" (list ":" 10 (list ":" 20 (list ":" 30 (list "[]"))))))
+
+(hk-test
+  "accumulate.hs — doubleEach maps then accumulates"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-accumulate-source
+        "main = do { r <- IORef.newIORef []; doubleEach r [1,2,3]; readReversed r }")))
+  (list "IO" (list ":" 2 (list ":" 4 (list ":" 6 (list "[]"))))))
+
+(hk-test
+  "accumulate.hs — sum into Int IORef"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-accumulate-source
+        "main = do { r <- IORef.newIORef 0; sumIntoRef r [1,2,3,4,5]; v <- IORef.readIORef r; return v }")))
+  (list "IO" 15))
+
+(hk-test
+  "accumulate.hs — empty list leaves ref untouched"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-accumulate-source
+        "main = do { r <- IORef.newIORef [99]; pushAll r []; xs <- IORef.readIORef r; return xs }")))
+  (list "IO" (list ":" 99 (list "[]"))))
+
+(hk-test
+  "accumulate.hs — pushAll then sumIntoRef on the same input"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-accumulate-source
+        "main = do { r <- IORef.newIORef 0; sumIntoRef r [10,20,30,40]; v <- IORef.readIORef r; return v }")))
+  (list "IO" 100))
+
+(hk-test
+  "accumulate.hs — accumulate results from a recursive helper"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-accumulate-source
+        "squaresUpTo r 0 = return ()\nsquaresUpTo r n = do { push r (n * n); squaresUpTo r (n - 1) }\nmain = do { r <- IORef.newIORef []; squaresUpTo r 4; readReversed r }")))
+  (list
+    "IO"
+    (list ":" 16 (list ":" 9 (list ":" 4 (list ":" 1 (list "[]")))))))
--- a/lib/haskell/tests/program-caesar.sx
+++ b/lib/haskell/tests/program-caesar.sx
@@ -0,0 +1,80 @@
+;; caesar.hs — Caesar cipher.
+;; Source: https://rosettacode.org/wiki/Caesar_cipher#Haskell (adapted).
+;;
+;; Exercises chr, ord, isUpper, isLower, mod, string pattern matching
+;; (x:xs) over a String (which is now a [Char] string view), and map
+;; from the Phase 7 string=[Char] foundation.
+
+(define
+  hk-prog-val
+  (fn
+    (src name)
+    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))
+
+(define
+  hk-as-list
+  (fn
+    (xs)
+    (cond
+      ((and (list? xs) (= (first xs) "[]")) (list))
+      ((and (list? xs) (= (first xs) ":"))
+        (cons (nth xs 1) (hk-as-list (nth xs 2))))
+      (:else xs))))
+
+(define
+  hk-caesar-source
+  "shift n c = if isUpper c\n              then chr (mod ((ord c) - 65 + n) 26 + 65)\n              else if isLower c\n                     then chr (mod ((ord c) - 97 + n) 26 + 97)\n                     else chr c\n\ncaesarRec n []     = []\ncaesarRec n (x:xs) = shift n x : caesarRec n xs\n\ncaesarMap n s = map (shift n) s\n")
+
+(hk-test
+  "caesar.hs — caesarRec 3 \"ABC\" = DEF"
+  (hk-as-list
+    (hk-prog-val (str hk-caesar-source "r = caesarRec 3 \"ABC\"\n") "r"))
+  (list "D" "E" "F"))
+
+(hk-test
+  "caesar.hs — caesarRec 13 \"Hello\" = Uryyb"
+  (hk-as-list
+    (hk-prog-val (str hk-caesar-source "r = caesarRec 13 \"Hello\"\n") "r"))
+  (list "U" "r" "y" "y" "b"))
+
+(hk-test
+  "caesar.hs — caesarRec 1 \"AZ\" wraps to BA"
+  (hk-as-list
+    (hk-prog-val (str hk-caesar-source "r = caesarRec 1 \"AZ\"\n") "r"))
+  (list "B" "A"))
+
+(hk-test
+  "caesar.hs — caesarRec 0 \"World\" identity"
+  (hk-as-list
+    (hk-prog-val (str hk-caesar-source "r = caesarRec 0 \"World\"\n") "r"))
+  (list "W" "o" "r" "l" "d"))
+
+(hk-test
+  "caesar.hs — caesarRec preserves punctuation"
+  (hk-as-list
+    (hk-prog-val (str hk-caesar-source "r = caesarRec 3 \"Hi!\"\n") "r"))
+  (list "K" "l" "!"))
+
+(hk-test
+  "caesar.hs — caesarMap 3 \"abc\" via map"
+  (hk-as-list
+    (hk-prog-val (str hk-caesar-source "r = caesarMap 3 \"abc\"\n") "r"))
+  (list "d" "e" "f"))
+
+(hk-test
+  "caesar.hs — caesarMap 13 round-trips with caesarMap 13"
+  (hk-as-list
+    (hk-prog-val
+      (str
+        hk-caesar-source
+        "r = caesarMap 13 (foldr (\\c acc -> c : acc) [] (caesarMap 13 \"Hello\"))\n")
+      "r"))
+  (list "H" "e" "l" "l" "o"))
+
+(hk-test
+  "caesar.hs — caesarRec 25 \"AB\" = ZA"
+  (hk-as-list
+    (hk-prog-val (str hk-caesar-source "r = caesarRec 25 \"AB\"\n") "r"))
+  (list "Z" "A"))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-config.sx
+++ b/lib/haskell/tests/program-config.sx
@@ -0,0 +1,63 @@
+;; config.hs — multi-field config record; partial update; defaultConfig
+;;            constant.
+;;
+;; Exercises Phase 14: 4-field record, defaultConfig as a CAF, partial
+;; updates that change one or two fields, accessors over derived configs.
+
+(define
+  hk-config-source
+  "data Config = Config { host :: String, port :: Int, retries :: Int, debug :: Bool } deriving (Show)\n\ndefaultConfig = Config { host = \"localhost\", port = 8080, retries = 3, debug = False }\n\ndevConfig = defaultConfig { debug = True }\nremoteConfig = defaultConfig { host = \"api.example.com\", port = 443 }\n")
+
+(hk-test
+  "config.hs — defaultConfig host"
+  (hk-deep-force (hk-run (str hk-config-source "main = host defaultConfig")))
+  "localhost")
+
+(hk-test
+  "config.hs — defaultConfig port"
+  (hk-deep-force (hk-run (str hk-config-source "main = port defaultConfig")))
+  8080)
+
+(hk-test
+  "config.hs — defaultConfig retries"
+  (hk-deep-force
+    (hk-run (str hk-config-source "main = retries defaultConfig")))
+  3)
+
+(hk-test
+  "config.hs — devConfig flips debug"
+  (hk-deep-force (hk-run (str hk-config-source "main = debug devConfig")))
+  (list "True"))
+
+(hk-test
+  "config.hs — devConfig preserves host"
+  (hk-deep-force (hk-run (str hk-config-source "main = host devConfig")))
+  "localhost")
+
+(hk-test
+  "config.hs — devConfig preserves port"
+  (hk-deep-force (hk-run (str hk-config-source "main = port devConfig")))
+  8080)
+
+(hk-test
+  "config.hs — remoteConfig new host"
+  (hk-deep-force (hk-run (str hk-config-source "main = host remoteConfig")))
+  "api.example.com")
+
+(hk-test
+  "config.hs — remoteConfig new port"
+  (hk-deep-force (hk-run (str hk-config-source "main = port remoteConfig")))
+  443)
+
+(hk-test
+  "config.hs — remoteConfig preserves retries"
+  (hk-deep-force
+    (hk-run (str hk-config-source "main = retries remoteConfig")))
+  3)
+
+(hk-test
+  "config.hs — remoteConfig preserves debug"
+  (hk-deep-force (hk-run (str hk-config-source "main = debug remoteConfig")))
+  (list "False"))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-counter.sx
+++ b/lib/haskell/tests/program-counter.sx
@@ -0,0 +1,66 @@
+;; counter.hs — IORef-backed mutable counter (Phase 15 conformance).
+
+(define
+  hk-counter-source
+  "import qualified Data.IORef as IORef\n\ncount :: IORef Int -> Int -> IO ()\ncount r 0 = return ()\ncount r n = do\n  IORef.modifyIORef r (\\x -> x + 1)\n  count r (n - 1)\n\ncountBy :: IORef Int -> Int -> Int -> IO ()\ncountBy r step 0 = return ()\ncountBy r step n = do\n  IORef.modifyIORef r (\\x -> x + step)\n  countBy r step (n - 1)\n\nnewCounter :: Int -> IO (IORef Int)\nnewCounter v = IORef.newIORef v\n\nbumpAndRead :: IORef Int -> IO Int\nbumpAndRead r = do\n  IORef.modifyIORef r (\\x -> x + 1)\n  IORef.readIORef r\n\n")
+
+(hk-test
+  "counter.hs — start at 0, count 5 ⇒ 5"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-counter-source
+        "main = do { r <- newCounter 0; count r 5; v <- IORef.readIORef r; return v }")))
+  (list "IO" 5))
+
+(hk-test
+  "counter.hs — start at 100, count 10 ⇒ 110"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-counter-source
+        "main = do { r <- newCounter 100; count r 10; v <- IORef.readIORef r; return v }")))
+  (list "IO" 110))
+
+(hk-test
+  "counter.hs — countBy step 5, n 4 ⇒ 20"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-counter-source
+        "main = do { r <- newCounter 0; countBy r 5 4; v <- IORef.readIORef r; return v }")))
+  (list "IO" 20))
+
+(hk-test
+  "counter.hs — bumpAndRead returns updated value"
+  (hk-deep-force
+    (hk-run
+      (str hk-counter-source "main = do { r <- newCounter 41; bumpAndRead r }")))
+  (list "IO" 42))
+
+(hk-test
+  "counter.hs — count then countBy compose"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-counter-source
+        "main = do { r <- newCounter 0; count r 3; countBy r 10 2; v <- IORef.readIORef r; return v }")))
+  (list "IO" 23))
+
+(hk-test
+  "counter.hs — two independent counters"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-counter-source
+        "main = do { a <- newCounter 0; b <- newCounter 0; count a 7; countBy b 100 2; va <- IORef.readIORef a; vb <- IORef.readIORef b; return (va + vb) }")))
+  (list "IO" 207))
+
+(hk-test
+  "counter.hs — modifyIORef' (strict) variant"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-counter-source
+        "tick r 0 = return ()\ntick r n = do { IORef.modifyIORef' r (\\x -> x + 1); tick r (n - 1) }\nmain = do { r <- newCounter 0; tick r 50; v <- IORef.readIORef r; return v }")))
+  (list "IO" 50))
--- a/lib/haskell/tests/program-mapgraph.sx
+++ b/lib/haskell/tests/program-mapgraph.sx
@@ -0,0 +1,46 @@
+;; mapgraph.hs — adjacency-list using Data.Map (BFS-style traversal).
+;;
+;; Exercises Phase 11: `import qualified Data.Map as Map`, `Map.empty`,
+;; `Map.insert`, `Map.lookup`, `Map.findWithDefault`. Adjacency lists are
+;; stored as `Map Int [Int]`; `neighbors` does a default-empty lookup.
+
+(define
+  hk-mapgraph-source
+  "import qualified Data.Map as Map\n\nemptyG = Map.empty\n\naddEdge u v g = Map.insertWith add u [v] g\n  where add new old = new ++ old\n\nbuild = addEdge 1 2 (addEdge 1 3 (addEdge 2 4 (addEdge 3 4 (addEdge 4 5 emptyG))))\n\nneighbors n g = Map.findWithDefault [] n g\n")
+
+(hk-test
+  "mapgraph.hs — neighbors of 1"
+  (hk-deep-force
+    (hk-run (str hk-mapgraph-source "main = neighbors 1 build\n")))
+  (list ":" 2 (list ":" 3 (list "[]"))))
+
+(hk-test
+  "mapgraph.hs — neighbors of 4"
+  (hk-deep-force
+    (hk-run (str hk-mapgraph-source "main = neighbors 4 build\n")))
+  (list ":" 5 (list "[]")))
+
+(hk-test
+  "mapgraph.hs — neighbors of 5 (leaf, no entry) defaults to []"
+  (hk-deep-force
+    (hk-run (str hk-mapgraph-source "main = neighbors 5 build\n")))
+  (list "[]"))
+
+(hk-test
+  "mapgraph.hs — neighbors of 99 (absent) defaults to []"
+  (hk-deep-force
+    (hk-run (str hk-mapgraph-source "main = neighbors 99 build\n")))
+  (list "[]"))
+
+(hk-test
+  "mapgraph.hs — Map.member 1"
+  (hk-deep-force
+    (hk-run (str hk-mapgraph-source "main = Map.member 1 build\n")))
+  (list "True"))
+
+(hk-test
+  "mapgraph.hs — Map.size = 4 source nodes"
+  (hk-deep-force (hk-run (str hk-mapgraph-source "main = Map.size build\n")))
+  4)
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-newton.sx
+++ b/lib/haskell/tests/program-newton.sx
@@ -0,0 +1,49 @@
+;; newton.hs — Newton's method for square root.
+;; Source: classic numerical analysis exercise.
+;;
+;; Exercises Phase 10: `Float`, `abs`, `/`, iteration via `until`.
+
+(define
+  hk-prog-val
+  (fn
+    (src name)
+    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))
+
+(define
+  hk-newton-source
+  "improve x guess = (guess + x / guess) / 2\n\ngoodEnough x guess = abs (guess * guess - x) < 0.0001\n\nnewtonSqrt x = newtonHelp x 1.0\n\nnewtonHelp x guess = if goodEnough x guess\n                       then guess\n                       else newtonHelp x (improve x guess)\n")
+
+(hk-test
+  "newton.hs — newtonSqrt 4 ≈ 2"
+  (hk-prog-val
+    (str hk-newton-source "r = abs (newtonSqrt 4.0 - 2.0) < 0.001\n")
+    "r")
+  (list "True"))
+
+(hk-test
+  "newton.hs — newtonSqrt 9 ≈ 3"
+  (hk-prog-val
+    (str hk-newton-source "r = abs (newtonSqrt 9.0 - 3.0) < 0.001\n")
+    "r")
+  (list "True"))
+
+(hk-test
+  "newton.hs — newtonSqrt 2 ≈ 1.41421"
+  (hk-prog-val
+    (str hk-newton-source "r = abs (newtonSqrt 2.0 - 1.41421) < 0.001\n")
+    "r")
+  (list "True"))
+
+(hk-test
+  "newton.hs — improve converges (one step)"
+  (hk-prog-val (str hk-newton-source "r = improve 4.0 1.0\n") "r")
+  2.5)
+
+(hk-test
+  "newton.hs — newtonSqrt 100 ≈ 10"
+  (hk-prog-val
+    (str hk-newton-source "r = abs (newtonSqrt 100.0 - 10.0) < 0.001\n")
+    "r")
+  (list "True"))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-partial.sx
+++ b/lib/haskell/tests/program-partial.sx
@@ -0,0 +1,58 @@
+;; partial.hs — exercises Phase 9 partial functions caught at the top level.
+;;
+;; Each program calls a partial function on bad input; hk-run-io catches the
+;; raise and appends the error message to io-lines so tests can inspect.
+
+(hk-test
+  "partial.hs — main = print (head [])"
+  (let
+    ((lines (hk-run-io "main = print (head [])")))
+    (>= (index-of (str lines) "Prelude.head: empty list") 0))
+  true)
+
+(hk-test
+  "partial.hs — main = print (tail [])"
+  (let
+    ((lines (hk-run-io "main = print (tail [])")))
+    (>= (index-of (str lines) "Prelude.tail: empty list") 0))
+  true)
+
+(hk-test
+  "partial.hs — main = print (fromJust Nothing)"
+  (let
+    ((lines (hk-run-io "main = print (fromJust Nothing)")))
+    (>= (index-of (str lines) "Maybe.fromJust: Nothing") 0))
+  true)
+
+(hk-test
+  "partial.hs — putStrLn before error preserves prior output"
+  (let
+    ((lines (hk-run-io "main = do { putStrLn \"step 1\"; putStrLn (show (head [])); putStrLn \"never\" }")))
+    (and
+      (>= (index-of (str lines) "step 1") 0)
+      (>= (index-of (str lines) "Prelude.head: empty list") 0)
+      (= (index-of (str lines) "never") -1)))
+  true)
+
+(hk-test
+  "partial.hs — undefined as IO action"
+  (let
+    ((lines (hk-run-io "main = print undefined")))
+    (>= (index-of (str lines) "Prelude.undefined") 0))
+  true)
+
+(hk-test
+  "partial.hs — catches error from a user-thrown error"
+  (let
+    ((lines (hk-run-io "main = error \"boom from main\"")))
+    (>= (index-of (str lines) "boom from main") 0))
+  true)
+
+;; Negative case: when no error is raised, io-lines doesn't contain
+;; "Prelude" prefixes from our error path.
+(hk-test
+  "partial.hs — happy path: head [42] succeeds, no error in output"
+  (hk-run-io "main = print (head [42])")
+  (list "42"))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-person.sx
+++ b/lib/haskell/tests/program-person.sx
@@ -0,0 +1,51 @@
+;; person.hs — record type with accessors, update, deriving Show.
+;;
+;; Exercises Phase 14: data with record syntax, accessor functions,
+;; record creation, record update, deriving Show on a record.
+
+(define
+  hk-person-source
+  "data Person = Person { name :: String, age :: Int } deriving (Show)\n\nalice = Person { name = \"alice\", age = 30 }\nbob = Person { name = \"bob\", age = 25 }\n\nbirthday p = p { age = age p + 1 }\n")
+
+(hk-test
+  "person.hs — alice's name"
+  (hk-deep-force (hk-run (str hk-person-source "main = name alice")))
+  "alice")
+
+(hk-test
+  "person.hs — alice's age"
+  (hk-deep-force (hk-run (str hk-person-source "main = age alice")))
+  30)
+
+(hk-test
+  "person.hs — birthday adds one year"
+  (hk-deep-force
+    (hk-run (str hk-person-source "main = age (birthday alice)")))
+  31)
+
+(hk-test
+  "person.hs — birthday preserves name"
+  (hk-deep-force
+    (hk-run (str hk-person-source "main = name (birthday alice)")))
+  "alice")
+
+(hk-test
+  "person.hs — show alice"
+  (hk-deep-force (hk-run (str hk-person-source "main = show alice")))
+  "Person \"alice\" 30")
+
+(hk-test
+  "person.hs — bob has different name"
+  (hk-deep-force (hk-run (str hk-person-source "main = name bob")))
+  "bob")
+
+(hk-test
+  "person.hs — pattern match in function"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-person-source
+        "greet (Person { name = n }) = \"Hi, \" ++ n\nmain = greet alice")))
+  "Hi, alice")
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-runlength-str.sx
+++ b/lib/haskell/tests/program-runlength-str.sx
@@ -0,0 +1,83 @@
+;; runlength-str.hs — run-length encoding on a String.
+;; Source: https://rosettacode.org/wiki/Run-length_encoding#Haskell (adapted).
+;;
+;; Exercises String pattern matching `(x:xs)`, `span` over a string view,
+;; tuple construction `(Int, Char)`, character equality, and tuple-in-cons
+;; patterns `((n, c) : rest)` — all enabled by Phase 7 string=[Char].
+
+(define
+  hk-prog-val
+  (fn
+    (src name)
+    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))
+
+(define
+  hk-as-list
+  (fn
+    (xs)
+    (cond
+      ((and (list? xs) (= (first xs) "[]")) (list))
+      ((and (list? xs) (= (first xs) ":"))
+        (cons (nth xs 1) (hk-as-list (nth xs 2))))
+      (:else xs))))
+
+(define
+  hk-rle-source
+  "encodeRL []     = []\nencodeRL (x:xs) = let (same, rest) = span eqX xs\n                      eqX y         = y == x\n                  in (1 + length same, x) : encodeRL rest\n\nreplicateRL 0 _ = []\nreplicateRL n c = c : replicateRL (n - 1) c\n\ndecodeRL []                = []\ndecodeRL ((n, c) : rest)   = replicateRL n c ++ decodeRL rest\n")
+
+(hk-test
+  "rle.hs — encodeRL [] = []"
+  (hk-as-list (hk-prog-val (str hk-rle-source "r = encodeRL \"\"\n") "r"))
+  (list))
+
+(hk-test
+  "rle.hs — length (encodeRL \"aabbbcc\") = 3"
+  (hk-prog-val (str hk-rle-source "r = length (encodeRL \"aabbbcc\")\n") "r")
+  3)
+
+(hk-test
+  "rle.hs — map fst (encodeRL \"aabbbcc\") = [2,3,2]"
+  (hk-as-list
+    (hk-prog-val (str hk-rle-source "r = map fst (encodeRL \"aabbbcc\")\n") "r"))
+  (list 2 3 2))
+
+(hk-test
+  "rle.hs — map snd (encodeRL \"aabbbcc\") = [97,98,99]"
+  (hk-as-list
+    (hk-prog-val (str hk-rle-source "r = map snd (encodeRL \"aabbbcc\")\n") "r"))
+  (list 97 98 99))
+
+(hk-test
+  "rle.hs — counts of encodeRL \"aabbbccddddee\" = [2,3,2,4,2]"
+  (hk-as-list
+    (hk-prog-val
+      (str hk-rle-source "r = map fst (encodeRL \"aabbbccddddee\")\n")
+      "r"))
+  (list 2 3 2 4 2))
+
+(hk-test
+  "rle.hs — chars of encodeRL \"aabbbccddddee\" = [97,98,99,100,101]"
+  (hk-as-list
+    (hk-prog-val
+      (str hk-rle-source "r = map snd (encodeRL \"aabbbccddddee\")\n")
+      "r"))
+  (list 97 98 99 100 101))
+
+(hk-test
+  "rle.hs — singleton encodeRL \"x\""
+  (hk-as-list
+    (hk-prog-val (str hk-rle-source "r = map fst (encodeRL \"x\")\n") "r"))
+  (list 1))
+
+(hk-test
+  "rle.hs — decodeRL round-trip preserves \"aabbbcc\""
+  (hk-as-list
+    (hk-prog-val (str hk-rle-source "r = decodeRL (encodeRL \"aabbbcc\")\n") "r"))
+  (list 97 97 98 98 98 99 99))
+
+(hk-test
+  "rle.hs — replicateRL 4 65 = [65,65,65,65]"
+  (hk-as-list (hk-prog-val (str hk-rle-source "r = replicateRL 4 65\n") "r"))
+  (list 65 65 65 65))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-safediv.sx
+++ b/lib/haskell/tests/program-safediv.sx
@@ -0,0 +1,80 @@
+;; safediv.hs — safe division using catch (Phase 16 conformance).
+
+(define
+  hk-safediv-source
+  "safeDiv :: Int -> Int -> IO Int
+safeDiv _ 0 = throwIO (SomeException \"division by zero\")
+safeDiv x y = return (x `div` y)
+
+guarded :: Int -> Int -> IO Int
+guarded x y = catch (safeDiv x y) (\\(SomeException _) -> return 0)
+
+reason :: Int -> Int -> IO String
+reason x y = catch (safeDiv x y `seq` return \"ok\")
+  (\\(SomeException m) -> return m)
+
+bothBranches :: Int -> Int -> IO Int
+bothBranches x y = do
+  v <- catch (safeDiv x y) (\\(SomeException _) -> return (-1))
+  return (v + 100)
+
+")
+
+(hk-test
+  "safediv.hs — divide by non-zero"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source "main = guarded 10 2")))
+  (list "IO" 5))
+
+(hk-test
+  "safediv.hs — divide by zero returns 0"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source "main = guarded 10 0")))
+  (list "IO" 0))
+
+(hk-test
+  "safediv.hs — divide by zero — reason captured"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source "main = catch (safeDiv 1 0) (\\(SomeException m) -> return 0) >> reason 1 0")))
+  (list "IO" "division by zero"))
+
+(hk-test
+  "safediv.hs — bothBranches success path"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source "main = bothBranches 8 2")))
+  (list "IO" 104))
+
+(hk-test
+  "safediv.hs — bothBranches failure path"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source "main = bothBranches 8 0")))
+  (list "IO" 99))
+
+(hk-test
+  "safediv.hs — chained safeDiv with catch"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source
+        "main = do { a <- guarded 20 4; b <- guarded 7 0; return (a + b) }")))
+  (list "IO" 5))
+
+(hk-test
+  "safediv.hs — try then bind through Either"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source
+        "main = do { r <- try (safeDiv 1 0); case r of { Right v -> return v; Left (SomeException m) -> return 999 } }")))
+  (list "IO" 999))
+
+(hk-test
+  "safediv.hs — handle (flip catch)"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source
+        "main = handle (\\(SomeException _) -> return 0) (safeDiv 5 0)")))
+  (list "IO" 0))
--- a/lib/haskell/tests/program-setops.sx
+++ b/lib/haskell/tests/program-setops.sx
@@ -0,0 +1,61 @@
+;; setops.hs — set union/intersection/difference on integer sets.
+;;
+;; Exercises Phase 12: `import qualified Data.Set as Set`, all three
+;; combining operations + isSubsetOf.
+
+(define
+  hk-setops-source
+  "import qualified Data.Set as Set\n\ns1 = Set.insert 1 (Set.insert 2 (Set.insert 3 Set.empty))\ns2 = Set.insert 3 (Set.insert 4 (Set.insert 5 Set.empty))\ns3 = Set.insert 1 (Set.insert 2 Set.empty)\n")
+
+(hk-test
+  "setops.hs — union size = 5"
+  (hk-deep-force
+    (hk-run (str hk-setops-source "main = Set.size (Set.union s1 s2)\n")))
+  5)
+
+(hk-test
+  "setops.hs — intersection size = 1"
+  (hk-deep-force
+    (hk-run
+      (str hk-setops-source "main = Set.size (Set.intersection s1 s2)\n")))
+  1)
+
+(hk-test
+  "setops.hs — intersection contains 3"
+  (hk-deep-force
+    (hk-run
+      (str hk-setops-source "main = Set.member 3 (Set.intersection s1 s2)\n")))
+  (list "True"))
+
+(hk-test
+  "setops.hs — difference s1 s2 size = 2"
+  (hk-deep-force
+    (hk-run (str hk-setops-source "main = Set.size (Set.difference s1 s2)\n")))
+  2)
+
+(hk-test
+  "setops.hs — difference doesn't contain shared key"
+  (hk-deep-force
+    (hk-run
+      (str hk-setops-source "main = Set.member 3 (Set.difference s1 s2)\n")))
+  (list "False"))
+
+(hk-test
+  "setops.hs — s3 is subset of s1"
+  (hk-deep-force
+    (hk-run (str hk-setops-source "main = Set.isSubsetOf s3 s1\n")))
+  (list "True"))
+
+(hk-test
+  "setops.hs — s1 not subset of s3"
+  (hk-deep-force
+    (hk-run (str hk-setops-source "main = Set.isSubsetOf s1 s3\n")))
+  (list "False"))
+
+(hk-test
+  "setops.hs — empty set is subset of anything"
+  (hk-deep-force
+    (hk-run (str hk-setops-source "main = Set.isSubsetOf Set.empty s1\n")))
+  (list "True"))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-shapes.sx
+++ b/lib/haskell/tests/program-shapes.sx
@@ -0,0 +1,40 @@
+;; shapes.hs — class Area with a default perimeter, two instances
+;;             using where-local helpers.
+;;
+;; Exercises Phase 13: class default method (perimeter), instance
+;; methods that use `where`-bindings.
+
+(define
+  hk-shapes-source
+  "class Shape a where\n  area :: a -> Int\n  perimeter :: a -> Int\n  perimeter x = quadrilateral x\n    where quadrilateral y = 2 * (sideA y + sideB y)\n          sideA z = 1\n          sideB z = 1\n\ndata Square = Square Int\ndata Rect = Rect Int Int\n\ninstance Shape Square where\n  area (Square s) = s * s\n  perimeter (Square s) = 4 * s\n\ninstance Shape Rect where\n  area (Rect w h) = w * h\n  perimeter (Rect w h) = peri\n    where peri = 2 * (w + h)\n")
+
+(hk-test
+  "shapes.hs — area of Square 5 = 25"
+  (hk-deep-force (hk-run (str hk-shapes-source "main = area (Square 5)\n")))
+  25)
+
+(hk-test
+  "shapes.hs — perimeter of Square 5 = 20"
+  (hk-deep-force
+    (hk-run (str hk-shapes-source "main = perimeter (Square 5)\n")))
+  20)
+
+(hk-test
+  "shapes.hs — area of Rect 3 4 = 12"
+  (hk-deep-force (hk-run (str hk-shapes-source "main = area (Rect 3 4)\n")))
+  12)
+
+(hk-test
+  "shapes.hs — perimeter of Rect 3 4 = 14 (via where-bound)"
+  (hk-deep-force
+    (hk-run (str hk-shapes-source "main = perimeter (Rect 3 4)\n")))
+  14)
+
+(hk-test
+  "shapes.hs — Square sums area + perimeter"
+  (hk-deep-force
+    (hk-run
+      (str hk-shapes-source "main = area (Square 4) + perimeter (Square 4)\n")))
+  32)
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-showadt.sx
+++ b/lib/haskell/tests/program-showadt.sx
@@ -0,0 +1,45 @@
+;; showadt.hs — `deriving (Show)` on a multi-constructor recursive ADT.
+;; Source: classic exposition example, e.g. Real World Haskell ch.6.
+;;
+;; Exercises Phase 8: `deriving (Show)` on an ADT whose constructors recurse
+;; into themselves; precedence-based paren wrapping for nested arguments;
+;; `print` from the prelude (which is `putStrLn (show x)`).
+
+(define
+  hk-showadt-source
+  "data Expr = Lit Int | Add Expr Expr | Mul Expr Expr deriving (Show)\n\nmain = do\n  print (Lit 3)\n  print (Add (Lit 1) (Lit 2))\n  print (Mul (Lit 3) (Add (Lit 4) (Lit 5)))\n")
+
+(hk-test
+  "showadt.hs — main prints three lines"
+  (hk-run-io hk-showadt-source)
+  (list "Lit 3" "Add (Lit 1) (Lit 2)" "Mul (Lit 3) (Add (Lit 4) (Lit 5))"))
+
+(hk-test
+  "showadt.hs — show Lit 3"
+  (hk-deep-force
+    (hk-run
+      "data Expr = Lit Int | Add Expr Expr | Mul Expr Expr deriving (Show)\nmain = show (Lit 3)"))
+  "Lit 3")
+
+(hk-test
+  "showadt.hs — show Add wraps both args"
+  (hk-deep-force
+    (hk-run
+      "data Expr = Lit Int | Add Expr Expr | Mul Expr Expr deriving (Show)\nmain = show (Add (Lit 1) (Lit 2))"))
+  "Add (Lit 1) (Lit 2)")
+
+(hk-test
+  "showadt.hs — fully nested Mul of Adds"
+  (hk-deep-force
+    (hk-run
+      "data Expr = Lit Int | Add Expr Expr | Mul Expr Expr deriving (Show)\nmain = show (Mul (Add (Lit 1) (Lit 2)) (Add (Lit 3) (Lit 4)))"))
+  "Mul (Add (Lit 1) (Lit 2)) (Add (Lit 3) (Lit 4))")
+
+(hk-test
+  "showadt.hs — Lit with negative literal wraps int in parens"
+  (hk-deep-force
+    (hk-run
+      "data Expr = Lit Int | Add Expr Expr | Mul Expr Expr deriving (Show)\nmain = show (Lit (negate 7))"))
+  "Lit (-7)")
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-showio.sx
+++ b/lib/haskell/tests/program-showio.sx
@@ -0,0 +1,36 @@
+;; showio.hs — `print` on various types inside a `do` block.
+;;
+;; Exercises Phase 8 `print x = putStrLn (show x)` and the IO monad's
+;; statement sequencing. Each `print` produces one io-line.
+
+(define
+  hk-showio-source
+  "main = do\n  print 42\n  print True\n  print False\n  print [1,2,3]\n  print (1, 2)\n  print (Just 5)\n  print Nothing\n  print \"hello\"\n")
+
+(hk-test
+  "showio.hs — main produces 8 lines, all show-formatted"
+  (hk-run-io hk-showio-source)
+  (list "42" "True" "False" "[1,2,3]" "(1,2)" "Just 5" "Nothing" "\"hello\""))
+
+(hk-test
+  "showio.hs — print Int alone"
+  (hk-run-io "main = print 42")
+  (list "42"))
+
+(hk-test
+  "showio.hs — print list of Maybe"
+  (hk-run-io "main = print [Just 1, Nothing, Just 3]")
+  (list "[Just 1,Nothing,Just 3]"))
+
+(hk-test
+  "showio.hs — print nested tuple"
+  (hk-run-io "main = print ((1, 2), (3, 4))")
+  (list "((1,2),(3,4))"))
+
+(hk-test
+  "showio.hs — print derived ADT inside do"
+  (hk-run-io
+    "data Color = Red | Green | Blue deriving (Show)\nmain = do { print Red; print Green; print Blue }")
+  (list "Red" "Green" "Blue"))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-statistics.sx
+++ b/lib/haskell/tests/program-statistics.sx
@@ -0,0 +1,45 @@
+;; statistics.hs — mean, variance, std-dev on a [Double].
+;; Source: classic textbook example.
+;;
+;; Exercises Phase 10: `fromIntegral`, `/`, `sqrt`, list ops on `[Double]`.
+
+(define
+  hk-prog-val
+  (fn
+    (src name)
+    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))
+
+(define
+  hk-stats-source
+  "mean xs = sum xs / fromIntegral (length xs)\n\nvariance xs = let m = mean xs\n                  sqDiff x = (x - m) * (x - m)\n              in sum (map sqDiff xs) / fromIntegral (length xs)\n\nstdDev xs = sqrt (variance xs)\n")
+
+(hk-test
+  "statistics.hs — mean [1,2,3,4,5] = 3"
+  (hk-prog-val (str hk-stats-source "r = mean [1.0,2.0,3.0,4.0,5.0]\n") "r")
+  3)
+
+(hk-test
+  "statistics.hs — mean [10,20,30] = 20"
+  (hk-prog-val (str hk-stats-source "r = mean [10.0,20.0,30.0]\n") "r")
+  20)
+
+(hk-test
+  "statistics.hs — variance [2,4,4,4,5,5,7,9] = 4"
+  (hk-prog-val
+    (str hk-stats-source "r = variance [2.0,4.0,4.0,4.0,5.0,5.0,7.0,9.0]\n")
+    "r")
+  4)
+
+(hk-test
+  "statistics.hs — stdDev [2,4,4,4,5,5,7,9] = 2"
+  (hk-prog-val
+    (str hk-stats-source "r = stdDev [2.0,4.0,4.0,4.0,5.0,5.0,7.0,9.0]\n")
+    "r")
+  2)
+
+(hk-test
+  "statistics.hs — variance of constant list = 0"
+  (hk-prog-val (str hk-stats-source "r = variance [5.0,5.0,5.0,5.0]\n") "r")
+  0)
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-trycatch.sx
+++ b/lib/haskell/tests/program-trycatch.sx
@@ -0,0 +1,95 @@
+;; trycatch.hs — try pattern: branch on Left/Right (Phase 16 conformance).
+
+(define
+  hk-trycatch-source
+  "parseInt :: String -> IO Int
+parseInt \"zero\" = return 0
+parseInt \"one\"  = return 1
+parseInt \"two\"  = return 2
+parseInt s = throwIO (SomeException (\"unknown: \" ++ s))
+
+describe :: Either SomeException Int -> String
+describe (Right v) = \"got \" ++ show v
+describe (Left (SomeException m)) = \"err: \" ++ m
+
+trial :: String -> IO String
+trial s = do
+  r <- try (parseInt s)
+  return (describe r)
+
+run3 :: String -> String -> String -> IO [String]
+run3 a b c = do
+  ra <- trial a
+  rb <- trial b
+  rc <- trial c
+  return [ra, rb, rc]
+
+")
+
+(hk-test
+  "trycatch.hs — Right branch"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source "main = trial \"one\"")))
+  (list "IO" "got 1"))
+
+(hk-test
+  "trycatch.hs — Left branch with message"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source "main = trial \"banana\"")))
+  (list "IO" "err: unknown: banana"))
+
+(hk-test
+  "trycatch.hs — chain over three inputs, all good"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source "main = run3 \"zero\" \"one\" \"two\"")))
+  (list "IO"
+    (list ":" "got 0"
+      (list ":" "got 1"
+        (list ":" "got 2"
+          (list "[]"))))))
+
+(hk-test
+  "trycatch.hs — chain over three inputs, mixed"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source "main = run3 \"zero\" \"qux\" \"two\"")))
+  (list "IO"
+    (list ":" "got 0"
+      (list ":" "err: unknown: qux"
+        (list ":" "got 2"
+          (list "[]"))))))
+
+(hk-test
+  "trycatch.hs — Left from throwIO carries message"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source
+        "main = do { r <- try (throwIO (SomeException \"explicit\")); return (describe r) }")))
+  (list "IO" "err: explicit"))
+
+(hk-test
+  "trycatch.hs — Right preserves the int"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source
+        "main = do { r <- try (return 42); return (describe r) }")))
+  (list "IO" "got 42"))
+
+(hk-test
+  "trycatch.hs — pattern-bind on Right inside do"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source
+        "main = do { Right v <- try (parseInt \"two\"); return (v + 100) }")))
+  (list "IO" 102))
+
+(hk-test
+  "trycatch.hs — handle alias on parseInt failure"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source
+        "main = handle (\\(SomeException m) -> return (\"caught: \" ++ m)) (parseInt \"nope\" >>= (\\v -> return (show v)))")))
+  (list "IO" "caught: unknown: nope"))
--- a/lib/haskell/tests/program-uniquewords.sx
+++ b/lib/haskell/tests/program-uniquewords.sx
@@ -0,0 +1,35 @@
+;; uniquewords.hs — count unique words using Data.Set.
+;;
+;; Exercises Phase 12: `import qualified Data.Set as Set`, `Set.empty`,
+;; `Set.insert`, `Set.size`, `foldl`.
+
+(define
+  hk-uniquewords-source
+  "import qualified Data.Set as Set\n\naddWord s w = Set.insert w s\n\nuniqueWords ws = foldl addWord Set.empty ws\n\nresult = uniqueWords [\"the\", \"cat\", \"the\", \"dog\", \"the\", \"cat\"]\n")
+
+(hk-test
+  "uniquewords.hs — unique count = 3"
+  (hk-deep-force
+    (hk-run (str hk-uniquewords-source "main = Set.size result\n")))
+  3)
+
+(hk-test
+  "uniquewords.hs — \"the\" present"
+  (hk-deep-force
+    (hk-run (str hk-uniquewords-source "main = Set.member \"the\" result\n")))
+  (list "True"))
+
+(hk-test
+  "uniquewords.hs — \"missing\" absent"
+  (hk-deep-force
+    (hk-run (str hk-uniquewords-source "main = Set.member \"missing\" result\n")))
+  (list "False"))
+
+(hk-test
+  "uniquewords.hs — empty list yields empty set"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.Set as Set\nmain = Set.size (foldl (\\s w -> Set.insert w s) Set.empty [])"))
+  0)
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/program-wordfreq.sx
+++ b/lib/haskell/tests/program-wordfreq.sx
@@ -0,0 +1,54 @@
+;; wordfreq.hs — word-frequency histogram using Data.Map.
+;; Source: Rosetta Code "Word frequency" (Haskell entry, simplified).
+;;
+;; Exercises Phase 11: `import qualified Data.Map as Map`, `Map.empty`,
+;; `Map.insertWith`, `Map.lookup`, `Map.findWithDefault`, `foldl`.
+
+(define
+  hk-wordfreq-source
+  "import qualified Data.Map as Map\n\ncountWord m w = Map.insertWith (+) w 1 m\n\nwordFreq xs = foldl countWord Map.empty xs\n\nresult = wordFreq [\"the\", \"cat\", \"the\", \"dog\", \"the\", \"cat\"]\n")
+
+(hk-test
+  "wordfreq.hs — \"the\" counted 3 times"
+  (hk-deep-force
+    (hk-run (str hk-wordfreq-source "main = Map.lookup \"the\" result\n")))
+  (list "Just" 3))
+
+(hk-test
+  "wordfreq.hs — \"cat\" counted 2 times"
+  (hk-deep-force
+    (hk-run (str hk-wordfreq-source "main = Map.lookup \"cat\" result\n")))
+  (list "Just" 2))
+
+(hk-test
+  "wordfreq.hs — \"dog\" counted 1 time"
+  (hk-deep-force
+    (hk-run (str hk-wordfreq-source "main = Map.lookup \"dog\" result\n")))
+  (list "Just" 1))
+
+(hk-test
+  "wordfreq.hs — \"missing\" not present"
+  (hk-deep-force
+    (hk-run (str hk-wordfreq-source "main = Map.lookup \"missing\" result\n")))
+  (list "Nothing"))
+
+(hk-test
+  "wordfreq.hs — Map.size = 3 unique words"
+  (hk-deep-force (hk-run (str hk-wordfreq-source "main = Map.size result\n")))
+  3)
+
+(hk-test
+  "wordfreq.hs — findWithDefault for missing returns 0"
+  (hk-deep-force
+    (hk-run
+      (str hk-wordfreq-source "main = Map.findWithDefault 0 \"absent\" result\n")))
+  0)
+
+(hk-test
+  "wordfreq.hs — findWithDefault for present returns count"
+  (hk-deep-force
+    (hk-run
+      (str hk-wordfreq-source "main = Map.findWithDefault 0 \"the\" result\n")))
+  3)
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/records.sx
+++ b/lib/haskell/tests/records.sx
@@ -0,0 +1,127 @@
+;; records.sx — Phase 14 record syntax tests.
+
+(define
+  hk-person-source
+  "data Person = Person { name :: String, age :: Int }\n")
+
+(define hk-pt-source "data Pt = Pt { x :: Int, y :: Int }\n")
+
+;; ── Creation ────────────────────────────────────────────────
+(hk-test
+  "creation: Person { name = \"a\", age = 1 } via accessor name"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-person-source
+        "main = name (Person { name = \"alice\", age = 30 })")))
+  "alice")
+
+(hk-test
+  "creation: source order doesn't matter (age first)"
+  (hk-deep-force
+    (hk-run
+      (str hk-person-source "main = name (Person { age = 99, name = \"bob\" })")))
+  "bob")
+
+(hk-test
+  "creation: age accessor returns the right field"
+  (hk-deep-force
+    (hk-run
+      (str hk-person-source "main = age (Person { age = 99, name = \"bob\" })")))
+  99)
+
+;; ── Accessors ──────────────────────────────────────────────
+(hk-test
+  "accessor: x of Pt"
+  (hk-deep-force
+    (hk-run (str hk-pt-source "main = x (Pt { x = 7, y = 99 })")))
+  7)
+
+(hk-test
+  "accessor: y of Pt"
+  (hk-deep-force
+    (hk-run (str hk-pt-source "main = y (Pt { x = 7, y = 99 })")))
+  99)
+
+;; ── Update — single field ──────────────────────────────────
+(hk-test
+  "update one field: age changes"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-person-source
+        "alice = Person { name = \"alice\", age = 30 }\nmain = age (alice { age = 31 })")))
+  31)
+
+(hk-test
+  "update one field: name preserved"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-person-source
+        "alice = Person { name = \"alice\", age = 30 }\nmain = name (alice { age = 31 })")))
+  "alice")
+
+;; ── Update — two fields ────────────────────────────────────
+(hk-test
+  "update two fields: both changed"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-person-source
+        "alice = Person { name = \"alice\", age = 30 }\nbob = alice { name = \"bob\", age = 50 }\nmain = age bob")))
+  50)
+
+(hk-test
+  "update two fields: name takes new value"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-person-source
+        "alice = Person { name = \"alice\", age = 30 }\nbob = alice { name = \"bob\", age = 50 }\nmain = name bob")))
+  "bob")
+
+;; ── Record patterns ────────────────────────────────────────
+(hk-test
+  "case-alt record pattern: Pt { x = a }"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-pt-source
+        "getX p = case p of Pt { x = a } -> a\nmain = getX (Pt { x = 7, y = 99 })")))
+  7)
+
+(hk-test
+  "case-alt record pattern: multi-field bind"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-pt-source
+        "sumPt p = case p of Pt { x = a, y = b } -> a + b\nmain = sumPt (Pt { x = 3, y = 4 })")))
+  7)
+
+(hk-test
+  "fun-LHS record pattern"
+  (hk-deep-force
+    (hk-run
+      (str
+        hk-person-source
+        "getName (Person { name = n }) = n\nmain = getName (Person { name = \"alice\", age = 30 })")))
+  "alice")
+
+;; ── deriving Show on a record ───────────────────────────────
+(hk-test
+  "deriving Show on a record produces positional output"
+  (hk-deep-force
+    (hk-run
+      "data Person = Person { name :: String, age :: Int } deriving (Show)\nmain = show (Person { name = \"alice\", age = 30 })"))
+  "Person \"alice\" 30")
+
+(hk-test
+  "deriving Show on Pt"
+  (hk-deep-force
+    (hk-run
+      "data Pt = Pt { x :: Int, y :: Int } deriving (Show)\nmain = show (Pt { x = 3, y = 4 })"))
+  "Pt 3 4")
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/set.sx
+++ b/lib/haskell/tests/set.sx
@@ -0,0 +1,119 @@
+;; set.sx — Phase 12 Data.Set unit tests.
+
+;; ── SX-level (direct hk-set-*) ───────────────────────────────
+(hk-test
+  "hk-set-empty: size 0 + null"
+  (list (hk-set-size hk-set-empty) (hk-set-null hk-set-empty))
+  (list 0 true))
+
+(hk-test
+  "hk-set-singleton: member yes"
+  (let
+    ((s (hk-set-singleton 5)))
+    (list (hk-set-size s) (hk-set-member 5 s) (hk-set-member 99 s)))
+  (list 1 true false))
+
+(hk-test
+  "hk-set-insert: idempotent"
+  (let
+    ((s (hk-set-insert 1 (hk-set-insert 1 hk-set-empty))))
+    (hk-set-size s))
+  1)
+
+(hk-test
+  "hk-set-from-list: dedupes"
+  (hk-set-to-asc-list (hk-set-from-list (list 3 1 4 1 5 9 2 6)))
+  (list 1 2 3 4 5 6 9))
+
+(hk-test
+  "hk-set-delete: removes"
+  (let
+    ((s (hk-set-from-list (list 1 2 3))))
+    (hk-set-to-asc-list (hk-set-delete 2 s)))
+  (list 1 3))
+
+(hk-test
+  "hk-set-union"
+  (hk-set-to-asc-list
+    (hk-set-union
+      (hk-set-from-list (list 1 2 3))
+      (hk-set-from-list (list 3 4 5))))
+  (list 1 2 3 4 5))
+
+(hk-test
+  "hk-set-intersection"
+  (hk-set-to-asc-list
+    (hk-set-intersection
+      (hk-set-from-list (list 1 2 3 4))
+      (hk-set-from-list (list 3 4 5 6))))
+  (list 3 4))
+
+(hk-test
+  "hk-set-difference"
+  (hk-set-to-asc-list
+    (hk-set-difference
+      (hk-set-from-list (list 1 2 3 4))
+      (hk-set-from-list (list 3 4 5))))
+  (list 1 2))
+
+(hk-test
+  "hk-set-is-subset-of: yes"
+  (hk-set-is-subset-of
+    (hk-set-from-list (list 2 3))
+    (hk-set-from-list (list 1 2 3 4)))
+  true)
+
+(hk-test
+  "hk-set-is-subset-of: no"
+  (hk-set-is-subset-of
+    (hk-set-from-list (list 5 6))
+    (hk-set-from-list (list 1 2 3 4)))
+  false)
+
+(hk-test
+  "hk-set-filter"
+  (hk-set-to-asc-list
+    (hk-set-filter (fn (k) (> k 2)) (hk-set-from-list (list 1 2 3 4 5))))
+  (list 3 4 5))
+
+(hk-test
+  "hk-set-map"
+  (hk-set-to-asc-list
+    (hk-set-map (fn (k) (* k 10)) (hk-set-from-list (list 1 2 3))))
+  (list 10 20 30))
+
+(hk-test
+  "hk-set-foldr: sum"
+  (hk-set-foldr + 0 (hk-set-from-list (list 1 2 3 4 5)))
+  15)
+
+;; ── Haskell-level (Set.* via import wiring) ──────────────────
+(hk-test
+  "Set.size after Set.insert chain"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.Set as Set\nmain = Set.size (Set.insert 3 (Set.insert 1 (Set.insert 2 Set.empty)))"))
+  3)
+
+(hk-test
+  "Set.member true"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.Set as Set\nmain = Set.member 5 (Set.insert 5 Set.empty)"))
+  (list "True"))
+
+(hk-test
+  "Set.union via Haskell"
+  (hk-deep-force
+    (hk-run
+      "import Data.Set\nmain = Set.size (Set.union (Set.insert 1 Set.empty) (Set.insert 2 Set.empty))"))
+  2)
+
+(hk-test
+  "Set.isSubsetOf via Haskell"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.Set as S\nmain = S.isSubsetOf (S.insert 1 S.empty) (S.insert 2 (S.insert 1 S.empty))"))
+  (list "True"))
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/show.sx
+++ b/lib/haskell/tests/show.sx
@@ -0,0 +1,140 @@
+;; show.sx — tests for the Show / Read class plumbing.
+;;
+;; Covers Phase 8:
+;;  - showsPrec / showParen / shows / showString stubs
+;;  - Read class stubs (reads / readsPrec / read)
+;;  - direct show coverage (Int, Bool, String, list, tuple, Maybe, ADT, ...)
+
+;; ── ShowS / showsPrec / showParen stubs ──────────────────────
+(hk-test
+  "shows: prepends show output"
+  (hk-deep-force (hk-run "main = shows 5 \"abc\""))
+  "5abc")
+
+(hk-test
+  "shows: works on True"
+  (hk-deep-force (hk-run "main = shows True \"x\""))
+  "Truex")
+
+(hk-test
+  "showString: prepends literal"
+  (hk-deep-force (hk-run "main = showString \"hello\" \" world\""))
+  "hello world")
+
+(hk-test
+  "showParen True: wraps inner output in parens"
+  (hk-deep-force (hk-run "main = showParen True (showString \"inside\") \"\""))
+  "(inside)")
+
+(hk-test
+  "showParen False: passes through unchanged"
+  (hk-deep-force (hk-run "main = showParen False (showString \"inside\") \"\""))
+  "inside")
+
+(hk-test
+  "showsPrec: prepends show output regardless of prec"
+  (hk-deep-force (hk-run "main = showsPrec 11 42 \"end\""))
+  "42end")
+
+(hk-test
+  "showParen + manual composition: build (Just 3)"
+  (hk-deep-force
+    (hk-run
+      "buildJust3 s = showString \"Just \" (shows 3 s)\nmain = showParen True buildJust3 \"\""))
+  "(Just 3)")
+
+;; ── Read stubs ───────────────────────────────────────────────
+(hk-test
+  "reads: stub returns empty list (null-check)"
+  (hk-deep-force (hk-run "main = show (null (reads \"42\"))"))
+  "True")
+
+(hk-test
+  "readsPrec: stub returns empty list"
+  (hk-deep-force (hk-run "main = show (null (readsPrec 0 \"True\"))"))
+  "True")
+
+(hk-test
+  "reads: type-checks in expression context (length)"
+  (hk-deep-force (hk-run "main = show (length (reads \"abc\"))"))
+  "0")
+
+;; ── Direct `show` audit coverage ─────────────────────────────
+(hk-test "show Int" (hk-deep-force (hk-run "main = show 42")) "42")
+
+(hk-test
+  "show negative Int"
+  (hk-deep-force (hk-run "main = show (negate 5)"))
+  "-5")
+
+(hk-test "show Bool True" (hk-deep-force (hk-run "main = show True")) "True")
+
+(hk-test
+  "show Bool False"
+  (hk-deep-force (hk-run "main = show False"))
+  "False")
+
+(hk-test
+  "show String quotes the value"
+  (hk-deep-force (hk-run "main = show \"hello\""))
+  "\"hello\"")
+
+(hk-test
+  "show list of Int"
+  (hk-deep-force (hk-run "main = show [1,2,3]"))
+  "[1,2,3]")
+
+(hk-test
+  "show empty list"
+  (hk-deep-force (hk-run "main = show (drop 5 [1,2,3])"))
+  "[]")
+
+(hk-test
+  "show pair tuple"
+  (hk-deep-force (hk-run "main = show (1, True)"))
+  "(1,True)")
+
+(hk-test
+  "show triple tuple"
+  (hk-deep-force (hk-run "main = show (1, 2, 3)"))
+  "(1,2,3)")
+
+(hk-test
+  "show Maybe Nothing"
+  (hk-deep-force (hk-run "main = show Nothing"))
+  "Nothing")
+
+(hk-test
+  "show Maybe Just"
+  (hk-deep-force (hk-run "main = show (Just 3)"))
+  "Just 3")
+
+(hk-test
+  "show nested Just wraps inner in parens"
+  (hk-deep-force (hk-run "main = show (Just (Just 3))"))
+  "Just (Just 3)")
+
+(hk-test
+  "show Just (negate 3) wraps negative in parens"
+  (hk-deep-force (hk-run "main = show (Just (negate 3))"))
+  "Just (-3)")
+
+(hk-test
+  "show custom nullary ADT"
+  (hk-deep-force
+    (hk-run "data Day = Mon | Tue | Wed deriving (Show)\nmain = show Tue"))
+  "Tue")
+
+(hk-test
+  "show custom multi-constructor ADT"
+  (hk-deep-force
+    (hk-run
+      "data Shape = Pt | Sq Int | Rect Int Int deriving (Show)\nmain = show (Rect 3 4)"))
+  "Rect 3 4")
+
+(hk-test
+  "show list of Maybe wraps each element"
+  (hk-deep-force (hk-run "main = show [Just 1, Nothing, Just 2]"))
+  "[Just 1,Nothing,Just 2]")
+
+{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/stdlib.sx
+++ b/lib/haskell/tests/stdlib.sx
@@ -37,11 +37,11 @@
 (hk-ts "show neg" "negate 7" "-7")
 (hk-ts "show bool T" "True" "True")
 (hk-ts "show bool F" "False" "False")
-(hk-ts "show list" "[1,2,3]" "[1, 2, 3]")
-(hk-ts "show Just" "Just 5" "(Just 5)")
+(hk-ts "show list" "[1,2,3]" "[1,2,3]")
+(hk-ts "show Just" "Just 5" "Just 5")
 (hk-ts "show Nothing" "Nothing" "Nothing")
 (hk-ts "show LT" "LT" "LT")
-(hk-ts "show tuple" "(1, True)" "(1, True)")
+(hk-ts "show tuple" "(1, True)" "(1,True)")

 ;; ── Num extras ───────────────────────────────────────────────
 (hk-test "signum pos" (hk-deep-force (hk-run "main = signum 5")) 1)
@@ -59,13 +59,13 @@
 (hk-test
  "foldr cons"
  (hk-deep-force (hk-run "main = show (foldr (:) [] [1,2,3])"))
-  "[1, 2, 3]")
+  "[1,2,3]")

 ;; ── List ops ─────────────────────────────────────────────────
 (hk-test
  "reverse"
  (hk-deep-force (hk-run "main = show (reverse [1,2,3])"))
-  "[3, 2, 1]")
+  "[3,2,1]")
 (hk-test "null []" (hk-deep-force (hk-run "main = null []")) (list "True"))
 (hk-test
  "null xs"
@@ -82,7 +82,7 @@
 (hk-test
  "zip"
  (hk-deep-force (hk-run "main = show (zip [1,2] [3,4])"))
-  "[(1, 3), (2, 4)]")
+  "[(1,3),(2,4)]")
 (hk-test "sum" (hk-deep-force (hk-run "main = sum [1,2,3,4,5]")) 15)
 (hk-test "product" (hk-deep-force (hk-run "main = product [1,2,3,4]")) 24)
 (hk-test "maximum" (hk-deep-force (hk-run "main = maximum [3,1,9,2]")) 9)
@@ -112,7 +112,7 @@
 (hk-test
  "fmap list"
  (hk-deep-force (hk-run "main = show (fmap (+1) [1,2,3])"))
-  "[2, 3, 4]")
+  "[2,3,4]")

 ;; ── Monad / Applicative ──────────────────────────────────────
 (hk-test "return" (hk-deep-force (hk-run "main = return 7")) (list "IO" 7))
@@ -134,7 +134,7 @@
 (hk-test
  "lookup hit"
  (hk-deep-force (hk-run "main = show (lookup 2 [(1,10),(2,20)])"))
-  "(Just 20)")
+  "Just 20")
 (hk-test
  "lookup miss"
  (hk-deep-force (hk-run "main = show (lookup 9 [(1,10)])"))
--- a/lib/haskell/tests/string-char.sx
+++ b/lib/haskell/tests/string-char.sx
@@ -0,0 +1,139 @@
+;; String / Char tests — Phase 7 items 1-4.
+;;
+;; Covers:
+;;   hk-str? / hk-str-head / hk-str-tail / hk-str-null?   (runtime helpers)
+;;   chr / ord / toUpper / toLower                          (builtins in eval)
+;;   cons-pattern on strings via match.sx                   (":"-intercept)
+;;   empty-list pattern on strings via match.sx             ("[]"-intercept)
+
+;; ── hk-str? predicate ────────────────────────────────────────────────────
+(hk-test "hk-str? native string" (hk-str? "hello") true)
+
+(hk-test "hk-str? empty string" (hk-str? "") true)
+
+(hk-test "hk-str? view dict" (hk-str? {:hk-off 1 :hk-str "hi"}) true)
+
+(hk-test "hk-str? rejects number" (hk-str? 42) false)
+
+;; ── hk-str-null? predicate ───────────────────────────────────────────────
+(hk-test "hk-str-null? empty string" (hk-str-null? "") true)
+
+(hk-test "hk-str-null? non-empty" (hk-str-null? "a") false)
+
+(hk-test "hk-str-null? exhausted view" (hk-str-null? {:hk-off 2 :hk-str "hi"}) true)
+
+(hk-test "hk-str-null? live view" (hk-str-null? {:hk-off 1 :hk-str "hi"}) false)
+
+;; ── hk-str-head ──────────────────────────────────────────────────────────
+(hk-test "hk-str-head native string" (hk-str-head "hello") 104)
+
+(hk-test "hk-str-head view at offset" (hk-str-head {:hk-off 1 :hk-str "hello"}) 101)
+
+;; ── hk-str-tail ──────────────────────────────────────────────────────────
+(hk-test "hk-str-tail of single char is nil" (hk-str-tail "h") (list "[]"))
+
+(hk-test
+  "hk-str-tail of two-char string is live view"
+  (hk-str-null? (hk-str-tail "hi"))
+  false)
+
+(hk-test
+  "hk-str-tail head of tail of hi is i"
+  (hk-str-head (hk-str-tail "hi"))
+  105)
+
+;; ── chr / ord ────────────────────────────────────────────────────────────
+(hk-test "chr 65 = A" (hk-eval-expr-source "chr 65") "A")
+
+(hk-test "chr 104 = h" (hk-eval-expr-source "chr 104") "h")
+
+(hk-test "ord char literal 'A' = 65" (hk-eval-expr-source "ord 'A'") 65)
+
+(hk-test "ord char literal 'a' = 97" (hk-eval-expr-source "ord 'a'") 97)
+
+(hk-test
+  "ord of head string = char code"
+  (hk-eval-expr-source "ord (head \"hello\")")
+  104)
+
+;; ── toUpper / toLower ────────────────────────────────────────────────────
+(hk-test "toUpper 97 = 65 (a->A)" (hk-eval-expr-source "toUpper 97") 65)
+
+(hk-test
+  "toUpper 65 = 65 (already upper)"
+  (hk-eval-expr-source "toUpper 65")
+  65)
+
+(hk-test
+  "toUpper 48 = 48 (digit unchanged)"
+  (hk-eval-expr-source "toUpper 48")
+  48)
+
+(hk-test "toLower 65 = 97 (A->a)" (hk-eval-expr-source "toLower 65") 97)
+
+(hk-test
+  "toLower 97 = 97 (already lower)"
+  (hk-eval-expr-source "toLower 97")
+  97)
+
+(hk-test
+  "toLower 48 = 48 (digit unchanged)"
+  (hk-eval-expr-source "toLower 48")
+  48)
+
+;; ── Pattern matching on strings ──────────────────────────────────────────
+(hk-test
+  "cons pattern: head of hello = 104"
+  (hk-eval-expr-source "case \"hello\" of { (x:_) -> x }")
+  104)
+
+(hk-test
+  "cons pattern: tail is traversable"
+  (hk-eval-expr-source "case \"hi\" of { (_:xs) -> case xs of { (y:_) -> y } }")
+  105)
+
+(hk-test
+  "empty list pattern matches empty string"
+  (hk-eval-expr-source "case \"\" of { [] -> True; _ -> False }")
+  (list "True"))
+
+(hk-test
+  "empty list pattern fails on non-empty"
+  (hk-eval-expr-source "case \"a\" of { [] -> True; _ -> False }")
+  (list "False"))
+
+(hk-test
+  "cons pattern fails on empty string"
+  (hk-eval-expr-source "case \"\" of { (_:_) -> True; _ -> False }")
+  (list "False"))
+
+;; ── Haskell programs using string traversal ──────────────────────────────
+(hk-test
+  "null prelude on empty string"
+  (hk-eval-expr-source "null \"\"")
+  (list "True"))
+
+(hk-test
+  "null prelude on non-empty string"
+  (hk-eval-expr-source "null \"abc\"")
+  (list "False"))
+
+(hk-test
+  "length of string via cons recursion"
+  (hk-eval-expr-source "let { f [] = 0; f (_:xs) = 1 + f xs } in f \"hello\"")
+  5)
+
+(hk-test
+  "map ord over string gives char codes"
+  (hk-deep-force (hk-eval-expr-source "map ord \"abc\""))
+  (list ":" 97 (list ":" 98 (list ":" 99 (list "[]")))))
+
+(hk-test
+  "map toUpper over char codes then chr"
+  (hk-eval-expr-source "chr (toUpper (ord (head \"abc\")))")
+  "A")
+
+(hk-test
+  "head then ord using prelude head"
+  (hk-eval-expr-source "ord (head \"hello\")")
+  104)
--- a/lib/haskell/tests/typecheck.sx
+++ b/lib/haskell/tests/typecheck.sx
@@ -16,15 +16,18 @@
      true)))

 ;; ─── Valid programs pass through ─────────────────────────────────────────────
-(hk-test "typed ok: simple arithmetic" (hk-run-typed "main = 1 + 2") 3)
+(hk-test "typed ok: simple arithmetic"
+  (hk-deep-force (hk-run-typed "main = 1 + 2")) 3)

-(hk-test "typed ok: boolean" (hk-run-typed "main = True") (list "True"))
+(hk-test "typed ok: boolean"
+  (hk-deep-force (hk-run-typed "main = True")) (list "True"))

-(hk-test "typed ok: let binding" (hk-run-typed "main = let x = 1 in x + 2") 3)
+(hk-test "typed ok: let binding"
+  (hk-deep-force (hk-run-typed "main = let x = 1 in x + 2")) 3)

 (hk-test
  "typed ok: two independent fns"
-  (hk-run-typed "f x = x + 1\nmain = f 5")
+  (hk-deep-force (hk-run-typed "f x = x + 1\nmain = f 5"))
  6)

 ;; ─── Untypeable programs are rejected ────────────────────────────────────────
@@ -76,7 +79,7 @@

 (hk-test
  "run-typed sig ok: Int declared matches"
-  (hk-run-typed "main :: Int\nmain = 1 + 2")
+  (hk-deep-force (hk-run-typed "main :: Int\nmain = 1 + 2"))
  3)

 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/minikanren/clpfd.sx
+++ b/lib/minikanren/clpfd.sx
@@ -1,858 +0,0 @@
-;; lib/minikanren/clpfd.sx — Phase 6: native CLP(FD) on miniKanren.
-;;
-;; The substitution dict carries an extra reserved key "_fd" that holds a
-;; constraint-store record:
-;;
-;;   {:domains    {var-name -> sorted-int-list}
-;;    :constraints (... pending constraint closures ...)}
-;;
-;; Domains are sorted SX lists of ints (no duplicates).
-;; Constraints are functions s -> s-or-nil that propagate / re-check.
-;; They are re-fired after every label binding via fd-fire-store.
-
-(define fd-key "_fd")
-
-;; --- domain primitives ---
-
-(define
-  fd-dom-rev
-  (fn
-    (xs acc)
-    (cond
-      ((empty? xs) acc)
-      (:else (fd-dom-rev (rest xs) (cons (first xs) acc))))))
-
-(define
-  fd-dom-insert
-  (fn
-    (x desc)
-    (cond
-      ((empty? desc) (list x))
-      ((= x (first desc)) desc)
-      ((> x (first desc)) (cons x desc))
-      (:else (cons (first desc) (fd-dom-insert x (rest desc)))))))
-
-(define
-  fd-dom-sort-dedupe
-  (fn
-    (xs acc)
-    (cond
-      ((empty? xs) (fd-dom-rev acc (list)))
-      (:else (fd-dom-sort-dedupe (rest xs) (fd-dom-insert (first xs) acc))))))
-
-(define fd-dom-from-list (fn (xs) (fd-dom-sort-dedupe xs (list))))
-
-(define fd-dom-empty? (fn (d) (empty? d)))
-(define
-  fd-dom-singleton?
-  (fn (d) (and (not (empty? d)) (empty? (rest d)))))
-(define fd-dom-min (fn (d) (first d)))
-
-(define
-  fd-dom-last
-  (fn
-    (d)
-    (cond ((empty? (rest d)) (first d)) (:else (fd-dom-last (rest d))))))
-
-(define fd-dom-max (fn (d) (fd-dom-last d)))
-(define fd-dom-member? (fn (x d) (some (fn (y) (= x y)) d)))
-
-(define
-  fd-dom-intersect
-  (fn
-    (a b)
-    (cond
-      ((empty? a) (list))
-      ((empty? b) (list))
-      ((= (first a) (first b))
-        (cons (first a) (fd-dom-intersect (rest a) (rest b))))
-      ((< (first a) (first b)) (fd-dom-intersect (rest a) b))
-      (:else (fd-dom-intersect a (rest b))))))
-
-(define
-  fd-dom-without
-  (fn
-    (x d)
-    (cond
-      ((empty? d) (list))
-      ((= (first d) x) (rest d))
-      ((> (first d) x) d)
-      (:else (cons (first d) (fd-dom-without x (rest d)))))))
-
-(define
-  fd-dom-range
-  (fn
-    (lo hi)
-    (cond
-      ((> lo hi) (list))
-      (:else (cons lo (fd-dom-range (+ lo 1) hi))))))
-
-;; --- constraint store accessors ---
-
-(define fd-store-empty (fn () {:domains {} :constraints (list)}))
-
-(define
-  fd-store-of
-  (fn
-    (s)
-    (cond ((has-key? s fd-key) (get s fd-key)) (:else (fd-store-empty)))))
-
-(define fd-domains-of (fn (s) (get (fd-store-of s) :domains)))
-(define fd-with-store (fn (s store) (assoc s fd-key store)))
-
-(define
-  fd-domain-of
-  (fn
-    (s var-name)
-    (let
-      ((doms (fd-domains-of s)))
-      (cond ((has-key? doms var-name) (get doms var-name)) (:else nil)))))
-
-(define
-  fd-set-domain
-  (fn
-    (s var-name d)
-    (cond
-      ((fd-dom-empty? d) nil)
-      (:else
-        (let
-          ((store (fd-store-of s)))
-          (let
-            ((doms-prime (assoc (get store :domains) var-name d)))
-            (let
-              ((store-prime (assoc store :domains doms-prime)))
-              (fd-with-store s store-prime))))))))
-
-(define
-  fd-add-constraint
-  (fn
-    (s c)
-    (let
-      ((store (fd-store-of s)))
-      (let
-        ((cs-prime (cons c (get store :constraints))))
-        (let
-          ((store-prime (assoc store :constraints cs-prime)))
-          (fd-with-store s store-prime))))))
-
-(define
-  fd-fire-list
-  (fn
-    (cs s)
-    (cond
-      ((empty? cs) s)
-      (:else
-        (let
-          ((s2 ((first cs) s)))
-          (cond ((= s2 nil) nil) (:else (fd-fire-list (rest cs) s2))))))))
-
-(define
-  fd-store-signature
-  (fn
-    (s)
-    (let
-      ((doms (fd-domains-of s)))
-      (let
-        ((dom-sizes (reduce (fn (acc k) (+ acc (len (get doms k)))) 0 (keys doms))))
-        (+ dom-sizes (len (keys s)))))))
-
-(define
-  fd-fire-store
-  (fn
-    (s)
-    (let
-      ((s2 (fd-fire-list (get (fd-store-of s) :constraints) s)))
-      (cond
-        ((= s2 nil) nil)
-        ((= (fd-store-signature s) (fd-store-signature s2)) s2)
-        (:else (fd-fire-store s2))))))
-
-;; --- user-facing goals ---
-
-(define
-  fd-in
-  (fn
-    (x dom-list)
-    (fn
-      (s)
-      (let
-        ((new-dom (fd-dom-from-list dom-list)))
-        (let
-          ((wx (mk-walk x s)))
-          (cond
-            ((number? wx)
-              (cond ((fd-dom-member? wx new-dom) (unit s)) (:else mzero)))
-            ((is-var? wx)
-              (let
-                ((existing (fd-domain-of s (var-name wx))))
-                (let
-                  ((narrowed (cond ((= existing nil) new-dom) (:else (fd-dom-intersect existing new-dom)))))
-                  (let
-                    ((s2 (fd-set-domain s (var-name wx) narrowed)))
-                    (cond ((= s2 nil) mzero) (:else (unit s2)))))))
-            (:else mzero)))))))
-
-;; --- fd-neq ---
-
-(define
-  fd-neq-prop
-  (fn
-    (x y s)
-    (let
-      ((wx (mk-walk x s)) (wy (mk-walk y s)))
-      (cond
-        ((and (number? wx) (number? wy))
-          (cond ((= wx wy) nil) (:else s)))
-        ((and (number? wx) (is-var? wy))
-          (let
-            ((y-dom (fd-domain-of s (var-name wy))))
-            (cond
-              ((= y-dom nil) s)
-              (:else
-                (fd-set-domain s (var-name wy) (fd-dom-without wx y-dom))))))
-        ((and (number? wy) (is-var? wx))
-          (let
-            ((x-dom (fd-domain-of s (var-name wx))))
-            (cond
-              ((= x-dom nil) s)
-              (:else
-                (fd-set-domain s (var-name wx) (fd-dom-without wy x-dom))))))
-        (:else s)))))
-
-(define
-  fd-neq
-  (fn
-    (x y)
-    (fn
-      (s)
-      (let
-        ((c (fn (s-prime) (fd-neq-prop x y s-prime))))
-        (let
-          ((s2 (fd-add-constraint s c)))
-          (let
-            ((s2-or-nil (c s2)))
-            (let
-              ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil)))))
-              (cond ((= s3 nil) mzero) (:else (unit s3))))))))))
-
-;; --- fd-lt ---
-
-(define
-  fd-lt-prop
-  (fn
-    (x y s)
-    (let
-      ((wx (mk-walk x s)) (wy (mk-walk y s)))
-      (cond
-        ((and (number? wx) (number? wy))
-          (cond ((< wx wy) s) (:else nil)))
-        ((and (number? wx) (is-var? wy))
-          (let
-            ((yd (fd-domain-of s (var-name wy))))
-            (cond
-              ((= yd nil) s)
-              (:else
-                (fd-set-domain
-                  s
-                  (var-name wy)
-                  (filter (fn (v) (> v wx)) yd))))))
-        ((and (is-var? wx) (number? wy))
-          (let
-            ((xd (fd-domain-of s (var-name wx))))
-            (cond
-              ((= xd nil) s)
-              (:else
-                (fd-set-domain
-                  s
-                  (var-name wx)
-                  (filter (fn (v) (< v wy)) xd))))))
-        ((and (is-var? wx) (is-var? wy))
-          (let
-            ((xd (fd-domain-of s (var-name wx)))
-              (yd (fd-domain-of s (var-name wy))))
-            (cond
-              ((or (= xd nil) (= yd nil)) s)
-              (:else
-                (let
-                  ((xd-prime (filter (fn (v) (< v (fd-dom-max yd))) xd)))
-                  (let
-                    ((s2 (fd-set-domain s (var-name wx) xd-prime)))
-                    (cond
-                      ((= s2 nil) nil)
-                      (:else
-                        (let
-                          ((yd-prime (filter (fn (v) (> v (fd-dom-min xd-prime))) yd)))
-                          (fd-set-domain s2 (var-name wy) yd-prime))))))))))
-        (:else s)))))
-
-(define
-  fd-lt
-  (fn
-    (x y)
-    (fn
-      (s)
-      (let
-        ((c (fn (sp) (fd-lt-prop x y sp))))
-        (let
-          ((s2 (fd-add-constraint s c)))
-          (let
-            ((s2-or-nil (c s2)))
-            (let
-              ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil)))))
-              (cond ((= s3 nil) mzero) (:else (unit s3))))))))))
-
-;; --- fd-lte ---
-
-(define
-  fd-lte-prop
-  (fn
-    (x y s)
-    (let
-      ((wx (mk-walk x s)) (wy (mk-walk y s)))
-      (cond
-        ((and (number? wx) (number? wy))
-          (cond ((<= wx wy) s) (:else nil)))
-        ((and (number? wx) (is-var? wy))
-          (let
-            ((yd (fd-domain-of s (var-name wy))))
-            (cond
-              ((= yd nil) s)
-              (:else
-                (fd-set-domain
-                  s
-                  (var-name wy)
-                  (filter (fn (v) (>= v wx)) yd))))))
-        ((and (is-var? wx) (number? wy))
-          (let
-            ((xd (fd-domain-of s (var-name wx))))
-            (cond
-              ((= xd nil) s)
-              (:else
-                (fd-set-domain
-                  s
-                  (var-name wx)
-                  (filter (fn (v) (<= v wy)) xd))))))
-        ((and (is-var? wx) (is-var? wy))
-          (let
-            ((xd (fd-domain-of s (var-name wx)))
-              (yd (fd-domain-of s (var-name wy))))
-            (cond
-              ((or (= xd nil) (= yd nil)) s)
-              (:else
-                (let
-                  ((xd-prime (filter (fn (v) (<= v (fd-dom-max yd))) xd)))
-                  (let
-                    ((s2 (fd-set-domain s (var-name wx) xd-prime)))
-                    (cond
-                      ((= s2 nil) nil)
-                      (:else
-                        (let
-                          ((yd-prime (filter (fn (v) (>= v (fd-dom-min xd-prime))) yd)))
-                          (fd-set-domain s2 (var-name wy) yd-prime))))))))))
-        (:else s)))))
-
-(define
-  fd-lte
-  (fn
-    (x y)
-    (fn
-      (s)
-      (let
-        ((c (fn (sp) (fd-lte-prop x y sp))))
-        (let
-          ((s2 (fd-add-constraint s c)))
-          (let
-            ((s2-or-nil (c s2)))
-            (let
-              ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil)))))
-              (cond ((= s3 nil) mzero) (:else (unit s3))))))))))
-
-;; --- fd-eq ---
-
-(define
-  fd-eq-prop
-  (fn
-    (x y s)
-    (let
-      ((wx (mk-walk x s)) (wy (mk-walk y s)))
-      (cond
-        ((and (number? wx) (number? wy))
-          (cond ((= wx wy) s) (:else nil)))
-        ((and (number? wx) (is-var? wy))
-          (let
-            ((yd (fd-domain-of s (var-name wy))))
-            (cond
-              ((and (not (= yd nil)) (not (fd-dom-member? wx yd))) nil)
-              (:else
-                (let
-                  ((s2 (mk-unify wy wx s)))
-                  (cond ((= s2 nil) nil) (:else s2)))))))
-        ((and (is-var? wx) (number? wy))
-          (let
-            ((xd (fd-domain-of s (var-name wx))))
-            (cond
-              ((and (not (= xd nil)) (not (fd-dom-member? wy xd))) nil)
-              (:else
-                (let
-                  ((s2 (mk-unify wx wy s)))
-                  (cond ((= s2 nil) nil) (:else s2)))))))
-        ((and (is-var? wx) (is-var? wy))
-          (let
-            ((xd (fd-domain-of s (var-name wx)))
-              (yd (fd-domain-of s (var-name wy))))
-            (cond
-              ((and (= xd nil) (= yd nil))
-                (let
-                  ((s2 (mk-unify wx wy s)))
-                  (cond ((= s2 nil) nil) (:else s2))))
-              (:else
-                (let
-                  ((shared (cond ((= xd nil) yd) ((= yd nil) xd) (:else (fd-dom-intersect xd yd)))))
-                  (cond
-                    ((fd-dom-empty? shared) nil)
-                    (:else
-                      (let
-                        ((s2 (fd-set-domain s (var-name wx) shared)))
-                        (cond
-                          ((= s2 nil) nil)
-                          (:else
-                            (let
-                              ((s3 (fd-set-domain s2 (var-name wy) shared)))
-                              (cond
-                                ((= s3 nil) nil)
-                                (:else (mk-unify wx wy s3))))))))))))))
-        (:else s)))))
-
-(define
-  fd-eq
-  (fn
-    (x y)
-    (fn
-      (s)
-      (let
-        ((c (fn (sp) (fd-eq-prop x y sp))))
-        (let
-          ((s2 (fd-add-constraint s c)))
-          (let
-            ((s2-or-nil (c s2)))
-            (let
-              ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil)))))
-              (cond ((= s3 nil) mzero) (:else (unit s3))))))))))
-
-;; --- labelling ---
-
-(define
-  fd-try-each-value
-  (fn
-    (x dom s)
-    (cond
-      ((empty? dom) mzero)
-      (:else
-        (let
-          ((s2 (mk-unify x (first dom) s)))
-          (let
-            ((s3 (cond ((= s2 nil) nil) (:else (fd-fire-store s2)))))
-            (let
-              ((this-stream (cond ((= s3 nil) mzero) (:else (unit s3))))
-                (rest-stream (fd-try-each-value x (rest dom) s)))
-              (mk-mplus this-stream rest-stream))))))))
-
-(define
-  fd-label-one
-  (fn
-    (x)
-    (fn
-      (s)
-      (let
-        ((wx (mk-walk x s)))
-        (cond
-          ((number? wx) (unit s))
-          ((is-var? wx)
-            (let
-              ((dom (fd-domain-of s (var-name wx))))
-              (cond
-                ((= dom nil) mzero)
-                (:else (fd-try-each-value wx dom s)))))
-          (:else mzero))))))
-
-(define
-  fd-label
-  (fn
-    (vars)
-    (cond
-      ((empty? vars) succeed)
-      (:else (mk-conj (fd-label-one (first vars)) (fd-label (rest vars)))))))
-
-;; --- fd-distinct (pairwise distinct via fd-neq) ---
-
-(define
-  fd-distinct-from-head
-  (fn
-    (x others)
-    (cond
-      ((empty? others) succeed)
-      (:else
-        (mk-conj
-          (fd-neq x (first others))
-          (fd-distinct-from-head x (rest others)))))))
-
-(define
-  fd-distinct
-  (fn
-    (vars)
-    (cond
-      ((empty? vars) succeed)
-      ((empty? (rest vars)) succeed)
-      (:else
-        (mk-conj
-          (fd-distinct-from-head (first vars) (rest vars))
-          (fd-distinct (rest vars)))))))
-
-;; --- fd-plus (x + y = z, ground-cases propagator) ---
-
-(define
-  fd-bind-or-narrow
-  (fn
-    (w target s)
-    (cond
-      ((number? w) (cond ((= w target) s) (:else nil)))
-      ((is-var? w)
-        (let
-          ((wd (fd-domain-of s (var-name w))))
-          (cond
-            ((and (not (= wd nil)) (not (fd-dom-member? target wd))) nil)
-            (:else
-              (let
-                ((s2 (mk-unify w target s)))
-                (cond ((= s2 nil) nil) (:else s2)))))))
-      (:else nil))))
-
-(define
-  fd-narrow-or-skip
-  (fn
-    (s var-key d lo hi)
-    (cond
-      ((= d nil) s)
-      (:else
-        (fd-set-domain
-          s
-          var-key
-          (filter (fn (v) (and (>= v lo) (<= v hi))) d))))))
-
-(define
-  fd-plus-prop-vvn
-  (fn
-    (wx wy wz s)
-    (let
-      ((xd (fd-domain-of s (var-name wx)))
-        (yd (fd-domain-of s (var-name wy))))
-      (cond
-        ((or (= xd nil) (= yd nil)) s)
-        (:else
-          (let
-            ((s1 (fd-narrow-or-skip s (var-name wx) xd (- wz (fd-dom-max yd)) (- wz (fd-dom-min yd)))))
-            (cond
-              ((= s1 nil) nil)
-              (:else
-                (let
-                  ((xd2 (fd-domain-of s1 (var-name wx))))
-                  (fd-narrow-or-skip
-                    s1
-                    (var-name wy)
-                    yd
-                    (- wz (fd-dom-max xd2))
-                    (- wz (fd-dom-min xd2))))))))))))
-
-(define
-  fd-plus-prop-nvv
-  (fn
-    (wx wy wz s)
-    (let
-      ((yd (fd-domain-of s (var-name wy)))
-        (zd (fd-domain-of s (var-name wz))))
-      (cond
-        ((or (= yd nil) (= zd nil)) s)
-        (:else
-          (let
-            ((s1 (fd-narrow-or-skip s (var-name wy) yd (- (fd-dom-min zd) wx) (- (fd-dom-max zd) wx))))
-            (cond
-              ((= s1 nil) nil)
-              (:else
-                (let
-                  ((yd2 (fd-domain-of s1 (var-name wy))))
-                  (fd-narrow-or-skip
-                    s1
-                    (var-name wz)
-                    zd
-                    (+ wx (fd-dom-min yd2))
-                    (+ wx (fd-dom-max yd2))))))))))))
-
-(define
-  fd-plus-prop-vnv
-  (fn
-    (wx wy wz s)
-    (let
-      ((xd (fd-domain-of s (var-name wx)))
-        (zd (fd-domain-of s (var-name wz))))
-      (cond
-        ((or (= xd nil) (= zd nil)) s)
-        (:else
-          (let
-            ((s1 (fd-narrow-or-skip s (var-name wx) xd (- (fd-dom-min zd) wy) (- (fd-dom-max zd) wy))))
-            (cond
-              ((= s1 nil) nil)
-              (:else
-                (let
-                  ((xd2 (fd-domain-of s1 (var-name wx))))
-                  (fd-narrow-or-skip
-                    s1
-                    (var-name wz)
-                    zd
-                    (+ (fd-dom-min xd2) wy)
-                    (+ (fd-dom-max xd2) wy))))))))))) 
-
-(define
-  fd-plus-prop-vvv
-  (fn
-    (wx wy wz s)
-    (let
-      ((xd (fd-domain-of s (var-name wx)))
-        (yd (fd-domain-of s (var-name wy)))
-        (zd (fd-domain-of s (var-name wz))))
-      (cond
-        ((or (= xd nil) (or (= yd nil) (= zd nil))) s)
-        (:else
-          (let
-            ((s1 (fd-narrow-or-skip s (var-name wx) xd (- (fd-dom-min zd) (fd-dom-max yd)) (- (fd-dom-max zd) (fd-dom-min yd)))))
-            (cond
-              ((= s1 nil) nil)
-              (:else
-                (let
-                  ((s2 (fd-narrow-or-skip s1 (var-name wy) yd (- (fd-dom-min zd) (fd-dom-max xd)) (- (fd-dom-max zd) (fd-dom-min xd)))))
-                  (cond
-                    ((= s2 nil) nil)
-                    (:else
-                      (fd-narrow-or-skip
-                        s2
-                        (var-name wz)
-                        zd
-                        (+ (fd-dom-min xd) (fd-dom-min yd))
-                        (+ (fd-dom-max xd) (fd-dom-max yd))))))))))))))
-
-(define
-  fd-plus-prop
-  (fn
-    (x y z s)
-    (let
-      ((wx (mk-walk x s)) (wy (mk-walk y s)) (wz (mk-walk z s)))
-      (cond
-        ((and (number? wx) (number? wy) (number? wz))
-          (cond ((= (+ wx wy) wz) s) (:else nil)))
-        ((and (number? wx) (number? wy))
-          (fd-bind-or-narrow wz (+ wx wy) s))
-        ((and (number? wx) (number? wz))
-          (fd-bind-or-narrow wy (- wz wx) s))
-        ((and (number? wy) (number? wz))
-          (fd-bind-or-narrow wx (- wz wy) s))
-        ((and (is-var? wx) (is-var? wy) (number? wz))
-          (fd-plus-prop-vvn wx wy wz s))
-        ((and (number? wx) (is-var? wy) (is-var? wz))
-          (fd-plus-prop-nvv wx wy wz s))
-        ((and (is-var? wx) (number? wy) (is-var? wz))
-          (fd-plus-prop-vnv wx wy wz s))
-        ((and (is-var? wx) (is-var? wy) (is-var? wz))
-          (fd-plus-prop-vvv wx wy wz s))
-        (:else s)))))
-
-(define
-  fd-plus
-  (fn
-    (x y z)
-    (fn
-      (s)
-      (let
-        ((c (fn (sp) (fd-plus-prop x y z sp))))
-        (let
-          ((s2 (fd-add-constraint s c)))
-          (let
-            ((s2-or-nil (c s2)))
-            (let
-              ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil)))))
-              (cond ((= s3 nil) mzero) (:else (unit s3))))))))))
-
-;; --- fd-times (x * y = z, ground-cases propagator) ---
-
-(define
-  fd-int-ceil-div
-  (fn
-    (a b)
-    (cond
-      ((= (mod a b) 0) (/ a b))
-      (:else (+ (fd-int-floor-div a b) 1)))))
-
-(define fd-int-floor-div (fn (a b) (/ (- a (mod a b)) b)))
-
-(define
-  fd-dom-positive?
-  (fn
-    (d)
-    (cond ((empty? d) false) (:else (>= (fd-dom-min d) 1)))))
-
-(define
-  fd-times-prop-vvv
-  (fn
-    (wx wy wz s)
-    (let
-      ((xd (fd-domain-of s (var-name wx)))
-        (yd (fd-domain-of s (var-name wy)))
-        (zd (fd-domain-of s (var-name wz))))
-      (cond
-        ((or (= xd nil) (or (= yd nil) (= zd nil))) s)
-        ((not (and (fd-dom-positive? xd) (and (fd-dom-positive? yd) (fd-dom-positive? zd))))
-          s)
-        (:else
-          (let
-            ((s1 (fd-narrow-or-skip s (var-name wx) xd (fd-int-ceil-div (fd-dom-min zd) (fd-dom-max yd)) (fd-int-floor-div (fd-dom-max zd) (fd-dom-min yd)))))
-            (cond
-              ((= s1 nil) nil)
-              (:else
-                (let
-                  ((s2 (fd-narrow-or-skip s1 (var-name wy) yd (fd-int-ceil-div (fd-dom-min zd) (fd-dom-max xd)) (fd-int-floor-div (fd-dom-max zd) (fd-dom-min xd)))))
-                  (cond
-                    ((= s2 nil) nil)
-                    (:else
-                      (fd-narrow-or-skip
-                        s2
-                        (var-name wz)
-                        zd
-                        (* (fd-dom-min xd) (fd-dom-min yd))
-                        (* (fd-dom-max xd) (fd-dom-max yd))))))))))))))
-
-(define
-  fd-times-prop-vvn
-  (fn
-    (wx wy wz s)
-    (let
-      ((xd (fd-domain-of s (var-name wx)))
-        (yd (fd-domain-of s (var-name wy))))
-      (cond
-        ((or (= xd nil) (= yd nil)) s)
-        ((not (and (fd-dom-positive? xd) (fd-dom-positive? yd))) s)
-        ((<= wz 0) s)
-        (:else
-          (let
-            ((s1 (fd-narrow-or-skip s (var-name wx) xd (fd-int-ceil-div wz (fd-dom-max yd)) (fd-int-floor-div wz (fd-dom-min yd)))))
-            (cond
-              ((= s1 nil) nil)
-              (:else
-                (let
-                  ((xd2 (fd-domain-of s1 (var-name wx))))
-                  (fd-narrow-or-skip
-                    s1
-                    (var-name wy)
-                    yd
-                    (fd-int-ceil-div wz (fd-dom-max xd2))
-                    (fd-int-floor-div wz (fd-dom-min xd2))))))))))))
-
-(define
-  fd-times-prop-nvv
-  (fn
-    (wx wy wz s)
-    (cond
-      ((<= wx 0) s)
-      (:else
-        (let
-          ((yd (fd-domain-of s (var-name wy)))
-            (zd (fd-domain-of s (var-name wz))))
-          (cond
-            ((or (= yd nil) (= zd nil)) s)
-            ((not (and (fd-dom-positive? yd) (fd-dom-positive? zd))) s)
-            (:else
-              (let
-                ((s1 (fd-narrow-or-skip s (var-name wy) yd (fd-int-ceil-div (fd-dom-min zd) wx) (fd-int-floor-div (fd-dom-max zd) wx))))
-                (cond
-                  ((= s1 nil) nil)
-                  (:else
-                    (let
-                      ((yd2 (fd-domain-of s1 (var-name wy))))
-                      (fd-narrow-or-skip
-                        s1
-                        (var-name wz)
-                        zd
-                        (* wx (fd-dom-min yd2))
-                        (* wx (fd-dom-max yd2))))))))))))))
-
-(define
-  fd-times-prop-vnv
-  (fn
-    (wx wy wz s)
-    (cond
-      ((<= wy 0) s)
-      (:else
-        (let
-          ((xd (fd-domain-of s (var-name wx)))
-            (zd (fd-domain-of s (var-name wz))))
-          (cond
-            ((or (= xd nil) (= zd nil)) s)
-            ((not (and (fd-dom-positive? xd) (fd-dom-positive? zd))) s)
-            (:else
-              (let
-                ((s1 (fd-narrow-or-skip s (var-name wx) xd (fd-int-ceil-div (fd-dom-min zd) wy) (fd-int-floor-div (fd-dom-max zd) wy))))
-                (cond
-                  ((= s1 nil) nil)
-                  (:else
-                    (let
-                      ((xd2 (fd-domain-of s1 (var-name wx))))
-                      (fd-narrow-or-skip
-                        s1
-                        (var-name wz)
-                        zd
-                        (* (fd-dom-min xd2) wy)
-                        (* (fd-dom-max xd2) wy))))))))))))) 
-
-(define
-  fd-times-prop
-  (fn
-    (x y z s)
-    (let
-      ((wx (mk-walk x s)) (wy (mk-walk y s)) (wz (mk-walk z s)))
-      (cond
-        ((and (number? wx) (number? wy) (number? wz))
-          (cond ((= (* wx wy) wz) s) (:else nil)))
-        ((and (number? wx) (number? wy))
-          (fd-bind-or-narrow wz (* wx wy) s))
-        ((and (number? wx) (number? wz))
-          (cond
-            ((= wx 0) (cond ((= wz 0) s) (:else nil)))
-            ((not (= (mod wz wx) 0)) nil)
-            (:else (fd-bind-or-narrow wy (/ wz wx) s))))
-        ((and (number? wy) (number? wz))
-          (cond
-            ((= wy 0) (cond ((= wz 0) s) (:else nil)))
-            ((not (= (mod wz wy) 0)) nil)
-            (:else (fd-bind-or-narrow wx (/ wz wy) s))))
-        ((and (is-var? wx) (is-var? wy) (number? wz))
-          (fd-times-prop-vvn wx wy wz s))
-        ((and (number? wx) (is-var? wy) (is-var? wz))
-          (fd-times-prop-nvv wx wy wz s))
-        ((and (is-var? wx) (number? wy) (is-var? wz))
-          (fd-times-prop-vnv wx wy wz s))
-        ((and (is-var? wx) (is-var? wy) (is-var? wz))
-          (fd-times-prop-vvv wx wy wz s))
-        (:else s)))))
-
-(define
-  fd-times
-  (fn
-    (x y z)
-    (fn
-      (s)
-      (let
-        ((c (fn (sp) (fd-times-prop x y z sp))))
-        (let
-          ((s2 (fd-add-constraint s c)))
-          (let
-            ((s2-or-nil (c s2)))
-            (let
-              ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil)))))
-              (cond ((= s3 nil) mzero) (:else (unit s3))))))))))
--- a/lib/minikanren/conda.sx
+++ b/lib/minikanren/conda.sx
@@ -1,42 +0,0 @@
-;; lib/minikanren/conda.sx — Phase 5 piece A: `conda`, the soft-cut.
-;;
-;;   (conda (g0 g ...) (h0 h ...) ...)
-;;     — first clause whose head g0 produces ANY answer wins; ALL of g0's
-;;       answers are then conj'd with the rest of that clause; later
-;;       clauses are NOT tried.
-;;     — differs from condu only in not wrapping g0 in onceo: condu
-;;       commits to the SINGLE first answer, conda lets the head's full
-;;       answer-set flow into the rest of the clause.
-;;       (Reasoned Schemer chapter 10; Byrd 5.3.)
-
-(define
-  conda-try
-  (fn
-    (clauses s)
-    (cond
-      ((empty? clauses) mzero)
-      (:else
-        (let
-          ((cl (first clauses)))
-          (let
-            ((head-goal (first cl)) (rest-goals (rest cl)))
-            (let
-              ((peek (stream-take 1 (head-goal s))))
-              (if
-                (empty? peek)
-                (conda-try (rest clauses) s)
-                (mk-bind (head-goal s) (mk-conj-list rest-goals))))))))))
-
-(defmacro
-  conda
-  (&rest clauses)
-  (quasiquote
-    (fn
-      (s)
-      (conda-try
-        (list
-          (splice-unquote
-            (map
-              (fn (cl) (quasiquote (list (splice-unquote cl))))
-              clauses)))
-        s))))
--- a/lib/minikanren/conde.sx
+++ b/lib/minikanren/conde.sx
@@ -1,39 +0,0 @@
-;; lib/minikanren/conde.sx — Phase 2 piece C: `conde`, the canonical
-;; miniKanren and-or form, with implicit Zzz inverse-eta delay so recursive
-;; relations like appendo terminate.
-;;
-;;   (conde (g1a g1b ...) (g2a g2b ...) ...)
-;;     ≡ (mk-disj (Zzz (mk-conj g1a g1b ...))
-;;                (Zzz (mk-conj g2a g2b ...)) ...)
-;;
-;; `Zzz g` wraps a goal expression in (fn (S) (fn () (g S))) so that
-;; `g`'s body isn't constructed until the surrounding fn is applied to a
-;; substitution AND the returned thunk is forced. This is what gives
-;; miniKanren its laziness — recursive goal definitions can be `(conde
-;; ... (... (recur ...)))` without infinite descent at construction time.
-;;
-;; Hygiene: the substitution parameter is gensym'd so that user goal
-;; expressions which themselves bind `s` (e.g. `(appendo l s ls)`) keep
-;; their lexical `s` and don't accidentally reference the wrapper's
-;; substitution. Without gensym, miniKanren relations that follow the
-;; common (l s ls) parameter convention are silently miscompiled.
-
-(defmacro
-  Zzz
-  (g)
-  (let
-    ((s-sym (gensym "zzz-s-")))
-    (quasiquote
-      (fn ((unquote s-sym)) (fn () ((unquote g) (unquote s-sym)))))))
-
-(defmacro
-  conde
-  (&rest clauses)
-  (quasiquote
-    (mk-disj
-      (splice-unquote
-        (map
-          (fn
-            (clause)
-            (quasiquote (Zzz (mk-conj (splice-unquote clause)))))
-          clauses)))))
--- a/lib/minikanren/condu.sx
+++ b/lib/minikanren/condu.sx
@@ -1,58 +0,0 @@
-;; lib/minikanren/condu.sx — Phase 2 piece D: `condu` and `onceo`.
-;;
-;; Both are commitment forms (no backtracking into discarded options):
-;;
-;;   (onceo g)        — succeeds at most once: takes the first answer
-;;                      stream-take produces from (g s).
-;;
-;;   (condu (g0 g ...) (h0 h ...) ...)
-;;                    — first clause whose head goal succeeds wins; only
-;;                      the first answer of the head is propagated to the
-;;                      rest of that clause; later clauses are not tried.
-;;                      (Reasoned Schemer chapter 10; Byrd 5.4.)
-
-(define
-  onceo
-  (fn
-    (g)
-    (fn
-      (s)
-      (let
-        ((peek (stream-take 1 (g s))))
-        (if (empty? peek) mzero (unit (first peek)))))))
-
-;; condu-try — runtime walker over a list of clauses (each clause a list of
-;; goals). Forces the head with stream-take 1; if head fails, recurse to
-;; the next clause; if head succeeds, commits its single answer through
-;; the rest of the clause.
-(define
-  condu-try
-  (fn
-    (clauses s)
-    (cond
-      ((empty? clauses) mzero)
-      (:else
-        (let
-          ((cl (first clauses)))
-          (let
-            ((head-goal (first cl)) (rest-goals (rest cl)))
-            (let
-              ((peek (stream-take 1 (head-goal s))))
-              (if
-                (empty? peek)
-                (condu-try (rest clauses) s)
-                ((mk-conj-list rest-goals) (first peek))))))))))
-
-(defmacro
-  condu
-  (&rest clauses)
-  (quasiquote
-    (fn
-      (s)
-      (condu-try
-        (list
-          (splice-unquote
-            (map
-              (fn (cl) (quasiquote (list (splice-unquote cl))))
-              clauses)))
-        s))))
--- a/lib/minikanren/defrel.sx
+++ b/lib/minikanren/defrel.sx
@@ -1,25 +0,0 @@
-;; lib/minikanren/defrel.sx — Prolog-style defrel macro.
-;;
-;;   (defrel (NAME ARG1 ARG2 ...)
-;;     (CLAUSE1 ...)
-;;     (CLAUSE2 ...)
-;;     ...)
-;;
-;; expands to
-;;
-;;   (define NAME (fn (ARG1 ARG2 ...) (conde (CLAUSE1 ...) (CLAUSE2 ...))))
-;;
-;; This puts each clause's goals immediately after the head, mirroring
-;; Prolog's `name(Args) :- goals.` shape. Clauses are conde-conjoined
-;; goals — `Zzz`-wrapping is automatic via `conde`, so recursive
-;; relations terminate on partial answers.
-
-(defmacro
-  defrel
-  (head &rest clauses)
-  (let
-    ((name (first head)) (args (rest head)))
-    (list
-      (quote define)
-      name
-      (list (quote fn) args (cons (quote conde) clauses)))))
--- a/lib/minikanren/diseq.sx
+++ b/lib/minikanren/diseq.sx
@@ -1,71 +0,0 @@
-;; lib/minikanren/diseq.sx — Phase 5 polish: =/= disequality with a
-;; constraint store, generalising nafc / fd-neq to logic terms.
-;;
-;; The constraint store lives under the same `_fd` reserved key as the
-;; CLP(FD) propagators (a disequality is just another constraint
-;; closure that the existing fd-fire-store machinery re-runs).
-;;
-;; =/= semantics:
-;;   - If u and v walk to ground non-unifiable terms, succeed (drop).
-;;   - If they walk to terms that COULD become equal under a future
-;;     binding, store the constraint; re-check after each binding.
-;;   - If they're already equal (unify with no new bindings), fail.
-;;
-;; Implementation: each =/= test attempts (mk-unify wu wv s).
-;;   nil      — distinct, keep s, drop the constraint (return s).
-;;   subst eq — equal, fail (return nil).
-;;   subst >  — partially unifiable; keep the constraint, return s.
-;;
-;; "Substitution equal to s" is detected via key-count: mk-unify only
-;; ever extends a substitution, never removes from it, so equal
-;; key-count means no new bindings were needed.
-
-(define
-  =/=-prop
-  (fn
-    (u v s)
-    (let
-      ((s-after (mk-unify u v s)))
-      (cond
-        ((= s-after nil) s)
-        ((= (len (keys s)) (len (keys s-after))) nil)
-        (:else s)))))
-
-(define
-  =/=
-  (fn
-    (u v)
-    (fn
-      (s)
-      (let
-        ((c (fn (sp) (=/=-prop u v sp))))
-        (let
-          ((s2 (fd-add-constraint s c)))
-          (let
-            ((s2-or-nil (c s2)))
-            (let
-              ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil)))))
-              (cond ((= s3 nil) mzero) (:else (unit s3))))))))))
-
-;; --- constraint-aware == ---
-;;
-;; Plain `==` doesn't fire the constraint store, so a binding that
-;; should violate a pending =/= goes undetected. `==-cs` is the
-;; drop-in replacement that fires fd-fire-store after each binding.
-;; Use ==-cs in any program that mixes =/= (or fd-* goals that should
-;; re-check after non-FD bindings) with regular unification.
-
-(define
-  ==-cs
-  (fn
-    (u v)
-    (fn
-      (s)
-      (let
-        ((s2 (mk-unify u v s)))
-        (cond
-          ((= s2 nil) mzero)
-          (:else
-            (let
-              ((s3 (fd-fire-store s2)))
-              (cond ((= s3 nil) mzero) (:else (unit s3))))))))))
--- a/lib/minikanren/fd.sx
+++ b/lib/minikanren/fd.sx
@@ -1,25 +0,0 @@
-;; lib/minikanren/fd.sx — Phase 6 piece A: minimal finite-domain helpers.
-;;
-;; A full CLP(FD) engine (arc consistency, native integer domains, fd-plus
-;; etc.) is Phase 6 proper. For now we expose two small relations layered
-;; on the existing list machinery — they're sufficient for permutation
-;; puzzles, the N-queens-style core of constraint solving:
-;;
-;;   (ino x dom)         — x is a member of dom (alias for membero with the
-;;                         constraint-store-friendly argument order).
-;;   (all-distincto l)   — all elements of l are pairwise distinct.
-;;
-;; all-distincto uses nafc + membero on the tail — it requires the head
-;; element of each recursive step to be ground enough for membero to be
-;; finitary, so order matters: prefer (in x dom) goals BEFORE
-;; (all-distincto (list x ...)) so values get committed first.
-
-(define ino (fn (x dom) (membero x dom)))
-
-(define
-  all-distincto
-  (fn
-    (l)
-    (conde
-      ((nullo l))
-      ((fresh (a d) (conso a d l) (nafc (membero a d)) (all-distincto d))))))
--- a/lib/minikanren/fresh.sx
+++ b/lib/minikanren/fresh.sx
@@ -1,23 +0,0 @@
-;; lib/minikanren/fresh.sx — Phase 2 piece B: `fresh` for introducing
-;; logic variables inside a goal body.
-;;
-;;   (fresh (x y z) goal1 goal2 ...)
-;;     ≡ (let ((x (make-var)) (y (make-var)) (z (make-var)))
-;;         (mk-conj goal1 goal2 ...))
-;;
-;; A macro rather than a function so user-named vars are real lexical
-;; bindings — which is also what miniKanren convention expects.
-;; The empty-vars form (fresh () goal ...) is just a goal grouping.
-
-(defmacro
-  fresh
-  (vars &rest goals)
-  (quasiquote
-    (let
-      (unquote (map (fn (v) (list v (list (quote make-var)))) vars))
-      (mk-conj (splice-unquote goals)))))
-
-;; call-fresh — functional alternative for code that builds goals
-;; programmatically:
-;;   ((call-fresh (fn (x) (== x 7))) empty-s) → ({:_.N 7})
-(define call-fresh (fn (f) (fn (s) ((f (make-var)) s))))
--- a/lib/minikanren/goals.sx
+++ b/lib/minikanren/goals.sx
@@ -1,58 +0,0 @@
-;; lib/minikanren/goals.sx — Phase 2 piece B: core goals.
-;;
-;; A goal is a function (fn (s) → stream-of-substitutions).
-;; Goals built here:
-;;   succeed         — always returns (unit s)
-;;   fail            — always returns mzero
-;;   ==              — unifies two terms; succeeds with a singleton, else fails
-;;   ==-check        — opt-in occurs-checked equality
-;;   conj2 / mk-conj — sequential conjunction of goals
-;;   disj2 / mk-disj — interleaved disjunction of goals (raw — `conde` adds
-;;                     the implicit-conj-per-clause sugar in a later commit)
-
-(define succeed (fn (s) (unit s)))
-
-(define fail (fn (s) mzero))
-
-(define
-  ==
-  (fn
-    (u v)
-    (fn
-      (s)
-      (let ((s2 (mk-unify u v s))) (if (= s2 nil) mzero (unit s2))))))
-
-(define
-  ==-check
-  (fn
-    (u v)
-    (fn
-      (s)
-      (let ((s2 (mk-unify-check u v s))) (if (= s2 nil) mzero (unit s2))))))
-
-(define conj2 (fn (g1 g2) (fn (s) (mk-bind (g1 s) g2))))
-
-(define disj2 (fn (g1 g2) (fn (s) (mk-mplus (g1 s) (g2 s)))))
-
-;; Fold goals in a list. (mk-conj-list ()) ≡ succeed; (mk-disj-list ()) ≡ fail.
-(define
-  mk-conj-list
-  (fn
-    (gs)
-    (cond
-      ((empty? gs) succeed)
-      ((empty? (rest gs)) (first gs))
-      (:else (conj2 (first gs) (mk-conj-list (rest gs)))))))
-
-(define
-  mk-disj-list
-  (fn
-    (gs)
-    (cond
-      ((empty? gs) fail)
-      ((empty? (rest gs)) (first gs))
-      (:else (disj2 (first gs) (mk-disj-list (rest gs)))))))
-
-(define mk-conj (fn (&rest gs) (mk-conj-list gs)))
-
-(define mk-disj (fn (&rest gs) (mk-disj-list gs)))
--- a/lib/minikanren/intarith.sx
+++ b/lib/minikanren/intarith.sx
@@ -1,151 +0,0 @@
-;; lib/minikanren/intarith.sx — fast integer arithmetic via project.
-;;
-;; These are ground-only escapes into host arithmetic. They run at native
-;; speed (host ints) but require their arguments to walk to actual numbers
-;; — they are not relational the way `pluso` (Peano) is. Use them when
-;; the puzzle size makes Peano impractical.
-;;
-;; Naming: `-i` suffix marks "integer-only" goals.
-
-(define
-  pluso-i
-  (fn
-    (a b c)
-    (project
-      (a b)
-      (if (and (number? a) (number? b)) (== c (+ a b)) fail))))
-
-(define
-  minuso-i
-  (fn
-    (a b c)
-    (project
-      (a b)
-      (if (and (number? a) (number? b)) (== c (- a b)) fail))))
-
-(define
-  *o-i
-  (fn
-    (a b c)
-    (project
-      (a b)
-      (if (and (number? a) (number? b)) (== c (* a b)) fail))))
-
-(define
-  lto-i
-  (fn
-    (a b)
-    (project
-      (a b)
-      (if (and (number? a) (and (number? b) (< a b))) succeed fail))))
-
-(define
-  lteo-i
-  (fn
-    (a b)
-    (project
-      (a b)
-      (if (and (number? a) (and (number? b) (<= a b))) succeed fail))))
-
-(define
-  neqo-i
-  (fn
-    (a b)
-    (project
-      (a b)
-      (if (and (number? a) (and (number? b) (not (= a b)))) succeed fail))))
-
-(define numbero (fn (x) (project (x) (if (number? x) succeed fail))))
-
-(define stringo (fn (x) (project (x) (if (string? x) succeed fail))))
-
-(define symbolo (fn (x) (project (x) (if (symbol? x) succeed fail))))
-
-(define
-  even-i
-  (fn (n) (project (n) (if (and (number? n) (even? n)) succeed fail))))
-
-(define
-  odd-i
-  (fn (n) (project (n) (if (and (number? n) (odd? n)) succeed fail))))
-
-(define
-  sortedo
-  (fn
-    (l)
-    (conde
-      ((nullo l))
-      ((fresh (a) (== l (list a))))
-      ((fresh (a b rest mid) (conso a mid l) (conso b rest mid) (lteo-i a b) (sortedo mid))))))
-
-(define
-  mino
-  (fn
-    (l m)
-    (conde
-      ((fresh (a) (== l (list a)) (== m a)))
-      ((fresh (a d rest-min) (conso a d l) (mino d rest-min) (conde ((lteo-i a rest-min) (== m a)) ((lto-i rest-min a) (== m rest-min))))))))
-
-(define
-  maxo
-  (fn
-    (l m)
-    (conde
-      ((fresh (a) (== l (list a)) (== m a)))
-      ((fresh (a d rest-max) (conso a d l) (maxo d rest-max) (conde ((lteo-i rest-max a) (== m a)) ((lto-i a rest-max) (== m rest-max))))))))
-
-(define
-  sumo
-  (fn
-    (l total)
-    (conde
-      ((nullo l) (== total 0))
-      ((fresh (a d rest-sum) (conso a d l) (sumo d rest-sum) (pluso-i a rest-sum total))))))
-
-(define
-  producto
-  (fn
-    (l total)
-    (conde
-      ((nullo l) (== total 1))
-      ((fresh (a d rest-prod) (conso a d l) (producto d rest-prod) (*o-i a rest-prod total))))))
-
-(define
-  lengtho-i
-  (fn
-    (l n)
-    (conde
-      ((nullo l) (== n 0))
-      ((fresh (a d n-1) (conso a d l) (lengtho-i d n-1) (pluso-i 1 n-1 n))))))
-
-(define
-  enumerate-from-i
-  (fn
-    (start l result)
-    (conde
-      ((nullo l) (nullo result))
-      ((fresh (a d r-rest start-prime) (conso a d l) (conso (list start a) r-rest result) (pluso-i 1 start start-prime) (enumerate-from-i start-prime d r-rest))))))
-
-(define enumerate-i (fn (l result) (enumerate-from-i 0 l result)))
-
-(define
-  counto
-  (fn
-    (x l n)
-    (conde
-      ((nullo l) (== n 0))
-      ((fresh (a d n-rest) (conso a d l) (conde ((== a x) (counto x d n-rest) (pluso-i 1 n-rest n)) ((nafc (== a x)) (counto x d n))))))))
-
-(define
-  mk-arith-prog
-  (fn
-    (start step len)
-    (cond
-      ((= len 0) (list))
-      (:else (cons start (mk-arith-prog (+ start step) step (- len 1)))))))
-
-(define
-  arith-progo
-  (fn
-    (start step len result)
-    (project (start step len) (== result (mk-arith-prog start step len)))))
--- a/lib/minikanren/matche.sx
+++ b/lib/minikanren/matche.sx
@@ -1,76 +0,0 @@
-;; lib/minikanren/matche.sx — Phase 5 piece D: pattern matching over terms.
-;;
-;;   (matche TARGET
-;;     (PATTERN1 g1 g2 ...)
-;;     (PATTERN2 g1 ...)
-;;     ...)
-;;
-;; Pattern grammar:
-;;   _                 wildcard — fresh anonymous var
-;;   x                 plain symbol — fresh var, bind by name
-;;   ATOM              literal (number, string, boolean) — must equal
-;;   :keyword          keyword literal — emitted bare (keywords self-evaluate
-;;                     to their string name in SX, so quoting them changes
-;;                     their type from string to keyword)
-;;   ()                empty list — must equal
-;;   (p1 p2 ... pn)    list pattern — recurse on each element
-;;
-;; The macro expands to a `conde` whose clauses are
-;;   `((fresh (vars-in-pat) (== target pat-expr) body...))`.
-;;
-;; Repeated symbol names within a pattern produce the same fresh var, so
-;; they unify by `==`. Fixed-length list patterns only — head/tail
-;; destructuring uses `(fresh (a d) (conso a d target) body)` directly.
-;;
-;; Note: the macro builds the expansion via `cons` / `list` rather than a
-;; quasiquote — quasiquote does not recurse into nested lambda bodies in
-;; SX, so `\`(matche-clause (quote ,target) cl)` left literal
-;; `(unquote target)` in the output.
-
-(define matche-symbol-var? (fn (s) (symbol? s)))
-
-(define
-  matche-collect-vars-acc
-  (fn
-    (pat acc)
-    (cond
-      ((matche-symbol-var? pat)
-        (if (some (fn (s) (= s pat)) acc) acc (append acc (list pat))))
-      ((and (list? pat) (not (empty? pat)))
-        (reduce (fn (a p) (matche-collect-vars-acc p a)) acc pat))
-      (:else acc))))
-
-(define
-  matche-collect-vars
-  (fn (pat) (matche-collect-vars-acc pat (list))))
-
-(define
-  matche-pattern->expr
-  (fn
-    (pat)
-    (cond
-      ((matche-symbol-var? pat) pat)
-      ((and (list? pat) (empty? pat)) (list (quote list)))
-      ((list? pat) (cons (quote list) (map matche-pattern->expr pat)))
-      ((keyword? pat) pat)
-      (:else (list (quote quote) pat)))))
-
-(define
-  matche-clause
-  (fn
-    (target cl)
-    (let
-      ((pat (first cl)) (body (rest cl)))
-      (let
-        ((vars (matche-collect-vars pat)))
-        (let
-          ((pat-expr (matche-pattern->expr pat)))
-          (list
-            (cons
-              (quote fresh)
-              (cons vars (cons (list (quote ==) target pat-expr) body)))))))))
-
-(defmacro
-  matche
-  (target &rest clauses)
-  (cons (quote conde) (map (fn (cl) (matche-clause target cl)) clauses)))
--- a/lib/minikanren/nafc.sx
+++ b/lib/minikanren/nafc.sx
@@ -1,24 +0,0 @@
-;; lib/minikanren/nafc.sx — Phase 5 piece C: negation as finite failure.
-;;
-;;   (nafc g)
-;;     succeeds (yields the input substitution) if g has zero answers
-;;     against that substitution; fails (mzero) if g has at least one.
-;;
-;; Caveat: `nafc` is unsound under the open-world assumption. It only
-;; makes sense for goals over fully-ground terms, or with the explicit
-;; understanding that adding more facts could flip the answer. Use
-;; `(project (...) ...)` to ensure the relevant vars are ground first.
-;;
-;; Caveat 2: stream-take forces g for at least one answer; if g is
-;; infinitely-ground (say, a divergent search over an unbound list),
-;; nafc itself will diverge. Standard miniKanren limitation.
-
-(define
-  nafc
-  (fn
-    (g)
-    (fn
-      (s)
-      (let
-        ((peek (stream-take 1 (g s))))
-        (if (empty? peek) (unit s) mzero)))))
--- a/lib/minikanren/peano.sx
+++ b/lib/minikanren/peano.sx
@@ -1,51 +0,0 @@
-;; lib/minikanren/peano.sx — Peano-encoded natural-number relations.
-;;
-;; Same encoding as `lengtho`: zero is the keyword `:z`; successors are
-;; `(:s n)`. So 3 = `(:s (:s (:s :z)))`. `(:z)` and `(:s ...)` are normal
-;; SX values that unify positionally — no special primitives needed.
-;;
-;; Peano arithmetic is the canonical miniKanren way to test addition /
-;; multiplication / less-than relationally without an FD constraint store.
-;; (CLP(FD) integers come in Phase 6.)
-
-(define zeroo (fn (n) (== n :z)))
-
-(define succ-of (fn (n m) (== m (list :s n))))
-
-(define
-  pluso
-  (fn
-    (a b c)
-    (conde
-      ((== a :z) (== b c))
-      ((fresh (a-1 c-1) (== a (list :s a-1)) (== c (list :s c-1)) (pluso a-1 b c-1))))))
-
-(define minuso (fn (a b c) (pluso b c a)))
-
-(define lteo (fn (a b) (fresh (k) (pluso a k b))))
-
-(define lto (fn (a b) (fresh (sa) (succ-of a sa) (lteo sa b))))
-
-(define
-  eveno
-  (fn
-    (n)
-    (conde
-      ((== n :z))
-      ((fresh (m) (== n (list :s (list :s m))) (eveno m))))))
-
-(define
-  oddo
-  (fn
-    (n)
-    (conde
-      ((== n (list :s :z)))
-      ((fresh (m) (== n (list :s (list :s m))) (oddo m))))))
-
-(define
-  *o
-  (fn
-    (a b c)
-    (conde
-      ((== a :z) (== c :z))
-      ((fresh (a-1 ab-1) (== a (list :s a-1)) (*o a-1 b ab-1) (pluso b ab-1 c))))))
--- a/lib/minikanren/project.sx
+++ b/lib/minikanren/project.sx
@@ -1,25 +0,0 @@
-;; lib/minikanren/project.sx — Phase 5 piece B: `project`.
-;;
-;;   (project (x y) g1 g2 ...)
-;;     — rebinds each named var to (mk-walk* var s) within the body's
-;;       lexical scope, then runs the conjunction of the body goals on
-;;       the same substitution. Use to escape into regular SX (arithmetic,
-;;       string ops, host predicates) when you need a ground value.
-;;
-;; If any of the projected vars is still unbound at this point, the body
-;; sees the raw `(:var NAME)` term — that is intentional and lets you
-;; mix project with `(== ground? var)` patterns or with conda guards.
-;;
-;; Hygiene: substitution parameter is gensym'd so it doesn't capture user
-;; vars (`s` is a popular relation parameter name).
-
-(defmacro
-  project
-  (vars &rest goals)
-  (let
-    ((s-sym (gensym "proj-s-")))
-    (quasiquote
-      (fn
-        ((unquote s-sym))
-        ((let (unquote (map (fn (v) (list v (list (quote mk-walk*) v s-sym))) vars)) (mk-conj (splice-unquote goals)))
-          (unquote s-sym))))))
--- a/lib/minikanren/queens.sx
+++ b/lib/minikanren/queens.sx
@@ -1,67 +0,0 @@
-;; lib/minikanren/queens.sx — N-queens via ino + all-distincto + project.
-;;
-;; Encoding: q = (c1 c2 ... cn) where ci is the column of the queen in
-;; row i. Each ci ∈ {1..n}; all distinct (no two queens share a column);
-;; no two queens on the same diagonal (|ci - cj| ≠ |i - j| for i ≠ j).
-;;
-;; The diagonal check uses `project` to escape into host arithmetic
-;; once both column values are ground.
-
-(define
-  safe-diag
-  (fn
-    (a b dist)
-    (project (a b) (if (= (abs (- a b)) dist) fail succeed))))
-
-(define
-  safe-cell-vs-rest
-  (fn
-    (c c-row others next-row)
-    (cond
-      ((empty? others) succeed)
-      (:else
-        (mk-conj
-          (safe-diag c (first others) (- next-row c-row))
-          (safe-cell-vs-rest c c-row (rest others) (+ next-row 1)))))))
-
-(define
-  all-cells-safe
-  (fn
-    (cols start-row)
-    (cond
-      ((empty? cols) succeed)
-      (:else
-        (mk-conj
-          (safe-cell-vs-rest
-            (first cols)
-            start-row
-            (rest cols)
-            (+ start-row 1))
-          (all-cells-safe (rest cols) (+ start-row 1)))))))
-
-(define
-  range-1-to-n
-  (fn
-    (n)
-    (cond
-      ((= n 0) (list))
-      (:else (append (range-1-to-n (- n 1)) (list n))))))
-
-(define
-  ino-each
-  (fn
-    (cols dom)
-    (cond
-      ((empty? cols) succeed)
-      (:else (mk-conj (ino (first cols) dom) (ino-each (rest cols) dom))))))
-
-(define
-  queens-cols
-  (fn
-    (cols n)
-    (let
-      ((dom (range-1-to-n n)))
-      (mk-conj
-        (ino-each cols dom)
-        (all-distincto cols)
-        (all-cells-safe cols 1)))))
--- a/lib/minikanren/relations.sx
+++ b/lib/minikanren/relations.sx
@@ -1,361 +0,0 @@
-;; lib/minikanren/relations.sx — Phase 4 standard relations.
-;;
-;; Programs use native SX lists as data. Relations decompose lists via the
-;; tagged cons-cell shape `(:cons h t)` because SX has no improper pairs;
-;; the unifier treats `(:cons h t)` and the native list `(h . t)` as
-;; equivalent, and `mk-walk*` flattens cons cells back to flat lists for
-;; reification.
-
-;; --- pair / list shape relations ---
-
-(define nullo (fn (l) (== l (list))))
-
-(define pairo (fn (p) (fresh (a d) (== p (mk-cons a d)))))
-
-(define caro (fn (p a) (fresh (d) (== p (mk-cons a d)))))
-
-(define cdro (fn (p d) (fresh (a) (== p (mk-cons a d)))))
-
-(define conso (fn (a d p) (== p (mk-cons a d))))
-
-(define firsto caro)
-(define resto cdro)
-
-(define
-  listo
-  (fn (l) (conde ((nullo l)) ((fresh (a d) (conso a d l) (listo d))))))
-
-;; --- appendo: the canary ---
-;;
-;; (appendo l s ls) — `ls` is the concatenation of `l` and `s`.
-;; Runs forwards (l, s known → ls), backwards (ls known → all (l, s) pairs),
-;; and bidirectionally (mix of bound + unbound).
-
-(define
-  appendo
-  (fn
-    (l s ls)
-    (conde
-      ((nullo l) (== s ls))
-      ((fresh (a d res) (conso a d l) (conso a res ls) (appendo d s res))))))
-
-;; --- membero ---
-;; (membero x l) — x appears (at least once) in l.
-
-(define
-  appendo3
-  (fn
-    (l1 l2 l3 result)
-    (fresh (l12) (appendo l1 l2 l12) (appendo l12 l3 result))))
-
-(define
-  partitiono
-  (fn
-    (pred l yes no)
-    (conde
-      ((nullo l) (nullo yes) (nullo no))
-      ((fresh (a d y-rest n-rest) (conso a d l) (conde ((pred a) (conso a y-rest yes) (== no n-rest) (partitiono pred d y-rest n-rest)) ((nafc (pred a)) (== yes y-rest) (conso a n-rest no) (partitiono pred d y-rest n-rest))))))))
-
-(define
-  foldr-o
-  (fn
-    (rel l acc result)
-    (conde
-      ((nullo l) (== result acc))
-      ((fresh (a d r-rest) (conso a d l) (foldr-o rel d acc r-rest) (rel a r-rest result))))))
-
-(define
-  foldl-o
-  (fn
-    (rel l acc result)
-    (conde
-      ((nullo l) (== result acc))
-      ((fresh (a d new-acc) (conso a d l) (rel acc a new-acc) (foldl-o rel d new-acc result))))))
-
-(define
-  flat-mapo
-  (fn
-    (rel l result)
-    (conde
-      ((nullo l) (nullo result))
-      ((fresh (a d a-result rest-result) (conso a d l) (rel a a-result) (flat-mapo rel d rest-result) (appendo a-result rest-result result))))))
-
-(define
-  nub-o
-  (fn
-    (l result)
-    (conde
-      ((nullo l) (nullo result))
-      ((fresh (a d r-rest) (conso a d l) (conde ((membero a d) (nub-o d result)) ((nafc (membero a d)) (conso a r-rest result) (nub-o d r-rest))))))))
-
-
-(define
-  take-while-o
-  (fn
-    (pred l result)
-    (conde
-      ((nullo l) (nullo result))
-      ((fresh (a d r-rest) (conso a d l) (conde ((pred a) (conso a r-rest result) (take-while-o pred d r-rest)) ((nafc (pred a)) (== result (list)))))))))
-
-(define
-  drop-while-o
-  (fn
-    (pred l result)
-    (conde
-      ((nullo l) (nullo result))
-      ((fresh (a d) (conso a d l) (conde ((pred a) (drop-while-o pred d result)) ((nafc (pred a)) (== result l))))))))
-
-(define
-  membero
-  (fn
-    (x l)
-    (conde
-      ((fresh (d) (conso x d l)))
-      ((fresh (a d) (conso a d l) (membero x d))))))
-
-(define
-  not-membero
-  (fn
-    (x l)
-    (conde
-      ((nullo l))
-      ((fresh (a d) (conso a d l) (nafc (== a x)) (not-membero x d))))))
-
-(define
-  subseto
-  (fn
-    (l1 l2)
-    (conde
-      ((nullo l1))
-      ((fresh (a d) (conso a d l1) (membero a l2) (subseto d l2))))))
-
-(define
-  reverseo
-  (fn
-    (l r)
-    (conde
-      ((nullo l) (nullo r))
-      ((fresh (a d res-rev) (conso a d l) (reverseo d res-rev) (appendo res-rev (list a) r))))))
-
-(define
-  rev-acco
-  (fn
-    (l acc result)
-    (conde
-      ((nullo l) (== result acc))
-      ((fresh (a d acc-prime) (conso a d l) (conso a acc acc-prime) (rev-acco d acc-prime result))))))
-
-(define rev-2o (fn (l result) (rev-acco l (list) result)))
-
-(define palindromeo (fn (l) (fresh (rev) (reverseo l rev) (== l rev))))
-
-(define prefixo (fn (p l) (fresh (rest) (appendo p rest l))))
-
-(define suffixo (fn (s l) (fresh (front) (appendo front s l))))
-
-(define
-  subo
-  (fn
-    (s l)
-    (fresh
-      (front-and-s back front)
-      (appendo front-and-s back l)
-      (appendo front s front-and-s))))
-
-(define
-  selecto
-  (fn
-    (x rest l)
-    (conde
-      ((conso x rest l))
-      ((fresh (a d r) (conso a d l) (conso a r rest) (selecto x r d))))))
-
-(define
-  lengtho
-  (fn
-    (l n)
-    (conde
-      ((nullo l) (== n :z))
-      ((fresh (a d n-1) (conso a d l) (== n (list :s n-1)) (lengtho d n-1))))))
-
-(define
-  inserto
-  (fn
-    (a l p)
-    (conde
-      ((conso a l p))
-      ((fresh (h t pt) (conso h t l) (conso h pt p) (inserto a t pt))))))
-
-(define
-  permuteo
-  (fn
-    (l p)
-    (conde
-      ((nullo l) (nullo p))
-      ((fresh (a d perm-d) (conso a d l) (permuteo d perm-d) (inserto a perm-d p))))))
-
-(define
-  flatteno
-  (fn
-    (tree flat)
-    (conde
-      ((nullo tree) (nullo flat))
-      ((pairo tree)
-        (fresh
-          (h t hf tf)
-          (conso h t tree)
-          (flatteno h hf)
-          (flatteno t tf)
-          (appendo hf tf flat)))
-      ((nafc (nullo tree)) (nafc (pairo tree)) (== flat (list tree))))))
-
-(define
-  rembero
-  (fn
-    (x l out)
-    (conde
-      ((nullo l) (nullo out))
-      ((fresh (a d) (conso a d l) (== a x) (== out d)))
-      ((fresh (a d res) (conso a d l) (nafc (== a x)) (conso a res out) (rembero x d res))))))
-
-(define
-  removeo-allo
-  (fn
-    (x l result)
-    (conde
-      ((nullo l) (nullo result))
-      ((fresh (a d) (conso a d l) (== a x) (removeo-allo x d result)))
-      ((fresh (a d r-rest) (conso a d l) (nafc (== a x)) (conso a r-rest result) (removeo-allo x d r-rest))))))
-
-(define
-  assoco
-  (fn
-    (key pairs val)
-    (fresh
-      (rest)
-      (conde
-        ((conso (list key val) rest pairs))
-        ((fresh (other) (conso other rest pairs) (assoco key rest val)))))))
-
-(define
-  nth-o
-  (fn
-    (n l elem)
-    (conde
-      ((== n :z) (fresh (d) (conso elem d l)))
-      ((fresh (n-1 a d) (== n (list :s n-1)) (conso a d l) (nth-o n-1 d elem))))))
-
-(define
-  samelengtho
-  (fn
-    (l1 l2)
-    (conde
-      ((nullo l1) (nullo l2))
-      ((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (samelengtho d d-prime))))))
-
-(define
-  mapo
-  (fn
-    (rel l1 l2)
-    (conde
-      ((nullo l1) (nullo l2))
-      ((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (rel a a-prime) (mapo rel d d-prime))))))
-
-(define
-  iterate-no
-  (fn
-    (rel n x result)
-    (conde
-      ((== n :z) (== result x))
-      ((fresh (n-1 mid) (== n (list :s n-1)) (rel x mid) (iterate-no rel n-1 mid result))))))
-
-(define
-  pairlisto
-  (fn
-    (l1 l2 pairs)
-    (conde
-      ((nullo l1) (nullo l2) (nullo pairs))
-      ((fresh (a1 d1 a2 d2 d-pairs) (conso a1 d1 l1) (conso a2 d2 l2) (conso (list a1 a2) d-pairs pairs) (pairlisto d1 d2 d-pairs))))))
-
-(define
-  zip-with-o
-  (fn
-    (rel l1 l2 result)
-    (conde
-      ((nullo l1) (nullo l2) (nullo result))
-      ((fresh (a1 d1 a2 d2 a-result d-result) (conso a1 d1 l1) (conso a2 d2 l2) (rel a1 a2 a-result) (conso a-result d-result result) (zip-with-o rel d1 d2 d-result))))))
-
-(define
-  swap-firsto
-  (fn
-    (l result)
-    (fresh
-      (a b rest mid-l mid-r)
-      (conso a mid-l l)
-      (conso b rest mid-l)
-      (conso b mid-r result)
-      (conso a rest mid-r))))
-
-(define
-  everyo
-  (fn
-    (rel l)
-    (conde
-      ((nullo l))
-      ((fresh (a d) (conso a d l) (rel a) (everyo rel d))))))
-
-(define
-  someo
-  (fn
-    (rel l)
-    (conde
-      ((fresh (a d) (conso a d l) (rel a)))
-      ((fresh (a d) (conso a d l) (someo rel d))))))
-
-(define
-  lasto
-  (fn
-    (l x)
-    (conde
-      ((conso x (list) l))
-      ((fresh (a d) (conso a d l) (lasto d x))))))
-
-(define
-  init-o
-  (fn
-    (l init)
-    (conde
-      ((fresh (x) (conso x (list) l) (== init (list))))
-      ((fresh (a d d-init) (conso a d l) (conso a d-init init) (init-o d d-init))))))
-
-(define
-  tako
-  (fn
-    (n l prefix)
-    (conde
-      ((== n :z) (== prefix (list)))
-      ((fresh (n-1 a d p-rest) (== n (list :s n-1)) (conso a d l) (conso a p-rest prefix) (tako n-1 d p-rest))))))
-
-(define
-  dropo
-  (fn
-    (n l suffix)
-    (conde
-      ((== n :z) (== suffix l))
-      ((fresh (n-1 a d) (== n (list :s n-1)) (conso a d l) (dropo n-1 d suffix))))))
-
-(define
-  repeato
-  (fn
-    (x n result)
-    (conde
-      ((== n :z) (== result (list)))
-      ((fresh (n-1 r-rest) (== n (list :s n-1)) (conso x r-rest result) (repeato x n-1 r-rest))))))
-
-(define
-  concato
-  (fn
-    (lists result)
-    (conde
-      ((nullo lists) (nullo result))
-      ((fresh (h t r-rest) (conso h t lists) (appendo h r-rest result) (concato t r-rest))))))
--- a/lib/minikanren/run.sx
+++ b/lib/minikanren/run.sx
@@ -1,56 +0,0 @@
-;; lib/minikanren/run.sx — Phase 3: drive a goal + reify the query var.
-;;
-;; reify-name N        — make the canonical "_.N" reified symbol.
-;; reify-s term rs     — walk term in rs, add a mapping from each fresh
-;;                       unbound var to its _.N name (left-to-right order).
-;; reify q s           — walk* q in s, build reify-s, walk* again to
-;;                       substitute reified names in.
-;; run-n n q-name g... — defmacro: bind q-name to a fresh var, conj goals,
-;;                       take ≤ n answers from the stream, reify each
-;;                       through q-name. n = -1 takes all (used by run*).
-;; run*                — defmacro: (run* q g...) ≡ (run-n -1 q g...)
-;; run                 — defmacro: (run n q g...) ≡ (run-n n q g...)
-;;                       The two-segment form is the standard TRS API.
-
-(define reify-name (fn (n) (make-symbol (str "_." n))))
-
-(define
-  reify-s
-  (fn
-    (term rs)
-    (let
-      ((w (mk-walk term rs)))
-      (cond
-        ((is-var? w) (extend (var-name w) (reify-name (len rs)) rs))
-        ((mk-list-pair? w) (reduce (fn (acc a) (reify-s a acc)) rs w))
-        (:else rs)))))
-
-(define
-  reify
-  (fn
-    (term s)
-    (let
-      ((w (mk-walk* term s)))
-      (let ((rs (reify-s w (empty-subst)))) (mk-walk* w rs)))))
-
-(defmacro
-  run-n
-  (n q-name &rest goals)
-  (quasiquote
-    (let
-      (((unquote q-name) (make-var)))
-      (map
-        (fn (s) (reify (unquote q-name) s))
-        (stream-take
-          (unquote n)
-          ((mk-conj (splice-unquote goals)) empty-s))))))
-
-(defmacro
-  run*
-  (q-name &rest goals)
-  (quasiquote (run-n -1 (unquote q-name) (splice-unquote goals))))
-
-(defmacro
-  run
-  (n q-name &rest goals)
-  (quasiquote (run-n (unquote n) (unquote q-name) (splice-unquote goals))))
--- a/lib/minikanren/stream.sx
+++ b/lib/minikanren/stream.sx
@@ -1,66 +0,0 @@
-;; lib/minikanren/stream.sx — Phase 2 piece A: lazy streams of substitutions.
-;;
-;; SX has no improper pairs (cons requires a list cdr), so we use a
-;; tagged stream-cell shape for mature stream elements:
-;;
-;;   stream  ::= mzero                        empty (the SX empty list)
-;;             | (:s HEAD TAIL)               mature cell, TAIL is a stream
-;;             | thunk                        (fn () ...) → stream when forced
-;;
-;; HEAD is a substitution dict. TAIL is again a stream (possibly a thunk),
-;; which is what gives us laziness — mk-mplus can return a mature head with
-;; a thunk in the tail, deferring the rest of the search.
-
-(define mzero (list))
-
-(define s-cons (fn (h t) (list :s h t)))
-
-(define
-  s-cons?
-  (fn (s) (and (list? s) (not (empty? s)) (= (first s) :s))))
-
-(define s-car (fn (s) (nth s 1)))
-(define s-cdr (fn (s) (nth s 2)))
-
-(define unit (fn (s) (s-cons s mzero)))
-
-(define stream-pause? (fn (s) (and (not (list? s)) (callable? s))))
-
-;; mk-mplus — interleave two streams. If s1 is paused we suspend and
-;; swap (Reasoned Schemer "interleave"); otherwise mature-cons head with
-;; mk-mplus of the rest.
-(define
-  mk-mplus
-  (fn
-    (s1 s2)
-    (cond
-      ((empty? s1) s2)
-      ((stream-pause? s1) (fn () (mk-mplus s2 (s1))))
-      (:else (s-cons (s-car s1) (mk-mplus (s-cdr s1) s2))))))
-
-;; mk-bind — apply goal g to every substitution in stream s, mk-mplus-ing.
-(define
-  mk-bind
-  (fn
-    (s g)
-    (cond
-      ((empty? s) mzero)
-      ((stream-pause? s) (fn () (mk-bind (s) g)))
-      (:else (mk-mplus (g (s-car s)) (mk-bind (s-cdr s) g))))))
-
-;; stream-take — force up to n results out of a (possibly lazy) stream
-;; into a flat SX list of substitutions. n = -1 means take all.
-(define
-  stream-take
-  (fn
-    (n s)
-    (cond
-      ((= n 0) (list))
-      ((empty? s) (list))
-      ((stream-pause? s) (stream-take n (s)))
-      (:else
-        (cons
-          (s-car s)
-          (stream-take
-            (if (= n -1) -1 (- n 1))
-            (s-cdr s)))))))
--- a/lib/minikanren/tabling-slg.sx
+++ b/lib/minikanren/tabling-slg.sx
@@ -1,94 +0,0 @@
-;; lib/minikanren/tabling-slg.sx — Phase 7 piece A: SLG-style tabling.
-;;
-;; Naive memoization (table-1/2/3 in tabling.sx) drains the body's
-;; answer stream eagerly, then caches. Recursive tabled calls with the
-;; SAME ground key see an empty cache (the in-progress entry doesn't
-;; exist), so they recurse and the host overflows on cyclic relations.
-;;
-;; This module ships the in-progress-sentinel piece of SLG resolution:
-;; before evaluating the body, mark the cache entry as :in-progress;
-;; any recursive call to the same key sees the sentinel and returns
-;; mzero (no answers yet). Outer recursion thus terminates on cycles.
-;; Limitation: a single pass — answers found by cycle-dependent
-;; recursive calls are NOT discovered. Full SLG with fixed-point
-;; iteration (re-running until no new answers) is left for follow-up.
-
-(define
-  table-2-slg-iter
-  (fn
-    (rel-fn input output s key prev-vals)
-    (begin
-      (mk-tab-store! key prev-vals)
-      (let
-        ((all-substs (stream-take -1 ((rel-fn input output) s))))
-        (let
-          ((vals (map (fn (s2) (mk-walk* output s2)) all-substs)))
-          (cond
-            ((= (len vals) (len prev-vals))
-              (begin
-                (mk-tab-store! key vals)
-                (mk-tab-replay-vals vals output s)))
-            (:else (table-2-slg-iter rel-fn input output s key vals))))))))
-
-(define
-  table-2-slg
-  (fn
-    (name rel-fn)
-    (fn
-      (input output)
-      (fn
-        (s)
-        (let
-          ((winput (mk-walk* input s)))
-          (cond
-            ((mk-tab-ground-term? winput)
-              (let
-                ((key (str name "/slg/" winput)))
-                (let
-                  ((cached (mk-tab-lookup key)))
-                  (cond
-                    ((not (= cached :miss))
-                      (mk-tab-replay-vals cached output s))
-                    (:else
-                      (table-2-slg-iter rel-fn input output s key (list)))))))
-            (:else ((rel-fn input output) s))))))))
-
-(define
-  table-3-slg-iter
-  (fn
-    (rel-fn i1 i2 output s key prev-vals)
-    (begin
-      (mk-tab-store! key prev-vals)
-      (let
-        ((all-substs (stream-take -1 ((rel-fn i1 i2 output) s))))
-        (let
-          ((vals (map (fn (s2) (mk-walk* output s2)) all-substs)))
-          (cond
-            ((= (len vals) (len prev-vals))
-              (begin
-                (mk-tab-store! key vals)
-                (mk-tab-replay-vals vals output s)))
-            (:else (table-3-slg-iter rel-fn i1 i2 output s key vals))))))))
-
-(define
-  table-3-slg
-  (fn
-    (name rel-fn)
-    (fn
-      (i1 i2 output)
-      (fn
-        (s)
-        (let
-          ((wi1 (mk-walk* i1 s)) (wi2 (mk-walk* i2 s)))
-          (cond
-            ((and (mk-tab-ground-term? wi1) (mk-tab-ground-term? wi2))
-              (let
-                ((key (str name "/slg3/" wi1 "/" wi2)))
-                (let
-                  ((cached (mk-tab-lookup key)))
-                  (cond
-                    ((not (= cached :miss))
-                      (mk-tab-replay-vals cached output s))
-                    (:else
-                      (table-3-slg-iter rel-fn i1 i2 output s key (list)))))))
-            (:else ((rel-fn i1 i2 output) s))))))))
--- a/lib/minikanren/tabling.sx
+++ b/lib/minikanren/tabling.sx
@@ -1,157 +0,0 @@
-;; lib/minikanren/tabling.sx — Phase 7 piece A: naive memoization.
-;;
-;; A `table-2` wrapper for 2-arg relations (input, output). Caches by
-;; ground input (walked at call time). On hit, replays the cached output
-;; values; on miss, runs the relation, collects all output values from
-;; the answer stream, stores, then replays.
-;;
-;; Limitations of naive memoization (vs proper SLG / producer-consumer
-;; tabling):
-;;   - Each call must terminate before its result enters the cache —
-;;     so cyclic recursive calls with the SAME ground input would still
-;;     diverge (not addressed here).
-;;   - Caching by full ground walk only; partially-ground args fall
-;;     through to the underlying relation.
-;;
-;; Despite the limitations, naive memoization is enough for the
-;; canonical demo: Fibonacci goes from exponential to linear because
-;; each fib(k) result is computed at most once.
-;;
-;; Cache lifetime: a single global mk-tab-cache. Use `(mk-tab-clear!)`
-;; between independent queries.
-
-(define mk-tab-cache {})
-
-(define mk-tab-clear! (fn () (set! mk-tab-cache {})))
-
-(define
-  mk-tab-lookup
-  (fn
-    (key)
-    (cond
-      ((has-key? mk-tab-cache key) (get mk-tab-cache key))
-      (:else :miss))))
-
-(define
-  mk-tab-store!
-  (fn (key vals) (set! mk-tab-cache (assoc mk-tab-cache key vals))))
-
-(define
-  mk-tab-ground-term?
-  (fn
-    (t)
-    (cond
-      ((is-var? t) false)
-      ((mk-cons-cell? t)
-        (and
-          (mk-tab-ground-term? (mk-cons-head t))
-          (mk-tab-ground-term? (mk-cons-tail t))))
-      ((mk-list-pair? t) (every? mk-tab-ground-term? t))
-      (:else true))))
-
-(define
-  mk-tab-replay-vals
-  (fn
-    (vals output s)
-    (cond
-      ((empty? vals) mzero)
-      (:else
-        (let
-          ((sp (mk-unify output (first vals) s)))
-          (let
-            ((this-stream (cond ((= sp nil) mzero) (:else (unit sp)))))
-            (mk-mplus this-stream (mk-tab-replay-vals (rest vals) output s))))))))
-
-(define
-  table-2
-  (fn
-    (name rel-fn)
-    (fn
-      (input output)
-      (fn
-        (s)
-        (let
-          ((winput (mk-walk* input s)))
-          (cond
-            ((mk-tab-ground-term? winput)
-              (let
-                ((key (str name "@" winput)))
-                (let
-                  ((cached (mk-tab-lookup key)))
-                  (cond
-                    ((= cached :miss)
-                      (let
-                        ((all-substs (stream-take -1 ((rel-fn input output) s))))
-                        (let
-                          ((vals (map (fn (s2) (mk-walk* output s2)) all-substs)))
-                          (begin
-                            (mk-tab-store! key vals)
-                            (mk-tab-replay-vals vals output s)))))
-                    (:else (mk-tab-replay-vals cached output s))))))
-            (:else ((rel-fn input output) s))))))))
-
-;; --- table-1: 1-arg relation (one input, no output to cache) ---
-;; The relation is a predicate `(p input)` that succeeds or fails.
-;; Cache stores either :ok or :no.
-
-(define
-  table-1
-  (fn
-    (name rel-fn)
-    (fn
-      (input)
-      (fn
-        (s)
-        (let
-          ((winput (mk-walk* input s)))
-          (cond
-            ((mk-tab-ground-term? winput)
-              (let
-                ((key (str name "@1@" winput)))
-                (let
-                  ((cached (mk-tab-lookup key)))
-                  (cond
-                    ((= cached :miss)
-                      (let
-                        ((stream ((rel-fn input) s)))
-                        (let
-                          ((peek (stream-take 1 stream)))
-                          (cond
-                            ((empty? peek)
-                              (begin (mk-tab-store! key :no) mzero))
-                            (:else (begin (mk-tab-store! key :ok) stream))))))
-                    ((= cached :ok) (unit s))
-                    ((= cached :no) mzero)
-                    (:else mzero)))))
-            (:else ((rel-fn input) s))))))))
-
-;; --- table-3: 3-arg relation (input1 input2 output) ---
-;; Cache keyed by (input1, input2). Output values cached as a list.
-
-(define
-  table-3
-  (fn
-    (name rel-fn)
-    (fn
-      (i1 i2 output)
-      (fn
-        (s)
-        (let
-          ((wi1 (mk-walk* i1 s)) (wi2 (mk-walk* i2 s)))
-          (cond
-            ((and (mk-tab-ground-term? wi1) (mk-tab-ground-term? wi2))
-              (let
-                ((key (str name "@3@" wi1 "/" wi2)))
-                (let
-                  ((cached (mk-tab-lookup key)))
-                  (cond
-                    ((= cached :miss)
-                      (let
-                        ((all-substs (stream-take -1 ((rel-fn i1 i2 output) s))))
-                        (let
-                          ((vals (map (fn (s2) (mk-walk* output s2)) all-substs)))
-                          (begin
-                            (mk-tab-store! key vals)
-                            (mk-tab-replay-vals vals output s)))))
-                    (:else (mk-tab-replay-vals cached output s))))))
-            (:else ((rel-fn i1 i2 output) s))))))))
--- a/lib/minikanren/tests/appendo3.sx
+++ b/lib/minikanren/tests/appendo3.sx
@@ -1,49 +0,0 @@
-;; lib/minikanren/tests/appendo3.sx — 3-list append.
-
-(mk-test
-  "appendo3-forward"
-  (run*
-    q
-    (appendo3
-      (list 1 2)
-      (list 3 4)
-      (list 5 6)
-      q))
-  (list
-    (list 1 2 3 4 5 6)))
-
-(mk-test
-  "appendo3-empty-everything"
-  (run* q (appendo3 (list) (list) (list) q))
-  (list (list)))
-
-(mk-test
-  "appendo3-recover-middle"
-  (run*
-    q
-    (appendo3
-      (list 1 2)
-      q
-      (list 5 6)
-      (list 1 2 3 4 5 6)))
-  (list (list 3 4)))
-
-(mk-test
-  "appendo3-empty-middle"
-  (run*
-    q
-    (appendo3
-      (list 1 2)
-      (list)
-      (list 3 4)
-      q))
-  (list (list 1 2 3 4)))
-
-(mk-test
-  "appendo3-empty-first-and-last"
-  (run*
-    q
-    (appendo3 (list) (list 1 2 3) (list) q))
-  (list (list 1 2 3)))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/arith-prog.sx
+++ b/lib/minikanren/tests/arith-prog.sx
@@ -1,33 +0,0 @@
-;; lib/minikanren/tests/arith-prog.sx — arithmetic progression generation.
-
-(mk-test
-  "arith-progo-zero-len"
-  (run* q (arith-progo 5 1 0 q))
-  (list (list)))
-
-(mk-test
-  "arith-progo-1-to-5"
-  (run* q (arith-progo 1 1 5 q))
-  (list (list 1 2 3 4 5)))
-
-(mk-test
-  "arith-progo-evens-from-0"
-  (run* q (arith-progo 0 2 5 q))
-  (list (list 0 2 4 6 8)))
-
-(mk-test
-  "arith-progo-descending"
-  (run* q (arith-progo 10 -1 4 q))
-  (list (list 10 9 8 7)))
-
-(mk-test
-  "arith-progo-zero-step"
-  (run* q (arith-progo 7 0 3 q))
-  (list (list 7 7 7)))
-
-(mk-test
-  "arith-progo-negative-start"
-  (run* q (arith-progo -3 2 4 q))
-  (list (list -3 -1 1 3)))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/btree-walko.sx
+++ b/lib/minikanren/tests/btree-walko.sx
@@ -1,54 +0,0 @@
-;; lib/minikanren/tests/btree-walko.sx — walk a leaves-of-binary-tree relation
-;; using matche dispatch on (:leaf v) and (:node left right) patterns.
-
-(define
-  btree-walko
-  (fn
-    (tree v)
-    (matche
-      tree
-      ((:leaf x) (== v x))
-      ((:node l r) (conde ((btree-walko l v)) ((btree-walko r v)))))))
-
-;; A small test tree: ((1 2) (3 (4 5))).
-(define
-  test-btree
-  (list
-    :node (list :node (list :leaf 1) (list :leaf 2))
-    (list
-      :node (list :leaf 3)
-      (list :node (list :leaf 4) (list :leaf 5)))))
-
-(mk-test
-  "btree-walko-enumerates-all-leaves"
-  (let
-    ((leaves (run* q (btree-walko test-btree q))))
-    (and
-      (= (len leaves) 5)
-      (and
-        (some (fn (l) (= l 1)) leaves)
-        (and
-          (some (fn (l) (= l 2)) leaves)
-          (and
-            (some (fn (l) (= l 3)) leaves)
-            (and
-              (some (fn (l) (= l 4)) leaves)
-              (some (fn (l) (= l 5)) leaves)))))))
-  true)
-
-(mk-test
-  "btree-walko-find-3-membership"
-  (run 1 q (btree-walko test-btree 3))
-  (list (make-symbol "_.0")))
-
-(mk-test
-  "btree-walko-find-99-not-present"
-  (run* q (btree-walko test-btree 99))
-  (list))
-
-(mk-test
-  "btree-walko-leaf-only"
-  (run* q (btree-walko (list :leaf 42) q))
-  (list 42))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/classics.sx
+++ b/lib/minikanren/tests/classics.sx
@@ -1,87 +0,0 @@
-;; lib/minikanren/tests/classics.sx — small classic-style puzzles that
-;; exercise the full system end to end (relations + conde + matche +
-;; fresh + run*). Each test is a self-contained miniKanren program.
-
-;; -----------------------------------------------------------------------
-;; Pet puzzle (3 friends, 3 pets, 1-each).
-;; -----------------------------------------------------------------------
-
-(mk-test
-  "classics-pet-puzzle"
-  (run*
-    q
-    (fresh
-      (a b c)
-      (== q (list a b c))
-      (permuteo (list :dog :cat :fish) (list a b c))
-      (== b :fish)
-      (conde ((== a :cat)) ((== a :fish)))))
-  (list (list :cat :fish :dog)))
-
-;; -----------------------------------------------------------------------
-;; Family-relations puzzle (uses membero on a fact list).
-;; -----------------------------------------------------------------------
-
-(define
-  parent-facts
-  (list
-    (list "alice" "bob")
-    (list "alice" "carol")
-    (list "bob" "dave")
-    (list "carol" "eve")
-    (list "dave" "frank")))
-
-(define parento (fn (x y) (membero (list x y) parent-facts)))
-
-(define grandparento (fn (x z) (fresh (y) (parento x y) (parento y z))))
-
-(mk-test
-  "classics-grandparents-of-frank"
-  (run* q (grandparento q "frank"))
-  (list "bob"))
-
-(mk-test
-  "classics-grandchildren-of-alice"
-  (run* q (grandparento "alice" q))
-  (list "dave" "eve"))
-
-;; -----------------------------------------------------------------------
-;; Symbolic differentiation, matche-driven.
-;;   Variable :x:                d/dx x  = 1
-;;   Sum (:+ a b):                d/dx (a+b) = (da + db)
-;;   Product (:* a b):            d/dx (a*b) = (da*b + a*db)
-;; -----------------------------------------------------------------------
-
-(define
-  diffo
-  (fn
-    (expr var d)
-    (matche
-      expr
-      (:x (== d 1))
-      ((:+ a b)
-        (fresh
-          (da db)
-          (== d (list :+ da db))
-          (diffo a var da)
-          (diffo b var db)))
-      ((:* a b)
-        (fresh
-          (da db)
-          (== d (list :+ (list :* da b) (list :* a db)))
-          (diffo a var da)
-          (diffo b var db))))))
-
-(mk-test "classics-diff-of-x" (run* q (diffo :x :x q)) (list 1))
-
-(mk-test
-  "classics-diff-of-x-plus-x"
-  (run* q (diffo (list :+ :x :x) :x q))
-  (list (list :+ 1 1)))
-
-(mk-test
-  "classics-diff-of-x-times-x"
-  (run* q (diffo (list :* :x :x) :x q))
-  (list (list :+ (list :* 1 :x) (list :* :x 1))))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-bounds.sx
+++ b/lib/minikanren/tests/clpfd-bounds.sx
@@ -1,316 +0,0 @@
-;; lib/minikanren/tests/clpfd-bounds.sx — Phase 6 piece B: bounds-consistency
-;; for fd-plus and fd-times in the partial- and all-domain cases.
-;;
-;; We probe domains directly (peek at the FD store) before any labelling
-;; happens. This isolates the propagator's narrowing behaviour from the
-;; search engine.
-
-(define
-  probe-dom
-  (fn
-    (goal var-key)
-    (let
-      ((s (first (stream-take 1 (goal empty-s)))))
-      (cond ((= s nil) :no-subst) (:else (fd-domain-of s var-key))))))
-
-;; --- fd-plus partial-domain narrowing ---
-
-(mk-test
-  "fd-plus-vvn-narrows-x"
-  (let
-    ((x (mk-var "x")) (y (mk-var "y")))
-    (probe-dom
-      (mk-conj
-        (fd-in
-          x
-          (list
-            1
-            2
-            3
-            4
-            5
-            6
-            7
-            8
-            9
-            10))
-        (fd-in y (list 1 2 3))
-        (fd-plus x y 10))
-      "x"))
-  (list 7 8 9))
-
-(mk-test
-  "fd-plus-vvn-narrows-y"
-  (let
-    ((x (mk-var "x")) (y (mk-var "y")))
-    (probe-dom
-      (mk-conj
-        (fd-in
-          x
-          (list
-            1
-            2
-            3
-            4
-            5
-            6
-            7
-            8
-            9
-            10))
-        (fd-in y (list 1 2 3))
-        (fd-plus x y 10))
-      "y"))
-  (list 1 2 3))
-
-(mk-test
-  "fd-plus-nvv-narrows"
-  (let
-    ((y (mk-var "y")) (z (mk-var "z")))
-    (probe-dom
-      (mk-conj
-        (fd-in y (list 1 2 3))
-        (fd-in
-          z
-          (list
-            1
-            2
-            3
-            4
-            5
-            6
-            7
-            8
-            9
-            10
-            11
-            12
-            13
-            14
-            15
-            16
-            17
-            18
-            19
-            20))
-        (fd-plus 5 y z))
-      "z"))
-  (list 6 7 8))
-
-(mk-test
-  "fd-plus-vvv-narrows-z"
-  (let
-    ((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z")))
-    (probe-dom
-      (mk-conj
-        (fd-in x (list 1 2 3))
-        (fd-in y (list 1 2 3))
-        (fd-in
-          z
-          (list
-            1
-            2
-            3
-            4
-            5
-            6
-            7
-            8
-            9
-            10
-            11
-            12
-            13
-            14
-            15
-            16
-            17
-            18
-            19
-            20))
-        (fd-plus x y z))
-      "z"))
-  (list 2 3 4 5 6))
-
-(mk-test
-  "fd-plus-vvv-narrows-x"
-  (let
-    ((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z")))
-    (probe-dom
-      (mk-conj
-        (fd-in
-          x
-          (list
-            1
-            2
-            3
-            4
-            5
-            6
-            7
-            8
-            9
-            10))
-        (fd-in y (list 1 2 3))
-        (fd-in z (list 5 6 7))
-        (fd-plus x y z))
-      "x"))
-  (list 2 3 4 5 6))
-
-;; --- fd-times partial-domain narrowing (positive domains) ---
-
-(mk-test
-  "fd-times-vvn-narrows"
-  (let
-    ((x (mk-var "x")) (y (mk-var "y")))
-    (probe-dom
-      (mk-conj
-        (fd-in
-          x
-          (list
-            1
-            2
-            3
-            4
-            5
-            6))
-        (fd-in
-          y
-          (list
-            1
-            2
-            3
-            4
-            5
-            6))
-        (fd-times x y 12))
-      "x"))
-  (list 2 3 4 5 6))
-
-(mk-test
-  "fd-times-nvv-narrows"
-  (let
-    ((y (mk-var "y")) (z (mk-var "z")))
-    (probe-dom
-      (mk-conj
-        (fd-in y (list 1 2 3 4))
-        (fd-in
-          z
-          (list
-            1
-            2
-            3
-            4
-            5
-            6
-            7
-            8
-            9
-            10
-            11
-            12
-            13
-            14
-            15
-            16
-            17
-            18
-            19
-            20))
-        (fd-times 3 y z))
-      "z"))
-  (list
-    3
-    4
-    5
-    6
-    7
-    8
-    9
-    10
-    11
-    12))
-
-(mk-test
-  "fd-times-vvv-narrows"
-  (let
-    ((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z")))
-    (probe-dom
-      (mk-conj
-        (fd-in x (list 1 2 3))
-        (fd-in y (list 1 2 3))
-        (fd-in
-          z
-          (list
-            1
-            2
-            3
-            4
-            5
-            6
-            7
-            8
-            9
-            10
-            11
-            12
-            13
-            14
-            15
-            16
-            17
-            18
-            19
-            20))
-        (fd-times x y z))
-      "z"))
-  (list
-    1
-    2
-    3
-    4
-    5
-    6
-    7
-    8
-    9))
-
-;; --- bounds force impossible branches to fail early ---
-
-(mk-test
-  "fd-plus-impossible-via-bounds"
-  (let
-    ((x (mk-var "x")) (y (mk-var "y")))
-    (probe-dom
-      (mk-conj
-        (fd-in
-          x
-          (list
-            1
-            2
-            3
-            4
-            5
-            6
-            7
-            8
-            9
-            10))
-        (fd-in
-          y
-          (list
-            1
-            2
-            3
-            4
-            5
-            6
-            7
-            8
-            9
-            10))
-        (fd-plus x y 100))
-      "x"))
-  :no-subst)
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-distinct.sx
+++ b/lib/minikanren/tests/clpfd-distinct.sx
@@ -1,52 +0,0 @@
-;; lib/minikanren/tests/clpfd-distinct.sx — fd-distinct (alldifferent).
-
-(mk-test
-  "fd-distinct-empty"
-  (run* q (fd-distinct (list)))
-  (list (make-symbol "_.0")))
-
-(mk-test
-  "fd-distinct-singleton"
-  (run* q (fd-distinct (list 5)))
-  (list (make-symbol "_.0")))
-
-(mk-test
-  "fd-distinct-pair-distinct"
-  (run* q (fd-distinct (list 1 2)))
-  (list (make-symbol "_.0")))
-
-(mk-test
-  "fd-distinct-pair-equal-fails"
-  (run* q (fd-distinct (list 5 5)))
-  (list))
-
-(mk-test
-  "fd-distinct-3-perms-of-3"
-  (let
-    ((res (run* q (fresh (a b c) (fd-in a (list 1 2 3)) (fd-in b (list 1 2 3)) (fd-in c (list 1 2 3)) (fd-distinct (list a b c)) (fd-label (list a b c)) (== q (list a b c))))))
-    (= (len res) 6))
-  true)
-
-(mk-test
-  "fd-distinct-4-perms-of-4-count"
-  (let
-    ((res (run* q (fresh (a b c d) (fd-in a (list 1 2 3 4)) (fd-in b (list 1 2 3 4)) (fd-in c (list 1 2 3 4)) (fd-in d (list 1 2 3 4)) (fd-distinct (list a b c d)) (fd-label (list a b c d)) (== q (list a b c d))))))
-    (= (len res) 24))
-  true)
-
-(mk-test
-  "fd-distinct-pigeonhole-fails"
-  (run*
-    q
-    (fresh
-      (a b c d)
-      (fd-in a (list 1 2 3))
-      (fd-in b (list 1 2 3))
-      (fd-in c (list 1 2 3))
-      (fd-in d (list 1 2 3))
-      (fd-distinct (list a b c d))
-      (fd-label (list a b c d))
-      (== q (list a b c d))))
-  (list))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-domains.sx
+++ b/lib/minikanren/tests/clpfd-domains.sx
@@ -1,133 +0,0 @@
-;; lib/minikanren/tests/clpfd-domains.sx — Phase 6 piece B: domain primitives.
-
-;; --- domain construction ---
-
-(mk-test
-  "fd-dom-from-list-sorts"
-  (fd-dom-from-list
-    (list 3 1 2 1 5))
-  (list 1 2 3 5))
-
-(mk-test "fd-dom-from-list-empty" (fd-dom-from-list (list)) (list))
-
-(mk-test
-  "fd-dom-from-list-single"
-  (fd-dom-from-list (list 7))
-  (list 7))
-
-(mk-test
-  "fd-dom-range-1-5"
-  (fd-dom-range 1 5)
-  (list 1 2 3 4 5))
-
-(mk-test "fd-dom-range-empty" (fd-dom-range 5 1) (list))
-
-;; --- predicates ---
-
-(mk-test "fd-dom-empty-yes" (fd-dom-empty? (list)) true)
-(mk-test "fd-dom-empty-no" (fd-dom-empty? (list 1)) false)
-(mk-test "fd-dom-singleton-yes" (fd-dom-singleton? (list 5)) true)
-(mk-test
-  "fd-dom-singleton-multi"
-  (fd-dom-singleton? (list 1 2))
-  false)
-(mk-test "fd-dom-singleton-empty" (fd-dom-singleton? (list)) false)
-
-(mk-test
-  "fd-dom-min"
-  (fd-dom-min (list 3 7 9))
-  3)
-(mk-test
-  "fd-dom-max"
-  (fd-dom-max (list 3 7 9))
-  9)
-
-(mk-test
-  "fd-dom-member-yes"
-  (fd-dom-member?
-    3
-    (list 1 2 3 4))
-  true)
-(mk-test
-  "fd-dom-member-no"
-  (fd-dom-member?
-    9
-    (list 1 2 3 4))
-  false)
-
-;; --- intersect / without ---
-
-(mk-test
-  "fd-dom-intersect"
-  (fd-dom-intersect
-    (list 1 2 3 4 5)
-    (list 2 4 6))
-  (list 2 4))
-
-(mk-test
-  "fd-dom-intersect-disjoint"
-  (fd-dom-intersect
-    (list 1 2 3)
-    (list 4 5 6))
-  (list))
-
-(mk-test
-  "fd-dom-intersect-empty"
-  (fd-dom-intersect (list) (list 1 2 3))
-  (list))
-
-(mk-test
-  "fd-dom-intersect-equal"
-  (fd-dom-intersect
-    (list 1 2 3)
-    (list 1 2 3))
-  (list 1 2 3))
-
-(mk-test
-  "fd-dom-without-mid"
-  (fd-dom-without
-    3
-    (list 1 2 3 4 5))
-  (list 1 2 4 5))
-
-(mk-test
-  "fd-dom-without-missing"
-  (fd-dom-without 9 (list 1 2 3))
-  (list 1 2 3))
-
-(mk-test
-  "fd-dom-without-min"
-  (fd-dom-without 1 (list 1 2 3))
-  (list 2 3))
-
-;; --- store accessors ---
-
-(mk-test "fd-domain-of-unset" (fd-domain-of {} "x") nil)
-
-(mk-test
-  "fd-domain-of-set"
-  (let
-    ((s (fd-set-domain {} "x" (list 1 2 3))))
-    (fd-domain-of s "x"))
-  (list 1 2 3))
-
-(mk-test
-  "fd-set-domain-empty-fails"
-  (fd-set-domain {} "x" (list))
-  nil)
-
-(mk-test
-  "fd-set-domain-overrides"
-  (let
-    ((s (fd-set-domain {} "x" (list 1 2 3))))
-    (fd-domain-of (fd-set-domain s "x" (list 5)) "x"))
-  (list 5))
-
-(mk-test
-  "fd-set-domain-multiple-vars"
-  (let
-    ((s (fd-set-domain (fd-set-domain {} "x" (list 1)) "y" (list 2 3))))
-    (list (fd-domain-of s "x") (fd-domain-of s "y")))
-  (list (list 1) (list 2 3)))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-in-label.sx
+++ b/lib/minikanren/tests/clpfd-in-label.sx
@@ -1,120 +0,0 @@
-;; lib/minikanren/tests/clpfd-in-label.sx — fd-in (domain narrowing) + fd-label.
-
-;; --- fd-in: domain narrowing ---
-
-(mk-test
-  "fd-in-bare-label"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 1 2 3 4 5))
-      (fd-label (list x))
-      (== q x)))
-  (list 1 2 3 4 5))
-
-(mk-test
-  "fd-in-intersection"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 1 2 3 4 5))
-      (fd-in x (list 3 4 5 6 7))
-      (fd-label (list x))
-      (== q x)))
-  (list 3 4 5))
-
-(mk-test
-  "fd-in-disjoint-empty"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 1 2 3))
-      (fd-in x (list 7 8 9))
-      (fd-label (list x))
-      (== q x)))
-  (list))
-
-(mk-test
-  "fd-in-singleton-domain"
-  (run*
-    q
-    (fresh (x) (fd-in x (list 5)) (fd-label (list x)) (== q x)))
-  (list 5))
-
-;; --- ground value checks the domain ---
-
-(mk-test
-  "fd-in-ground-in-domain"
-  (run*
-    q
-    (fresh
-      (x)
-      (== x 3)
-      (fd-in x (list 1 2 3 4 5))
-      (== q x)))
-  (list 3))
-
-(mk-test
-  "fd-in-ground-not-in-domain"
-  (run*
-    q
-    (fresh
-      (x)
-      (== x 9)
-      (fd-in x (list 1 2 3 4 5))
-      (== q x)))
-  (list))
-
-;; --- fd-label across multiple vars ---
-
-(mk-test
-  "fd-label-multiple-vars"
-  (let
-    ((res (run* q (fresh (a b) (fd-in a (list 1 2 3)) (fd-in b (list 10 20)) (fd-label (list a b)) (== q (list a b))))))
-    (= (len res) 6))
-  true)
-
-(mk-test
-  "fd-label-empty-vars"
-  (run* q (fd-label (list)))
-  (list (make-symbol "_.0")))
-
-;; --- composition with regular goals ---
-
-(mk-test
-  "fd-in-with-membero-style-filtering"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in
-        x
-        (list
-          1
-          2
-          3
-          4
-          5
-          6
-          7
-          8
-          9
-          10))
-      (fd-label (list x))
-      (== q x)))
-  (list
-    1
-    2
-    3
-    4
-    5
-    6
-    7
-    8
-    9
-    10))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-neq.sx
+++ b/lib/minikanren/tests/clpfd-neq.sx
@@ -1,82 +0,0 @@
-;; lib/minikanren/tests/clpfd-neq.sx — fd-neq with constraint propagation.
-
-;; --- ground / domain interaction ---
-
-(mk-test
-  "fd-neq-ground-distinct"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-neq x 5)
-      (fd-in x (list 4 5 6))
-      (fd-label (list x))
-      (== q x)))
-  (list 4 6))
-
-(mk-test
-  "fd-neq-ground-equal-fails"
-  (run* q (fresh (x) (== x 5) (fd-neq x 5) (== q x)))
-  (list))
-
-(mk-test
-  "fd-neq-symmetric"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-neq 7 x)
-      (fd-in x (list 5 6 7 8 9))
-      (fd-label (list x))
-      (== q x)))
-  (list 5 6 8 9))
-
-;; --- two vars with overlapping domains ---
-
-(mk-test
-  "fd-neq-pair-from-3"
-  (let
-    ((res (run* q (fresh (x y) (fd-in x (list 1 2 3)) (fd-in y (list 1 2 3)) (fd-neq x y) (fd-label (list x y)) (== q (list x y))))))
-    (= (len res) 6))
-  true)
-
-(mk-test
-  "fd-all-distinct-3-of-3"
-  (let
-    ((res (run* q (fresh (a b c) (fd-in a (list 1 2 3)) (fd-in b (list 1 2 3)) (fd-in c (list 1 2 3)) (fd-neq a b) (fd-neq a c) (fd-neq b c) (fd-label (list a b c)) (== q (list a b c))))))
-    (= (len res) 6))
-  true)
-
-(mk-test
-  "fd-pigeonhole-fails"
-  (run*
-    q
-    (fresh
-      (a b c)
-      (fd-in a (list 1 2))
-      (fd-in b (list 1 2))
-      (fd-in c (list 1 2))
-      (fd-neq a b)
-      (fd-neq a c)
-      (fd-neq b c)
-      (fd-label (list a b c))
-      (== q (list a b c))))
-  (list))
-
-;; --- propagation when one side becomes ground ---
-
-(mk-test
-  "fd-neq-propagates-after-ground"
-  (run*
-    q
-    (fresh
-      (x y)
-      (fd-in x (list 1 2 3))
-      (fd-in y (list 1 2 3))
-      (fd-neq x y)
-      (== x 2)
-      (fd-label (list y))
-      (== q y)))
-  (list 1 3))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-ord.sx
+++ b/lib/minikanren/tests/clpfd-ord.sx
@@ -1,128 +0,0 @@
-;; lib/minikanren/tests/clpfd-ord.sx — fd-lt / fd-lte / fd-eq.
-
-;; --- fd-lt ---
-
-(mk-test
-  "fd-lt-narrows-x-against-num"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 1 2 3 4 5))
-      (fd-lt x 3)
-      (fd-label (list x))
-      (== q x)))
-  (list 1 2))
-
-(mk-test
-  "fd-lt-narrows-x-against-num-symmetric"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 1 2 3 4 5))
-      (fd-lt 3 x)
-      (fd-label (list x))
-      (== q x)))
-  (list 4 5))
-
-(mk-test
-  "fd-lt-pair-ordered"
-  (let
-    ((res (run* q (fresh (x y) (fd-in x (list 1 2 3 4)) (fd-in y (list 1 2 3 4)) (fd-lt x y) (fd-label (list x y)) (== q (list x y))))))
-    (= (len res) 6))
-  true)
-
-(mk-test
-  "fd-lt-impossible-fails"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 5 6 7))
-      (fd-lt x 3)
-      (fd-label (list x))
-      (== q x)))
-  (list))
-
-;; --- fd-lte ---
-
-(mk-test
-  "fd-lte-includes-equal"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 1 2 3 4 5))
-      (fd-lte x 3)
-      (fd-label (list x))
-      (== q x)))
-  (list 1 2 3))
-
-(mk-test
-  "fd-lte-equal-bound"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 1 2 3 4 5))
-      (fd-lte 3 x)
-      (fd-label (list x))
-      (== q x)))
-  (list 3 4 5))
-
-;; --- fd-eq ---
-
-(mk-test
-  "fd-eq-bind"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 1 2 3 4 5))
-      (fd-eq x 3)
-      (== q x)))
-  (list 3))
-
-(mk-test
-  "fd-eq-out-of-domain-fails"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 1 2 3))
-      (fd-eq x 5)
-      (== q x)))
-  (list))
-
-(mk-test
-  "fd-eq-two-vars-share-domain"
-  (run*
-    q
-    (fresh
-      (x y)
-      (fd-in x (list 1 2 3))
-      (fd-in y (list 2 3 4))
-      (fd-eq x y)
-      (fd-label (list x y))
-      (== q (list x y))))
-  (list (list 2 2) (list 3 3)))
-
-;; --- combine fd-lt + fd-neq for "between" puzzle ---
-
-(mk-test
-  "fd-lt-neq-combined"
-  (run*
-    q
-    (fresh
-      (x y z)
-      (fd-in x (list 1 2 3))
-      (fd-in y (list 1 2 3))
-      (fd-in z (list 1 2 3))
-      (fd-lt x y)
-      (fd-lt y z)
-      (fd-label (list x y z))
-      (== q (list x y z))))
-  (list (list 1 2 3)))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-plus.sx
+++ b/lib/minikanren/tests/clpfd-plus.sx
@@ -1,62 +0,0 @@
-;; lib/minikanren/tests/clpfd-plus.sx — fd-plus (x + y = z).
-
-(mk-test
-  "fd-plus-all-ground"
-  (run* q (fresh (z) (fd-plus 2 3 z) (== q z)))
-  (list 5))
-
-(mk-test
-  "fd-plus-recover-x"
-  (run* q (fresh (x) (fd-plus x 3 5) (== q x)))
-  (list 2))
-
-(mk-test
-  "fd-plus-recover-y"
-  (run* q (fresh (y) (fd-plus 2 y 5) (== q y)))
-  (list 3))
-
-(mk-test
-  "fd-plus-impossible-fails"
-  (run*
-    q
-    (fresh
-      (z)
-      (fd-plus 2 3 z)
-      (== z 99)
-      (== q z)))
-  (list))
-
-(mk-test
-  "fd-plus-domain-check"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 3 4 5))
-      (fd-plus x 3 5)
-      (== q x)))
-  (list))
-
-(mk-test
-  "fd-plus-pairs-summing-to-5"
-  (run*
-    q
-    (fresh
-      (x y)
-      (fd-in x (list 1 2 3 4))
-      (fd-in y (list 1 2 3 4))
-      (fd-plus x y 5)
-      (fd-label (list x y))
-      (== q (list x y))))
-  (list
-    (list 1 4)
-    (list 2 3)
-    (list 3 2)
-    (list 4 1)))
-
-(mk-test
-  "fd-plus-z-derived"
-  (run* q (fresh (z) (fd-plus 7 8 z) (== q z)))
-  (list 15))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-times.sx
+++ b/lib/minikanren/tests/clpfd-times.sx
@@ -1,85 +0,0 @@
-;; lib/minikanren/tests/clpfd-times.sx — fd-times (x * y = z).
-
-(mk-test
-  "fd-times-3-4"
-  (run* q (fresh (z) (fd-times 3 4 z) (== q z)))
-  (list 12))
-
-(mk-test
-  "fd-times-recover-divisor"
-  (run* q (fresh (x) (fd-times x 5 30) (== q x)))
-  (list 6))
-
-(mk-test
-  "fd-times-non-divisible-fails"
-  (run* q (fresh (x) (fd-times x 5 31) (== q x)))
-  (list))
-
-(mk-test
-  "fd-times-by-zero"
-  (run* q (fresh (z) (fd-times 0 99 z) (== q z)))
-  (list 0))
-
-(mk-test
-  "fd-times-zero-by-anything-zero"
-  (run*
-    q
-    (fresh
-      (x)
-      (fd-in x (list 1 2 3))
-      (fd-times x 0 0)
-      (fd-label (list x))
-      (== q x)))
-  (list 1 2 3))
-
-(mk-test
-  "fd-times-12-divisor-pairs"
-  (run*
-    q
-    (fresh
-      (x y)
-      (fd-in
-        x
-        (list
-          1
-          2
-          3
-          4
-          5
-          6))
-      (fd-in
-        y
-        (list
-          1
-          2
-          3
-          4
-          5
-          6))
-      (fd-times x y 12)
-      (fd-label (list x y))
-      (== q (list x y))))
-  (list
-    (list 2 6)
-    (list 3 4)
-    (list 4 3)
-    (list 6 2)))
-
-(mk-test
-  "fd-times-square-of-each"
-  (run*
-    q
-    (fresh
-      (x z)
-      (fd-in x (list 1 2 3 4 5))
-      (fd-times x x z)
-      (fd-label (list x))
-      (== q (list x z))))
-  (list
-    (list 1 1)
-    (list 2 4)
-    (list 3 9)
-    (list 4 16)
-    (list 5 25)))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/conda.sx
+++ b/lib/minikanren/tests/conda.sx
@@ -1,75 +0,0 @@
-;; lib/minikanren/tests/conda.sx — Phase 5 piece A tests for `conda`.
-
-;; --- conda commits to first non-failing head, keeps ALL its answers ---
-
-(mk-test
-  "conda-first-clause-keeps-all"
-  (run*
-    q
-    (conda
-      ((mk-disj (== q 1) (== q 2)))
-      ((== q 100))))
-  (list 1 2))
-
-(mk-test
-  "conda-skips-failing-head"
-  (run*
-    q
-    (conda
-      ((== 1 2))
-      ((mk-disj (== q 10) (== q 20)))))
-  (list 10 20))
-
-(mk-test
-  "conda-all-fail"
-  (run*
-    q
-    (conda ((== 1 2)) ((== 3 4))))
-  (list))
-
-(mk-test "conda-no-clauses" (run* q (conda)) (list))
-
-;; --- conda DIFFERS from condu: conda keeps all head answers ---
-
-(mk-test
-  "conda-vs-condu-divergence"
-  (list
-    (run*
-      q
-      (conda
-        ((mk-disj (== q 1) (== q 2)))
-        ((== q 100))))
-    (run*
-      q
-      (condu
-        ((mk-disj (== q 1) (== q 2)))
-        ((== q 100)))))
-  (list (list 1 2) (list 1)))
-
-;; --- conda head's rest-goals run on every head answer ---
-
-(mk-test
-  "conda-rest-goals-run-on-all-answers"
-  (run*
-    q
-    (fresh
-      (x r)
-      (conda
-        ((mk-disj (== x 1) (== x 2))
-          (== r (list :tag x))))
-      (== q r)))
-  (list (list :tag 1) (list :tag 2)))
-
-;; --- if rest-goals fail on a head answer, that head answer is filtered;
-;;     the clause does not fall through to next clauses (per soft-cut). ---
-
-(mk-test
-  "conda-rest-fails-no-fallthrough"
-  (run*
-    q
-    (conda
-      ((mk-disj (== q 1) (== q 2)) (== q 99))
-      ((== q 200))))
-  (list))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/conde.sx
+++ b/lib/minikanren/tests/conde.sx
@@ -1,89 +0,0 @@
-;; lib/minikanren/tests/conde.sx — Phase 2 piece C tests for `conde`.
-;;
-;; 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"))) (run* q (conde ((== q 7)))))
-  (list 7))
-
-(mk-test
-  "conde-one-clause-multi-goals"
-  (let
-    ((q (mk-var "q")))
-    (run* q (conde ((fresh (x) (== x 5) (== q (list x x)))))))
-  (list (list 5 5)))
-
-;; --- multi-clause: produces one row per clause (interleaved) ---
-
-(mk-test
-  "conde-three-clauses-as-set"
-  (let
-    ((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-as-set"
-  (let
-    ((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-as-set"
-  (let
-    ((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-yields-three"
-  (let
-    ((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"
-  (run*
-    q
-    (conde ((== 1 2)) ((== 3 4))))
-  (list))
-
-;; --- empty conde: no clauses ⇒ fail ---
-
-(mk-test "conde-no-clauses" (run* q (conde)) (list))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/condu.sx
+++ b/lib/minikanren/tests/condu.sx
@@ -1,86 +0,0 @@
-;; lib/minikanren/tests/condu.sx — Phase 2 piece D tests for `onceo` and `condu`.
-
-;; --- onceo: at most one answer ---
-
-(mk-test
-  "onceo-single-success-passes-through"
-  (let
-    ((q (mk-var "q")))
-    (let
-      ((res (stream-take 5 ((onceo (== q 7)) empty-s))))
-      (map (fn (s) (mk-walk q s)) res)))
-  (list 7))
-
-(mk-test
-  "onceo-multi-success-trimmed-to-one"
-  (let
-    ((q (mk-var "q")))
-    (let
-      ((res (stream-take 5 ((onceo (mk-disj (== q 1) (== q 2) (== q 3))) empty-s))))
-      (map (fn (s) (mk-walk q s)) res)))
-  (list 1))
-
-(mk-test
-  "onceo-failure-stays-failure"
-  ((onceo (== 1 2)) empty-s)
-  (list))
-
-(mk-test
-  "onceo-conde-trimmed"
-  (let
-    ((q (mk-var "q")))
-    (let
-      ((res (stream-take 5 ((onceo (conde ((== q "a")) ((== q "b")))) empty-s))))
-      (map (fn (s) (mk-walk q s)) res)))
-  (list "a"))
-
-;; --- condu: first clause with successful head wins ---
-
-(mk-test
-  "condu-first-clause-wins"
-  (let
-    ((q (mk-var "q")))
-    (let
-      ((res (stream-take 10 ((condu ((== q 1)) ((== q 2))) empty-s))))
-      (map (fn (s) (mk-walk q s)) res)))
-  (list 1))
-
-(mk-test
-  "condu-skips-failing-head"
-  (let
-    ((q (mk-var "q")))
-    (let
-      ((res (stream-take 10 ((condu ((== 1 2)) ((== q 100)) ((== q 200))) empty-s))))
-      (map (fn (s) (mk-walk q s)) res)))
-  (list 100))
-
-(mk-test
-  "condu-all-fail-empty"
-  ((condu ((== 1 2)) ((== 3 4)))
-    empty-s)
-  (list))
-
-(mk-test "condu-empty-clauses-fail" ((condu) empty-s) (list))
-
-;; --- condu commits head's first answer; rest-goals can still backtrack
-;;     within that committed substitution but cannot revisit other heads. ---
-
-(mk-test
-  "condu-head-onceo-rest-runs"
-  (let
-    ((q (mk-var "q")) (r (mk-var "r")))
-    (let
-      ((res (stream-take 10 ((condu ((mk-disj (== q 1) (== q 2)) (== r 99))) empty-s))))
-      (map (fn (s) (list (mk-walk q s) (mk-walk r s))) res)))
-  (list (list 1 99)))
-
-(mk-test
-  "condu-rest-goals-can-fail-the-clause"
-  (let
-    ((q (mk-var "q")))
-    (let
-      ((res (stream-take 10 ((condu ((== q 1) (== 2 3)) ((== q 99))) empty-s))))
-      (map (fn (s) (mk-walk q s)) res)))
-  (list))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/counto.sx
+++ b/lib/minikanren/tests/counto.sx
@@ -1,35 +0,0 @@
-;; lib/minikanren/tests/counto.sx — count occurrences of x in l (intarith).
-
-(mk-test
-  "counto-empty"
-  (run* q (counto 1 (list) q))
-  (list 0))
-(mk-test
-  "counto-not-found"
-  (run* q (counto 99 (list 1 2 3) q))
-  (list 0))
-(mk-test
-  "counto-once"
-  (run* q (counto 2 (list 1 2 3) q))
-  (list 1))
-(mk-test
-  "counto-thrice"
-  (run*
-    q
-    (counto
-      1
-      (list 1 2 1 3 1)
-      q))
-  (list 3))
-(mk-test
-  "counto-all-same"
-  (run*
-    q
-    (counto 7 (list 7 7 7 7) q))
-  (list 4))
-(mk-test
-  "counto-string"
-  (run* q (counto "x" (list "x" "y" "x") q))
-  (list 2))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/cyclic-graph.sx
+++ b/lib/minikanren/tests/cyclic-graph.sx
@@ -1,48 +0,0 @@
-;; lib/minikanren/tests/cyclic-graph.sx — demonstrates the naive-patho
-;; behaviour on a cyclic graph. Without Phase-7 tabling/SLG, the search
-;; produces ever-longer paths revisiting the cycle. `run n` truncates;
-;; `run*` would diverge.
-
-(define cyclic-edges (list (list :a :b) (list :b :a) (list :b :c)))
-
-(define cyclic-edgeo (fn (x y) (membero (list x y) cyclic-edges)))
-
-(define
-  cyclic-patho
-  (fn
-    (x y path)
-    (conde
-      ((cyclic-edgeo x y) (== path (list x y)))
-      ((fresh (z mid) (cyclic-edgeo x z) (cyclic-patho z y mid) (conso x mid path))))))
-
-;; --- direct edge ---
-
-(mk-test
-  "cyclic-direct"
-  (run 1 q (cyclic-patho :a :b q))
-  (list (list :a :b)))
-
-;; --- runs first 5 paths from a to b: bare edge, then increasing
-;;     numbers of cycle traversals (a->b->a->b, etc.) ---
-
-(mk-test
-  "cyclic-enumerates-prefix-via-run-n"
-  (let
-    ((paths (run 5 q (cyclic-patho :a :b q))))
-    (and
-      (= (len paths) 5)
-      (and
-        (every? (fn (p) (= (first p) :a)) paths)
-        (every? (fn (p) (= (last p) :b)) paths))))
-  true)
-
-(mk-test
-  "cyclic-finds-c-via-cycle-or-direct"
-  (let
-    ((paths (run 3 q (cyclic-patho :a :c q))))
-    (and
-      (>= (len paths) 1)
-      (some (fn (p) (= p (list :a :b :c))) paths)))
-  true)
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/defrel.sx
+++ b/lib/minikanren/tests/defrel.sx
@@ -1,40 +0,0 @@
-;; lib/minikanren/tests/defrel.sx — Prolog-style relation definition macro.
-
-(defrel
-  (my-membero x l)
-  ((fresh (d) (conso x d l)))
-  ((fresh (a d) (conso a d l) (my-membero x d))))
-
-(mk-test
-  "defrel-defines-membero"
-  (run* q (my-membero q (list 1 2 3)))
-  (list 1 2 3))
-
-(defrel
-  (my-listo l)
-  ((nullo l))
-  ((fresh (a d) (conso a d l) (my-listo d))))
-
-(mk-test
-  "defrel-listo-bounded"
-  (run 3 q (my-listo q))
-  (list
-    (list)
-    (list (make-symbol "_.0"))
-    (list (make-symbol "_.0") (make-symbol "_.1"))))
-
-;; Multi-arg relation with arithmetic.
-
-(defrel
-  (my-pluso a b c)
-  ((== a :z) (== b c))
-  ((fresh (a-1 c-1) (== a (list :s a-1)) (== c (list :s c-1)) (my-pluso a-1 b c-1))))
-
-(mk-test
-  "defrel-pluso-2-3"
-  (run*
-    q
-    (my-pluso (list :s (list :s :z)) (list :s (list :s (list :s :z))) q))
-  (list (list :s (list :s (list :s (list :s (list :s :z)))))))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/diseq.sx
+++ b/lib/minikanren/tests/diseq.sx
@@ -1,83 +0,0 @@
-;; lib/minikanren/tests/diseq.sx — Phase 5 polish: =/= disequality.
-
-;; --- ground cases ---
-
-(mk-test
-  "=/=-ground-distinct"
-  (run* q (=/= 1 2))
-  (list (make-symbol "_.0")))
-(mk-test "=/=-ground-equal" (run* q (=/= 1 1)) (list))
-(mk-test
-  "=/=-ground-strings"
-  (run* q (=/= "a" "b"))
-  (list (make-symbol "_.0")))
-(mk-test "=/=-ground-strings-eq" (run* q (=/= "a" "a")) (list))
-
-;; --- structural ---
-
-(mk-test
-  "=/=-pair-distinct"
-  (run* q (=/= (list 1 2) (list 1 3)))
-  (list (make-symbol "_.0")))
-(mk-test
-  "=/=-pair-equal"
-  (run* q (=/= (list 1 2) (list 1 2)))
-  (list))
-(mk-test
-  "=/=-pair-vs-atom"
-  (run* q (=/= (list 1) 1))
-  (list (make-symbol "_.0")))
-
-;; --- partial / late binding ---
-;;
-;; ==-cs is required to wake up the constraint store after a binding;
-;; plain == doesn't fire constraints.
-
-(mk-test
-  "=/=-late-bind-violates"
-  (run* q (fresh (x) (=/= x 5) (==-cs x 5) (== q x)))
-  (list))
-
-(mk-test
-  "=/=-late-bind-ok"
-  (run* q (fresh (x) (=/= x 5) (==-cs x 7) (== q x)))
-  (list 7))
-
-(mk-test
-  "=/=-two-vars-equal-late-fails"
-  (run*
-    q
-    (fresh
-      (x y)
-      (=/= x y)
-      (==-cs x 1)
-      (==-cs y 1)
-      (== q (list x y))))
-  (list))
-
-(mk-test
-  "=/=-two-vars-distinct-late"
-  (run*
-    q
-    (fresh
-      (x y)
-      (=/= x y)
-      (==-cs x 1)
-      (==-cs y 2)
-      (== q (list x y))))
-  (list (list 1 2)))
-
-;; --- compose with conde / fresh ---
-
-(mk-test
-  "=/=-with-membero-filter"
-  (run*
-    q
-    (fresh
-      (x)
-      (membero x (list 1 2 3))
-      (=/= x 2)
-      (== q x)))
-  (list 1 3))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/enumerate.sx
+++ b/lib/minikanren/tests/enumerate.sx
@@ -1,31 +0,0 @@
-;; lib/minikanren/tests/enumerate.sx — index-each-element relation.
-
-(mk-test
-  "enumerate-i-empty"
-  (run* q (enumerate-i (list) q))
-  (list (list)))
-
-(mk-test
-  "enumerate-i-three"
-  (run* q (enumerate-i (list :a :b :c) q))
-  (list
-    (list (list 0 :a) (list 1 :b) (list 2 :c))))
-
-(mk-test
-  "enumerate-i-strings"
-  (run* q (enumerate-i (list "x" "y" "z") q))
-  (list
-    (list (list 0 "x") (list 1 "y") (list 2 "z"))))
-
-(mk-test
-  "enumerate-from-i-100"
-  (run* q (enumerate-from-i 100 (list :x :y :z) q))
-  (list
-    (list (list 100 :x) (list 101 :y) (list 102 :z))))
-
-(mk-test
-  "enumerate-from-i-singleton"
-  (run* q (enumerate-from-i 0 (list :only) q))
-  (list (list (list 0 :only))))
-
-(mk-tests-run!)
--- a/lib/minikanren/tests/fd.sx
+++ b/lib/minikanren/tests/fd.sx
@@ -1,75 +0,0 @@
-;; lib/minikanren/tests/fd.sx — Phase 6 piece A: ino + all-distincto.
-
-;; --- ino ---
-
-(mk-test
-  "ino-element-in-domain"
-  (run* q (ino q (list 1 2 3)))
-  (list 1 2 3))
-
-(mk-test "ino-empty-domain" (run* q (ino q (list))) (list))
-
-(mk-test
-  "ino-singleton-domain"
-  (run* q (ino q (list 42)))
-  (list 42))
-
-;; --- all-distincto ---
-
-(mk-test
-  "all-distincto-empty"
-  (run* q (all-distincto (list)))
-  (list (make-symbol "_.0")))
-
-(mk-test
-  "all-distincto-singleton"
-  (run* q (all-distincto (list 1)))
-  (list (make-symbol "_.0")))
-
-(mk-test
-  "all-distincto-distinct-three"
-  (run* q (all-distincto (list 1 2 3)))
-  (list (make-symbol "_.0")))
-
-(mk-test
-  "all-distincto-duplicate-fails"
-  (run* q (all-distincto (list 1 2 1)))
-  (list))
-
-(mk-test
-  "all-distincto-adjacent-duplicate-fails"
-  (run* q (all-distincto (list 1 1 2)))
-  (list))
-
-;; --- ino + all-distincto: classic enumerate-all-permutations ---
-
-(mk-test
-  "fd-puzzle-three-distinct-from-domain"
-  (let
-    ((perms (run* q (fresh (a b c) (== q (list a b c)) (ino a (list 1 2 3)) (ino b (list 1 2 3)) (ino c (list 1 2 3)) (all-distincto (list a b c))))))
-    (and
-      (= (len perms) 6)
-      (and
-        (some (fn (p) (= p (list 1 2 3))) perms)
-        (and
-          (some
-            (fn (p) (= p (list 1 3 2)))
-            perms)
-          (and
-            (some
-              (fn (p) (= p (list 2 1 3)))
-              perms)
-            (and
-              (some
-                (fn (p) (= p (list 2 3 1)))
-                perms)
-              (and
-                (some
-                  (fn (p) (= p (list 3 1 2)))
-                  perms)
-                (some
-                  (fn (p) (= p (list 3 2 1)))
-                  perms))))))))
-  true)
-
-(mk-tests-run!)
--- a/Show More
+++ b/Show More