kernel: loop summary — 18 commits, 322 tests, 6 reflective API candidates [proposes-reflective-extraction]

Loop closer documenting what 18 feature commits produced. Kernel-on-SX
is 1,398 LoC substrate + 1,747 LoC tests = 3,145 LoC total. Zero
substrate fixes required across the loop. R-1RK core + extras
implemented. Six proposed lib/guest/reflective/ files awaiting second
consumer. Substrate verdict: env-as-value generalises to
evaluator-as-value; the m-eval demo proves it.

hosts/ocaml/lib/sx_primitives.ml

@@ -3632,6 +3632,148 @@ let () =
                             else "")))
     else String trimmed);
 
+  (* exec-pipeline: takes a list of words like Tcl `exec` would receive.
+     Recognizes `|` as a stage separator and `> file`, `>> file`, `< file`,
+     `2>@1` (stderr→stdout), `2> file`. Returns trimmed stdout of the last
+     stage; raises Eval_error if the last stage exits non-zero. *)
+  register "exec-pipeline" (fun args ->
+    let items = match args with
+      | [List xs] | [ListRef { contents = xs }] -> xs
+      | _ -> raise (Eval_error "exec-pipeline: (word-list)")
+    in
+    let words = List.map (function
+      | String s -> s
+      | v -> Sx_types.inspect v
+    ) items in
+    if words = [] then raise (Eval_error "exec: empty command");
+    let split_stages ws =
+      let rec loop acc cur = function
+        | [] -> List.rev (List.rev cur :: acc)
+        | "|" :: rest -> loop (List.rev cur :: acc) [] rest
+        | w :: rest -> loop acc (w :: cur) rest
+      in
+      loop [] [] ws
+    in
+    let extract_redirs ws =
+      let in_path = ref None in
+      let out_path = ref None in
+      let out_append = ref false in
+      let err_path = ref None in
+      let merge_err = ref false in
+      let cleaned = ref [] in
+      let rec loop = function
+        | [] -> ()
+        | "<" :: p :: rest -> in_path := Some p; loop rest
+        | ">" :: p :: rest -> out_path := Some p; out_append := false; loop rest
+        | ">>" :: p :: rest -> out_path := Some p; out_append := true; loop rest
+        | "2>@1" :: rest -> merge_err := true; loop rest
+        | "2>" :: p :: rest -> err_path := Some p; loop rest
+        | w :: rest -> cleaned := w :: !cleaned; loop rest
+      in
+      loop ws;
+      (List.rev !cleaned, !in_path, !out_path, !out_append, !err_path, !merge_err)
+    in
+    let stages = List.map extract_redirs (split_stages words) in
+    if stages = [] then raise (Eval_error "exec: no stages");
+    let n = List.length stages in
+    let pipes = Array.init (max 0 (n - 1)) (fun _ -> Unix.pipe ()) in
+    let (final_r, final_w) = Unix.pipe () in
+    let (errstash_r, errstash_w) = Unix.pipe () in
+    let pids = ref [] in
+    let close_safe fd = try Unix.close fd with _ -> () in
+    let open_in_redir = function
+      | None -> Unix.stdin
+      | Some path ->
+        (try Unix.openfile path [Unix.O_RDONLY] 0o644
+         with Unix.Unix_error (e, _, _) ->
+           raise (Eval_error ("exec: open <" ^ path ^ ": " ^ Unix.error_message e)))
+    in
+    let open_out_redir path append =
+      let flags = Unix.O_WRONLY :: Unix.O_CREAT :: (if append then [Unix.O_APPEND] else [Unix.O_TRUNC]) in
+      try Unix.openfile path flags 0o644
+      with Unix.Unix_error (e, _, _) ->
+        raise (Eval_error ("exec: open >" ^ path ^ ": " ^ Unix.error_message e))
+    in
+    let stages_arr = Array.of_list stages in
+    (try
+      Array.iteri (fun i (cleaned, ip, op, app, ep, merge) ->
+        if cleaned = [] then raise (Eval_error "exec: empty stage in pipeline");
+        let argv = Array.of_list cleaned in
+        let stdin_fd =
+          if i = 0 then open_in_redir ip
+          else fst pipes.(i - 1)
+        in
+        let stdout_fd =
+          if i = n - 1 then
+            (match op with
+             | None -> final_w
+             | Some path -> open_out_redir path app)
+          else snd pipes.(i)
+        in
+        let stderr_fd =
+          if merge then stdout_fd
+          else (match ep with
+                | None -> if i = n - 1 then errstash_w else Unix.stderr
+                | Some path -> open_out_redir path false)
+        in
+        let pid =
+          try Unix.create_process argv.(0) argv stdin_fd stdout_fd stderr_fd
+          with Unix.Unix_error (e, _, _) ->
+            raise (Eval_error ("exec: " ^ argv.(0) ^ ": " ^ Unix.error_message e))
+        in
+        pids := pid :: !pids;
+        if i > 0 then close_safe (fst pipes.(i - 1));
+        if i < n - 1 then close_safe (snd pipes.(i));
+        if i = 0 && ip <> None then close_safe stdin_fd;
+        if i = n - 1 && op <> None then close_safe stdout_fd;
+        if not merge && ep <> None then close_safe stderr_fd
+      ) stages_arr
+    with e ->
+      close_safe final_r; close_safe final_w;
+      close_safe errstash_r; close_safe errstash_w;
+      Array.iter (fun (a,b) -> close_safe a; close_safe b) pipes;
+      raise e);
+    close_safe final_w;
+    close_safe errstash_w;
+    let buf = Buffer.create 256 in
+    let errbuf = Buffer.create 64 in
+    let chunk = Bytes.create 4096 in
+    let read_all fd target =
+      try
+        let stop = ref false in
+        while not !stop do
+          let r = Unix.read fd chunk 0 (Bytes.length chunk) in
+          if r = 0 then stop := true
+          else Buffer.add_subbytes target chunk 0 r
+        done
+      with _ -> ()
+    in
+    read_all final_r buf;
+    read_all errstash_r errbuf;
+    close_safe final_r;
+    close_safe errstash_r;
+    let exit_codes = List.rev_map (fun pid ->
+      let (_, st) = Unix.waitpid [] pid in
+      match st with
+      | Unix.WEXITED c -> c
+      | _ -> 1
+    ) !pids in
+    let final_code = match List.rev exit_codes with
+      | [] -> 0
+      | last :: _ -> last
+    in
+    let s = Buffer.contents buf in
+    let trimmed =
+      if String.length s > 0 && s.[String.length s - 1] = '\n'
+      then String.sub s 0 (String.length s - 1) else s
+    in
+    if final_code <> 0 then
+      raise (Eval_error ("exec: pipeline last stage exited " ^ string_of_int final_code
+                         ^ (if Buffer.length errbuf > 0
+                            then ": " ^ Buffer.contents errbuf
+                            else "")))
+    else String trimmed);
+
   (* === Sockets === wrapping Unix.socket/connect/bind/listen/accept *)
   let resolve_inet_addr host =
     if host = "" || host = "0.0.0.0" then Unix.inet_addr_any

lib/kernel/eval.sx

@@ -0,0 +1,234 @@
+;; lib/kernel/eval.sx — Kernel evaluator.
+;;
+;; The evaluator is `lookup-and-combine`: there are no hardcoded special
+;; forms. Even $if / $define! / $lambda are ordinary operatives bound in
+;; the standard environment (Phase 4). This file builds the dispatch
+;; machinery and the operative/applicative tagged-value protocol.
+;;
+;; Tagged values
+;; -------------
+;;   {:knl-tag :env :bindings DICT :parent PARENT-OR-NIL}
+;;     A first-class Kernel environment. Bindings is a mutable SX dict
+;;     keyed by symbol name; parent walks up the lookup chain.
+;;
+;;   {:knl-tag :operative :impl FN}
+;;     Primitive operative. FN receives (args dyn-env) — args are the
+;;     UN-evaluated argument expressions, dyn-env is the calling env.
+;;
+;;   {:knl-tag :operative :params P :env-param EP :body B :static-env SE}
+;;     User-defined operative (built by $vau). Same tag; dispatch in
+;;     kernel-call-operative forks on which keys are present.
+;;
+;;   {:knl-tag :applicative :underlying OP}
+;;     An applicative wraps an operative. Calls evaluate args first,
+;;     then forward to the underlying operative.
+;;
+;; The env-param of a user operative may be the sentinel :knl-ignore,
+;; in which case the dynamic env is not bound.
+;;
+;; Public API
+;;   (kernel-eval EXPR ENV)                     — primary entry
+;;   (kernel-combine COMBINER ARGS DYN-ENV)
+;;   (kernel-call-operative OP ARGS DYN-ENV)
+;;   (kernel-bind-params! ENV PARAMS ARGS)
+;;   (kernel-make-env) / (kernel-extend-env P)
+;;   (kernel-env-bind! E N V) / (kernel-env-lookup E N)
+;;   (kernel-env-has? E N) / (kernel-env? V)
+;;   (kernel-make-primitive-operative IMPL)
+;;   (kernel-make-primitive-applicative IMPL)
+;;   (kernel-make-user-operative PARAMS EPARAM BODY STATIC-ENV)
+;;   (kernel-wrap OP) / (kernel-unwrap APP)
+;;   (kernel-operative? V) / (kernel-applicative? V) / (kernel-combiner? V)
+;;
+;; Consumes: lib/kernel/parser.sx (kernel-string?, kernel-string-value)
+
+;; ── Environments — first-class, pure-SX (binding dict + parent) ──
+
+(define kernel-env? (fn (v) (and (dict? v) (= (get v :knl-tag) :env))))
+
+(define kernel-make-env (fn () {:parent nil :knl-tag :env :bindings {}}))
+
+(define kernel-extend-env (fn (parent) {:parent parent :knl-tag :env :bindings {}}))
+
+(define
+  kernel-env-bind!
+  (fn (env name val) (dict-set! (get env :bindings) name val) val))
+
+(define
+  kernel-env-has?
+  (fn
+    (env name)
+    (cond
+      ((nil? env) false)
+      ((not (kernel-env? env)) false)
+      ((dict-has? (get env :bindings) name) true)
+      (:else (kernel-env-has? (get env :parent) name)))))
+
+(define
+  kernel-env-lookup
+  (fn
+    (env name)
+    (cond
+      ((nil? env) (error (str "kernel-eval: unbound symbol: " name)))
+      ((not (kernel-env? env))
+        (error (str "kernel-eval: corrupt env: " env)))
+      ((dict-has? (get env :bindings) name) (get (get env :bindings) name))
+      (:else (kernel-env-lookup (get env :parent) name)))))
+
+;; ── Tagged-value constructors and predicates ─────────────────────
+
+(define kernel-make-primitive-operative (fn (impl) {:impl impl :knl-tag :operative}))
+
+(define
+  kernel-make-user-operative
+  (fn (params eparam body static-env) {:knl-tag :operative :static-env static-env :params params :body body :env-param eparam}))
+
+(define
+  kernel-operative?
+  (fn (v) (and (dict? v) (= (get v :knl-tag) :operative))))
+
+(define
+  kernel-applicative?
+  (fn (v) (and (dict? v) (= (get v :knl-tag) :applicative))))
+
+(define
+  kernel-combiner?
+  (fn (v) (or (kernel-operative? v) (kernel-applicative? v))))
+
+(define
+  kernel-wrap
+  (fn
+    (op)
+    (cond
+      ((kernel-operative? op) {:knl-tag :applicative :underlying op})
+      (:else (error "kernel-wrap: argument must be an operative")))))
+
+(define
+  kernel-unwrap
+  (fn
+    (app)
+    (cond
+      ((kernel-applicative? app) (get app :underlying))
+      (:else (error "kernel-unwrap: argument must be an applicative")))))
+
+(define
+  kernel-make-primitive-applicative
+  (fn
+    (impl)
+    (kernel-wrap
+      (kernel-make-primitive-operative (fn (args dyn-env) (impl args))))))
+
+;; As above, but IMPL receives (args dyn-env). Used by combinators that
+;; re-enter the evaluator (map, filter, reduce, apply, eval, ...).
+(define kernel-make-primitive-applicative-with-env
+  (fn (impl)
+    (kernel-wrap
+      (kernel-make-primitive-operative
+        (fn (args dyn-env) (impl args dyn-env))))))
+
+;; ── The evaluator ────────────────────────────────────────────────
+
+(define
+  kernel-eval
+  (fn
+    (expr env)
+    (cond
+      ((number? expr) expr)
+      ((boolean? expr) expr)
+      ((nil? expr) expr)
+      ((kernel-string? expr) (kernel-string-value expr))
+      ((string? expr) (kernel-env-lookup env expr))
+      ((list? expr)
+        (cond
+          ((= (length expr) 0) expr)
+          (:else
+            (let
+              ((combiner (kernel-eval (first expr) env))
+                (args (rest expr)))
+              (kernel-combine combiner args env)))))
+      (:else (error (str "kernel-eval: unknown form: " expr))))))
+
+(define
+  kernel-combine
+  (fn
+    (combiner args dyn-env)
+    (cond
+      ((kernel-operative? combiner)
+        (kernel-call-operative combiner args dyn-env))
+      ((kernel-applicative? combiner)
+        (kernel-combine
+          (get combiner :underlying)
+          (kernel-eval-args args dyn-env)
+          dyn-env))
+      (:else (error (str "kernel-eval: not a combiner: " combiner))))))
+
+;; Operatives may be primitive (:impl is a host fn) or user-defined
+;; (carry :params / :env-param / :body / :static-env). The dispatch
+;; fork is here so kernel-combine stays small.
+(define
+  kernel-call-operative
+  (fn
+    (op args dyn-env)
+    (cond
+      ((dict-has? op :impl) ((get op :impl) args dyn-env))
+      ((dict-has? op :body)
+        (let
+          ((local (kernel-extend-env (get op :static-env))))
+          (kernel-bind-params! local (get op :params) args)
+          (let
+            ((eparam (get op :env-param)))
+            (when
+              (not (= eparam :knl-ignore))
+              (kernel-env-bind! local eparam dyn-env)))
+          ;; :body is a list of forms — evaluate in sequence, return last.
+          (knl-eval-body (get op :body) local)))
+      (:else (error "kernel-call-operative: malformed operative")))))
+
+(define knl-eval-body
+  (fn (forms env)
+    (cond
+      ((= (length forms) 1) (kernel-eval (first forms) env))
+      (:else
+        (begin
+          (kernel-eval (first forms) env)
+          (knl-eval-body (rest forms) env))))))
+
+;; Phase 3 supports a flat parameter list only — destructuring later.
+(define
+  kernel-bind-params!
+  (fn
+    (env params args)
+    (cond
+      ((or (nil? params) (= (length params) 0))
+        (cond
+          ((or (nil? args) (= (length args) 0)) nil)
+          (:else (error "kernel-call: too many arguments"))))
+      ((or (nil? args) (= (length args) 0))
+        (error "kernel-call: too few arguments"))
+      (:else
+        (begin
+          (kernel-env-bind! env (first params) (first args))
+          (kernel-bind-params! env (rest params) (rest args)))))))
+
+(define
+  kernel-eval-args
+  (fn
+    (args env)
+    (cond
+      ((or (nil? args) (= (length args) 0)) (list))
+      (:else
+        (cons
+          (kernel-eval (first args) env)
+          (kernel-eval-args (rest args) env))))))
+
+(define
+  kernel-eval-program
+  (fn
+    (forms env)
+    (cond
+      ((or (nil? forms) (= (length forms) 0)) nil)
+      ((= (length forms) 1) (kernel-eval (first forms) env))
+      (:else
+        (begin
+          (kernel-eval (first forms) env)
+          (kernel-eval-program (rest forms) env))))))

lib/kernel/parser.sx

@@ -0,0 +1,253 @@
+;; lib/kernel/parser.sx — Kernel s-expression reader.
+;;
+;; Reads R-1RK lexical syntax: numbers, strings, symbols, booleans (#t/#f),
+;; the empty list (), nested lists, and ; line comments. Reader macros
+;; (' ` , ,@) deferred to Phase 6 per the plan.
+;;
+;; Public AST shape:
+;;   number      → SX number
+;;   #t / #f     → SX true / false
+;;   ()          → SX empty list (Kernel's nil — the empty list)
+;;   "..."       → {:knl-string "..."}    wrapped to distinguish from symbols
+;;   foo         → "foo"                  bare SX string is a Kernel symbol
+;;   (a b c)     → SX list of forms
+;;
+;; Public API:
+;;   (kernel-parse SRC)      — first form; errors on extra trailing input
+;;   (kernel-parse-all SRC)  — all top-level forms, as SX list
+;;   (kernel-string? V)      — recognise wrapped string literal
+;;   (kernel-string-value V) — extract the underlying string
+;;
+;; Consumes: lib/guest/lex.sx (lex-digit?, lex-whitespace?)
+
+(define kernel-string-make (fn (s) {:knl-string s}))
+(define
+  kernel-string?
+  (fn (v) (and (dict? v) (string? (get v :knl-string)))))
+(define kernel-string-value (fn (v) (get v :knl-string)))
+
+;; Atom delimiters: characters that end a symbol or numeric token.
+(define
+  knl-delim?
+  (fn
+    (c)
+    (or
+      (nil? c)
+      (lex-whitespace? c)
+      (= c "(")
+      (= c ")")
+      (= c "\"")
+      (= c ";")
+      (= c "'")
+      (= c "`")
+      (= c ","))))
+
+;; Numeric grammar:  [+-]? (digit+ ('.' digit+)? | '.' digit+) ([eE][+-]?digit+)?
+(define
+  knl-numeric?
+  (fn
+    (s)
+    (let
+      ((n (string-length s)))
+      (cond
+        ((= n 0) false)
+        (:else
+          (let
+            ((c0 (substring s 0 1)))
+            (let
+              ((start (if (or (= c0 "+") (= c0 "-")) 1 0)))
+              (knl-num-body? s start n))))))))
+
+(define
+  knl-num-body?
+  (fn
+    (s start n)
+    (cond
+      ((>= start n) false)
+      ((= (substring s start (+ start 1)) ".")
+        (knl-num-need-digits? s (+ start 1) n false))
+      ((lex-digit? (substring s start (+ start 1)))
+        (knl-num-int-tail? s (+ start 1) n))
+      (:else false))))
+
+(define
+  knl-num-int-tail?
+  (fn
+    (s i n)
+    (cond
+      ((>= i n) true)
+      ((lex-digit? (substring s i (+ i 1)))
+        (knl-num-int-tail? s (+ i 1) n))
+      ((= (substring s i (+ i 1)) ".")
+        (knl-num-need-digits? s (+ i 1) n true))
+      ((or (= (substring s i (+ i 1)) "e") (= (substring s i (+ i 1)) "E"))
+        (knl-num-exp-sign? s (+ i 1) n))
+      (:else false))))
+
+(define
+  knl-num-need-digits?
+  (fn
+    (s i n had-int)
+    (cond
+      ((>= i n) had-int)
+      ((lex-digit? (substring s i (+ i 1)))
+        (knl-num-frac-tail? s (+ i 1) n))
+      (:else false))))
+
+(define
+  knl-num-frac-tail?
+  (fn
+    (s i n)
+    (cond
+      ((>= i n) true)
+      ((lex-digit? (substring s i (+ i 1)))
+        (knl-num-frac-tail? s (+ i 1) n))
+      ((or (= (substring s i (+ i 1)) "e") (= (substring s i (+ i 1)) "E"))
+        (knl-num-exp-sign? s (+ i 1) n))
+      (:else false))))
+
+(define
+  knl-num-exp-sign?
+  (fn
+    (s i n)
+    (cond
+      ((>= i n) false)
+      ((or (= (substring s i (+ i 1)) "+") (= (substring s i (+ i 1)) "-"))
+        (knl-num-exp-digits? s (+ i 1) n false))
+      (:else (knl-num-exp-digits? s i n false)))))
+
+(define
+  knl-num-exp-digits?
+  (fn
+    (s i n had)
+    (cond
+      ((>= i n) had)
+      ((lex-digit? (substring s i (+ i 1)))
+        (knl-num-exp-digits? s (+ i 1) n true))
+      (:else false))))
+
+;; Reader: a closure over (src, pos). Exposes :read-form and :read-all.
+(define
+  knl-make-reader
+  (fn
+    (src)
+    (let
+      ((pos 0) (n (string-length src)))
+      (define
+        at
+        (fn () (if (< pos n) (substring src pos (+ pos 1)) nil)))
+      (define adv (fn () (set! pos (+ pos 1))))
+      (define
+        skip-line
+        (fn () (when (and (at) (not (= (at) "\n"))) (adv) (skip-line))))
+      (define
+        skip-ws
+        (fn
+          ()
+          (cond
+            ((nil? (at)) nil)
+            ((lex-whitespace? (at)) (do (adv) (skip-ws)))
+            ((= (at) ";") (do (adv) (skip-line) (skip-ws)))
+            (:else nil))))
+      (define
+        read-string-body
+        (fn
+          (acc)
+          (cond
+            ((nil? (at)) (error "kernel-parse: unterminated string"))
+            ((= (at) "\"") (do (adv) acc))
+            ((= (at) "\\")
+              (do
+                (adv)
+                (let
+                  ((c (at)))
+                  (when (nil? c) (error "kernel-parse: trailing backslash"))
+                  (adv)
+                  (read-string-body
+                    (str
+                      acc
+                      (cond
+                        ((= c "n") "\n")
+                        ((= c "t") "\t")
+                        ((= c "r") "\r")
+                        ((= c "\"") "\"")
+                        ((= c "\\") "\\")
+                        (:else c)))))))
+            (:else
+              (let ((c (at))) (adv) (read-string-body (str acc c)))))))
+      (define
+        read-atom-body
+        (fn
+          (acc)
+          (cond
+            ((knl-delim? (at)) acc)
+            (:else (let ((c (at))) (adv) (read-atom-body (str acc c)))))))
+      (define
+        classify-atom
+        (fn
+          (s)
+          (cond
+            ((= s "#t") true)
+            ((= s "#f") false)
+            ((knl-numeric? s) (string->number s))
+            (:else s))))
+      (define
+        read-form
+        (fn
+          ()
+          (skip-ws)
+          (cond
+            ((nil? (at)) :knl-eof)
+            ((= (at) ")") (error "kernel-parse: unexpected ')'"))
+            ((= (at) "(") (do (adv) (read-list (list))))
+            ((= (at) "\"")
+              (do (adv) (kernel-string-make (read-string-body ""))))
+            ((= (at) "'")
+              (do (adv) (list "$quote" (read-form))))
+            ((= (at) "`")
+              (do (adv) (list "$quasiquote" (read-form))))
+            ((= (at) ",")
+              (do (adv)
+                  (cond
+                    ((= (at) "@")
+                      (do (adv) (list "$unquote-splicing" (read-form))))
+                    (:else (list "$unquote" (read-form))))))
+            (:else (classify-atom (read-atom-body ""))))))
+      (define
+        read-list
+        (fn
+          (acc)
+          (skip-ws)
+          (cond
+            ((nil? (at)) (error "kernel-parse: unterminated list"))
+            ((= (at) ")") (do (adv) acc))
+            (:else (read-list (append acc (list (read-form))))))))
+      (define
+        read-all
+        (fn
+          (acc)
+          (skip-ws)
+          (if (nil? (at)) acc (read-all (append acc (list (read-form)))))))
+      {:read-form read-form :read-all read-all})))
+
+(define
+  kernel-parse-all
+  (fn (src) ((get (knl-make-reader src) :read-all) (list))))
+
+(define
+  kernel-parse
+  (fn
+    (src)
+    (let
+      ((r (knl-make-reader src)))
+      (let
+        ((form ((get r :read-form))))
+        (cond
+          ((= form :knl-eof) (error "kernel-parse: empty input"))
+          (:else
+            (let
+              ((next ((get r :read-form))))
+              (if
+                (= next :knl-eof)
+                form
+                (error "kernel-parse: trailing input after first form")))))))))

lib/kernel/runtime.sx

@@ -0,0 +1,911 @@
+;; lib/kernel/runtime.sx — the operative–applicative substrate and the
+;; standard Kernel environment.
+;;
+;; Phase 3 supplied four user-visible combiners ($vau, $lambda, wrap,
+;; unwrap). Phase 4 fills out the rest of the R-1RK core: $if, $define!,
+;; $sequence, eval, make-environment, get-current-environment, plus
+;; arithmetic, equality, list/pair, and boolean primitives — enough to
+;; write factorial.
+;;
+;; The standard env is built by EXTENDING the base env, not replacing
+;; it. So `kernel-standard-env` includes everything from `kernel-base-env`.
+;;
+;; Public API
+;;   (kernel-base-env)       — Phase 3 combiners
+;;   (kernel-standard-env)   — Phase 4 standard environment
+
+(define
+  knl-eparam-sentinel
+  (fn
+    (sym)
+    (cond
+      ((= sym "_") :knl-ignore)
+      ((= sym "#ignore") :knl-ignore)
+      (:else sym))))
+
+(define
+  knl-formals-ok?
+  (fn
+    (formals)
+    (cond
+      ((not (list? formals)) false)
+      ((= (length formals) 0) true)
+      ((string? (first formals)) (knl-formals-ok? (rest formals)))
+      (:else false))))
+
+;; ── $vau ─────────────────────────────────────────────────────────
+
+(define
+  kernel-vau-impl
+  (fn
+    (args dyn-env)
+    (cond
+      ((< (length args) 3)
+        (error "$vau: expects (formals env-param body...)"))
+      (:else
+        (let
+          ((formals (first args))
+            (eparam-raw (nth args 1))
+            (body-forms (rest (rest args))))
+          (cond
+            ((not (knl-formals-ok? formals))
+              (error "$vau: formals must be a list of symbols"))
+            ((not (string? eparam-raw))
+              (error "$vau: env-param must be a symbol"))
+            (:else
+              (kernel-make-user-operative
+                formals
+                (knl-eparam-sentinel eparam-raw)
+                body-forms
+                dyn-env))))))))
+
+(define
+  kernel-vau-operative
+  (kernel-make-primitive-operative kernel-vau-impl))
+
+;; ── $lambda ──────────────────────────────────────────────────────
+
+(define
+  kernel-lambda-impl
+  (fn
+    (args dyn-env)
+    (cond
+      ((< (length args) 2)
+        (error "$lambda: expects (formals body...)"))
+      (:else
+        (let
+          ((formals (first args)) (body-forms (rest args)))
+          (cond
+            ((not (knl-formals-ok? formals))
+              (error "$lambda: formals must be a list of symbols"))
+            (:else
+              (kernel-wrap
+                (kernel-make-user-operative
+                  formals
+                  :knl-ignore
+                  body-forms
+                  dyn-env)))))))))
+
+(define
+  kernel-lambda-operative
+  (kernel-make-primitive-operative kernel-lambda-impl))
+
+;; ── wrap / unwrap / predicates ───────────────────────────────────
+
+(define
+  kernel-wrap-applicative
+  (kernel-make-primitive-applicative
+    (fn
+      (args)
+      (cond
+        ((not (= (length args) 1))
+          (error "wrap: expects exactly 1 argument"))
+        (:else (kernel-wrap (first args)))))))
+
+(define
+  kernel-unwrap-applicative
+  (kernel-make-primitive-applicative
+    (fn
+      (args)
+      (cond
+        ((not (= (length args) 1))
+          (error "unwrap: expects exactly 1 argument"))
+        (:else (kernel-unwrap (first args)))))))
+
+(define
+  kernel-operative?-applicative
+  (kernel-make-primitive-applicative
+    (fn (args) (kernel-operative? (first args)))))
+
+(define
+  kernel-applicative?-applicative
+  (kernel-make-primitive-applicative
+    (fn (args) (kernel-applicative? (first args)))))
+
+(define
+  kernel-base-env
+  (fn
+    ()
+    (let
+      ((env (kernel-make-env)))
+      (kernel-env-bind! env "$vau" kernel-vau-operative)
+      (kernel-env-bind! env "$lambda" kernel-lambda-operative)
+      (kernel-env-bind! env "wrap" kernel-wrap-applicative)
+      (kernel-env-bind! env "unwrap" kernel-unwrap-applicative)
+      (kernel-env-bind! env "operative?" kernel-operative?-applicative)
+      (kernel-env-bind! env "applicative?" kernel-applicative?-applicative)
+      env)))
+
+;; ── $if / $define! / $sequence ───────────────────────────────────
+
+(define
+  kernel-if-operative
+  (kernel-make-primitive-operative
+    (fn
+      (args dyn-env)
+      (cond
+        ((not (= (length args) 3))
+          (error "$if: expects (condition then-expr else-expr)"))
+        (:else
+          (let
+            ((c (kernel-eval (first args) dyn-env)))
+            (if
+              c
+              (kernel-eval (nth args 1) dyn-env)
+              (kernel-eval (nth args 2) dyn-env))))))))
+
+(define
+  kernel-define!-operative
+  (kernel-make-primitive-operative
+    (fn
+      (args dyn-env)
+      (cond
+        ((not (= (length args) 2))
+          (error "$define!: expects (name expr)"))
+        ((not (string? (first args)))
+          (error "$define!: name must be a symbol"))
+        (:else
+          (let
+            ((v (kernel-eval (nth args 1) dyn-env)))
+            (kernel-env-bind! dyn-env (first args) v)
+            v))))))
+
+(define
+  kernel-sequence-operative
+  (kernel-make-primitive-operative
+    (fn
+      (args dyn-env)
+      (cond
+        ((or (nil? args) (= (length args) 0)) nil)
+        ((= (length args) 1) (kernel-eval (first args) dyn-env))
+        (:else
+          (begin
+            (kernel-eval (first args) dyn-env)
+            ((get kernel-sequence-operative :impl) (rest args) dyn-env)))))))
+
+;; ── eval / make-environment / get-current-environment ───────────
+
+(define
+  kernel-quote-operative
+  (kernel-make-primitive-operative
+    (fn
+      (args dyn-env)
+      (cond
+        ((not (= (length args) 1)) (error "$quote: expects 1 argument"))
+        (:else (first args))))))
+
+;; Quasiquote: walks the template, evaluating `$unquote` forms in the
+;; dynamic env and splicing `$unquote-splicing` list results.
+(define knl-quasi-walk
+  (fn (form dyn-env)
+    (cond
+      ((not (list? form)) form)
+      ((= (length form) 0) form)
+      ((and (string? (first form)) (= (first form) "$unquote"))
+        (cond
+          ((not (= (length form) 2))
+            (error "$unquote: expects exactly 1 argument"))
+          (:else (kernel-eval (nth form 1) dyn-env))))
+      (:else (knl-quasi-walk-list form dyn-env)))))
+
+(define knl-quasi-walk-list
+  (fn (forms dyn-env)
+    (cond
+      ((or (nil? forms) (= (length forms) 0)) (list))
+      (:else
+        (let ((head (first forms)))
+          (cond
+            ((and (list? head)
+                  (= (length head) 2)
+                  (string? (first head))
+                  (= (first head) "$unquote-splicing"))
+              (let ((spliced (kernel-eval (nth head 1) dyn-env)))
+                (cond
+                  ((not (list? spliced))
+                    (error "$unquote-splicing: value must be a list"))
+                  (:else
+                    (knl-list-concat
+                      spliced
+                      (knl-quasi-walk-list (rest forms) dyn-env))))))
+            (:else
+              (cons (knl-quasi-walk head dyn-env)
+                    (knl-quasi-walk-list (rest forms) dyn-env)))))))))
+
+(define knl-list-concat
+  (fn (xs ys)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) ys)
+      (:else (cons (first xs) (knl-list-concat (rest xs) ys))))))
+
+;; $cond — multi-clause branch.
+;;   ($cond (TEST1 EXPR1 ...) (TEST2 EXPR2 ...) ...)
+;; Evaluates each TEST in order; first truthy one runs its EXPRs (in
+;; sequence) and returns the last; if no TEST is truthy, returns nil.
+;; A clause with TEST = `else` always matches (sugar for $if's default).
+(define knl-cond-impl
+  (fn (clauses dyn-env)
+    (cond
+      ((or (nil? clauses) (= (length clauses) 0)) nil)
+      (:else
+        (let ((clause (first clauses)))
+          (cond
+            ((not (list? clause))
+              (error "$cond: each clause must be a list"))
+            ((= (length clause) 0)
+              (error "$cond: empty clause"))
+            ((and (string? (first clause)) (= (first clause) "else"))
+              (knl-cond-eval-body (rest clause) dyn-env))
+            (:else
+              (let ((test-val (kernel-eval (first clause) dyn-env)))
+                (cond
+                  (test-val (knl-cond-eval-body (rest clause) dyn-env))
+                  (:else (knl-cond-impl (rest clauses) dyn-env)))))))))))
+
+(define knl-cond-eval-body
+  (fn (body dyn-env)
+    (cond
+      ((or (nil? body) (= (length body) 0)) nil)
+      ((= (length body) 1) (kernel-eval (first body) dyn-env))
+      (:else
+        (begin
+          (kernel-eval (first body) dyn-env)
+          (knl-cond-eval-body (rest body) dyn-env))))))
+
+(define kernel-cond-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env) (knl-cond-impl args dyn-env))))
+
+;; $when COND BODY... — evaluate body iff COND is truthy; else nil.
+(define kernel-when-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((< (length args) 1)
+          (error "$when: expects (cond body...)"))
+        (:else
+          (let ((c (kernel-eval (first args) dyn-env)))
+            (cond
+              (c (knl-cond-eval-body (rest args) dyn-env))
+              (:else nil))))))))
+
+;; $and? — short-circuit AND. Operative (not applicative) so untaken
+;; clauses are NOT evaluated. Empty $and? returns true (the identity).
+(define knl-and?-impl
+  (fn (args dyn-env)
+    (cond
+      ((or (nil? args) (= (length args) 0)) true)
+      ((= (length args) 1) (kernel-eval (first args) dyn-env))
+      (:else
+        (let ((v (kernel-eval (first args) dyn-env)))
+          (cond
+            (v (knl-and?-impl (rest args) dyn-env))
+            (:else v)))))))
+
+(define kernel-and?-operative
+  (kernel-make-primitive-operative knl-and?-impl))
+
+;; $or? — short-circuit OR. Operative; untaken clauses NOT evaluated.
+;; Empty $or? returns false (the identity).
+(define knl-or?-impl
+  (fn (args dyn-env)
+    (cond
+      ((or (nil? args) (= (length args) 0)) false)
+      ((= (length args) 1) (kernel-eval (first args) dyn-env))
+      (:else
+        (let ((v (kernel-eval (first args) dyn-env)))
+          (cond
+            (v v)
+            (:else (knl-or?-impl (rest args) dyn-env))))))))
+
+(define kernel-or?-operative
+  (kernel-make-primitive-operative knl-or?-impl))
+
+;; $unless COND BODY... — evaluate body iff COND is falsy; else nil.
+(define kernel-unless-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((< (length args) 1)
+          (error "$unless: expects (cond body...)"))
+        (:else
+          (let ((c (kernel-eval (first args) dyn-env)))
+            (cond
+              (c nil)
+              (:else (knl-cond-eval-body (rest args) dyn-env)))))))))
+
+(define kernel-quasiquote-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 1))
+          (error "$quasiquote: expects exactly 1 argument"))
+        (:else (knl-quasi-walk (first args) dyn-env))))))
+
+(define
+  kernel-eval-applicative
+  (kernel-make-primitive-applicative
+    (fn
+      (args)
+      (cond
+        ((not (= (length args) 2))
+          (error "eval: expects (expr env)"))
+        ((not (kernel-env? (nth args 1)))
+          (error "eval: second arg must be a kernel env"))
+        (:else (kernel-eval (first args) (nth args 1)))))))
+
+(define
+  kernel-make-environment-applicative
+  (kernel-make-primitive-applicative
+    (fn
+      (args)
+      (cond
+        ((= (length args) 0) (kernel-make-env))
+        ((= (length args) 1)
+          (cond
+            ((not (kernel-env? (first args)))
+              (error "make-environment: parent must be a kernel env"))
+            (:else (kernel-extend-env (first args)))))
+        (:else (error "make-environment: 0 or 1 argument"))))))
+
+;; ── arithmetic and comparison (binary; trivial to extend later) ─
+
+(define
+  kernel-get-current-env-operative
+  (kernel-make-primitive-operative
+    (fn
+      (args dyn-env)
+      (cond
+        ((not (= (length args) 0))
+          (error "get-current-environment: expects 0 arguments"))
+        (:else dyn-env)))))
+
+(define
+  knl-bin-app
+  (fn
+    (name f)
+    (kernel-make-primitive-applicative
+      (fn
+        (args)
+        (cond
+          ((not (= (length args) 2))
+            (error (str name ": expects 2 arguments")))
+          (:else (f (first args) (nth args 1))))))))
+
+;; Variadic left-fold helper. ZERO-RES is the identity (`(+)` → 0);
+;; ONE-FN handles single-arg case (`(- x)` negates; `(+ x)` returns x).
+(define knl-fold-step
+  (fn (f acc rest-args)
+    (cond
+      ((or (nil? rest-args) (= (length rest-args) 0)) acc)
+      (:else
+        (knl-fold-step f (f acc (first rest-args)) (rest rest-args))))))
+
+(define knl-fold-app
+  (fn (name f zero-res one-fn)
+    (kernel-make-primitive-applicative
+      (fn (args)
+        (cond
+          ((= (length args) 0) zero-res)
+          ((= (length args) 1) (one-fn (first args)))
+          (:else (knl-fold-step f (first args) (rest args))))))))
+
+;; Variadic n-ary chained comparison: `(< 1 2 3)` ≡ `(< 1 2)` AND `(< 2 3)`.
+(define knl-chain-step
+  (fn (cmp prev rest-args)
+    (cond
+      ((or (nil? rest-args) (= (length rest-args) 0)) true)
+      (:else
+        (let ((next (first rest-args)))
+          (cond
+            ((cmp prev next)
+              (knl-chain-step cmp next (rest rest-args)))
+            (:else false)))))))
+
+(define knl-chain-cmp
+  (fn (name cmp)
+    (kernel-make-primitive-applicative
+      (fn (args)
+        (cond
+          ((< (length args) 2)
+            (error (str name ": expects at least 2 arguments")))
+          (:else (knl-chain-step cmp (first args) (rest args))))))))
+
+;; ── list / pair primitives ──────────────────────────────────────
+
+(define
+  knl-unary-app
+  (fn
+    (name f)
+    (kernel-make-primitive-applicative
+      (fn
+        (args)
+        (cond
+          ((not (= (length args) 1))
+            (error (str name ": expects 1 argument")))
+          (:else (f (first args))))))))
+
+(define kernel-cons-applicative (knl-bin-app "cons" (fn (a b) (cons a b))))
+
+(define
+  kernel-car-applicative
+  (knl-unary-app
+    "car"
+    (fn
+      (xs)
+      (cond
+        ((or (nil? xs) (and (list? xs) (= (length xs) 0)))
+          (error "car: empty list"))
+        (:else (first xs))))))
+
+(define
+  kernel-cdr-applicative
+  (knl-unary-app
+    "cdr"
+    (fn
+      (xs)
+      (cond
+        ((or (nil? xs) (and (list? xs) (= (length xs) 0)))
+          (error "cdr: empty list"))
+        (:else (rest xs))))))
+
+(define
+  kernel-list-applicative
+  (kernel-make-primitive-applicative (fn (args) args)))
+
+(define
+  kernel-length-applicative
+  (knl-unary-app "length" (fn (xs) (length xs))))
+
+(define
+  kernel-null?-applicative
+  (knl-unary-app
+    "null?"
+    (fn (v) (or (nil? v) (and (list? v) (= (length v) 0))))))
+
+;; ── boolean / equality ──────────────────────────────────────────
+
+(define
+  kernel-pair?-applicative
+  (knl-unary-app
+    "pair?"
+    (fn (v) (and (list? v) (> (length v) 0)))))
+
+(define knl-append-step
+  (fn (xs ys)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) ys)
+      (:else (cons (first xs) (knl-append-step (rest xs) ys))))))
+
+(define knl-all-lists?
+  (fn (xs)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) true)
+      ((list? (first xs)) (knl-all-lists? (rest xs)))
+      (:else false))))
+
+(define knl-append-all
+  (fn (lists)
+    (cond
+      ((or (nil? lists) (= (length lists) 0)) (list))
+      ((= (length lists) 1) (first lists))
+      (:else
+        (knl-append-step (first lists)
+                         (knl-append-all (rest lists)))))))
+
+(define kernel-append-applicative
+  (kernel-make-primitive-applicative
+    (fn (args)
+      (cond
+        ((knl-all-lists? args) (knl-append-all args))
+        (:else (error "append: all arguments must be lists"))))))
+
+(define knl-reverse-step
+  (fn (xs acc)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) acc)
+      (:else (knl-reverse-step (rest xs) (cons (first xs) acc))))))
+
+(define kernel-reverse-applicative
+  (knl-unary-app "reverse"
+    (fn (xs)
+      (cond
+        ((not (list? xs)) (error "reverse: argument must be a list"))
+        (:else (knl-reverse-step xs (list)))))))
+
+(define kernel-not-applicative (knl-unary-app "not" (fn (v) (not v))))
+
+;; Type predicates (Kernel-visible). Note `string?` covers BOTH symbols
+;; and string-literals in our representation (symbols are bare SX
+;; strings); a `kernel-string?` applicative distinguishes the two if
+;; needed.
+(define kernel-number?-applicative
+  (knl-unary-app "number?" (fn (v) (number? v))))
+(define kernel-string?-applicative
+  (knl-unary-app "string?" (fn (v) (string? v))))
+(define kernel-list?-applicative
+  (knl-unary-app "list?" (fn (v) (list? v))))
+(define kernel-boolean?-applicative
+  (knl-unary-app "boolean?" (fn (v) (boolean? v))))
+(define kernel-symbol?-applicative
+  (knl-unary-app "symbol?" (fn (v) (string? v))))
+
+(define kernel-eq?-applicative (knl-bin-app "eq?" (fn (a b) (= a b))))
+
+;; ── the standard environment ────────────────────────────────────
+
+(define
+  kernel-equal?-applicative
+  (knl-bin-app "equal?" (fn (a b) (= a b))))
+
+;; ── List combinators: map / filter / reduce ─────────────────────
+;; These re-enter the evaluator on each element, so they use the
+;; with-env applicative constructor.
+
+;; When the combiner is an applicative, we MUST unwrap before calling
+;; — otherwise kernel-combine will re-evaluate the already-evaluated
+;; element values (and crash if an element is itself a list).
+(define knl-apply-op
+  (fn (combiner)
+    (cond
+      ((kernel-applicative? combiner) (kernel-unwrap combiner))
+      (:else combiner))))
+
+(define knl-map-step
+  (fn (fn-val xs dyn-env)
+    (let ((op (knl-apply-op fn-val)))
+      (knl-map-walk op xs dyn-env))))
+
+(define knl-map-walk
+  (fn (op xs dyn-env)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) (list))
+      (:else
+        (cons (kernel-combine op (list (first xs)) dyn-env)
+              (knl-map-walk op (rest xs) dyn-env))))))
+
+(define kernel-map-applicative
+  (kernel-make-primitive-applicative-with-env
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 2))
+          (error "map: expects (fn list)"))
+        ((not (kernel-combiner? (first args)))
+          (error "map: first arg must be a combiner"))
+        ((not (list? (nth args 1)))
+          (error "map: second arg must be a list"))
+        (:else (knl-map-step (first args) (nth args 1) dyn-env))))))
+
+(define knl-filter-step
+  (fn (pred xs dyn-env)
+    (knl-filter-walk (knl-apply-op pred) xs dyn-env)))
+
+(define knl-filter-walk
+  (fn (op xs dyn-env)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) (list))
+      (:else
+        (let ((keep? (kernel-combine op (list (first xs)) dyn-env)))
+          (cond
+            (keep?
+              (cons (first xs) (knl-filter-walk op (rest xs) dyn-env)))
+            (:else (knl-filter-walk op (rest xs) dyn-env))))))))
+
+(define kernel-filter-applicative
+  (kernel-make-primitive-applicative-with-env
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 2))
+          (error "filter: expects (pred list)"))
+        ((not (kernel-combiner? (first args)))
+          (error "filter: first arg must be a combiner"))
+        ((not (list? (nth args 1)))
+          (error "filter: second arg must be a list"))
+        (:else (knl-filter-step (first args) (nth args 1) dyn-env))))))
+
+(define knl-reduce-step
+  (fn (fn-val xs acc dyn-env)
+    (knl-reduce-walk (knl-apply-op fn-val) xs acc dyn-env)))
+
+(define knl-reduce-walk
+  (fn (op xs acc dyn-env)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) acc)
+      (:else
+        (knl-reduce-walk
+          op
+          (rest xs)
+          (kernel-combine op (list acc (first xs)) dyn-env)
+          dyn-env)))))
+
+;; (apply COMBINER ARGS-LIST) — call COMBINER with the elements of
+;; ARGS-LIST as arguments. The Kernel canonical use: turn a constructed
+;; list of values into a function call. We skip the applicative's
+;; auto-eval step (via unwrap) because ARGS-LIST is already values, not
+;; expressions; for a bare operative, we pass through directly.
+(define kernel-apply-applicative
+  (kernel-make-primitive-applicative-with-env
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 2))
+          (error "apply: expects (combiner args-list)"))
+        ((not (kernel-combiner? (first args)))
+          (error "apply: first arg must be a combiner"))
+        ((not (list? (nth args 1)))
+          (error "apply: second arg must be a list"))
+        (:else
+          (let ((op (cond
+                      ((kernel-applicative? (first args))
+                        (kernel-unwrap (first args)))
+                      (:else (first args)))))
+            (kernel-combine op (nth args 1) dyn-env)))))))
+
+(define kernel-reduce-applicative
+  (kernel-make-primitive-applicative-with-env
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 3))
+          (error "reduce: expects (fn init list)"))
+        ((not (kernel-combiner? (first args)))
+          (error "reduce: first arg must be a combiner"))
+        ((not (list? (nth args 2)))
+          (error "reduce: third arg must be a list"))
+        (:else
+          (knl-reduce-step (first args) (nth args 2)
+                           (nth args 1) dyn-env))))))
+
+;; ── Encapsulations: Kernel's opaque-type idiom ──────────────────
+;;
+;; (make-encapsulation-type) → (encapsulator predicate decapsulator)
+;;
+;; Each call returns three applicatives over a fresh family identity.
+;; - (encapsulator V) → an opaque wrapper around V.
+;; - (predicate V)    → true iff V was wrapped by THIS family.
+;; - (decapsulator W) → the inner value; errors on wrong family.
+;;
+;; Family identity is a fresh empty dict; SX compares dicts by reference,
+;; so two `(make-encapsulation-type)` calls return distinct families.
+;;
+;; Pattern usage (Phase 5 lacks destructuring, so accessors are explicit):
+;;   ($define! triple (make-encapsulation-type))
+;;   ($define! wrap-promise   (car  triple))
+;;   ($define! promise?       (car  (cdr triple)))
+;;   ($define! unwrap-promise (car  (cdr (cdr triple))))
+
+(define kernel-make-encap-type-impl
+  (fn (args)
+    (cond
+      ((not (= (length args) 0))
+        (error "make-encapsulation-type: expects 0 arguments"))
+      (:else
+        (let ((family {}))
+          (let ((encap
+                  (kernel-make-primitive-applicative
+                    (fn (vargs)
+                      (cond
+                        ((not (= (length vargs) 1))
+                          (error "encapsulator: expects 1 argument"))
+                        (:else
+                          {:knl-tag :encap
+                           :family family
+                           :value (first vargs)})))))
+                (pred
+                  (kernel-make-primitive-applicative
+                    (fn (vargs)
+                      (cond
+                        ((not (= (length vargs) 1))
+                          (error "predicate: expects 1 argument"))
+                        (:else
+                          (let ((v (first vargs)))
+                            (and (dict? v)
+                                 (= (get v :knl-tag) :encap)
+                                 (= (get v :family) family))))))))
+                (decap
+                  (kernel-make-primitive-applicative
+                    (fn (vargs)
+                      (cond
+                        ((not (= (length vargs) 1))
+                          (error "decapsulator: expects 1 argument"))
+                        (:else
+                          (let ((v (first vargs)))
+                            (cond
+                              ((not (and (dict? v)
+                                         (= (get v :knl-tag) :encap)))
+                                (error "decapsulator: not an encapsulation"))
+                              ((not (= (get v :family) family))
+                                (error "decapsulator: wrong family"))
+                              (:else (get v :value))))))))))
+            (list encap pred decap)))))))
+
+(define kernel-make-encap-type-applicative
+  (kernel-make-primitive-applicative kernel-make-encap-type-impl))
+
+;; ── Hygiene: $let, $define-in!, make-environment ────────────────
+;;
+;; Kernel-on-SX is hygienic *by default* because user-defined operatives
+;; (Phase 3) bind their formals + any $define! in a CHILD env extending
+;; the operative's static-env, never the dyn-env. The caller's env is
+;; only mutated when code explicitly says so (e.g. `(eval expr env-arg)`).
+;;
+;; Phase 6 adds two helpers that make the property easy to lean on:
+;;
+;;   ($let ((NAME EXPR) ...) BODY)
+;;     Evaluates each EXPR in the calling env, binds NAME in a fresh
+;;     child env, evaluates BODY in that child env. NAMES don't leak.
+;;
+;;   ($define-in! ENV NAME EXPR)
+;;     Binds NAME=value-of-EXPR in the *specified* env, not the dyn-env.
+;;     Useful for operatives that need to mutate a sandbox env without
+;;     touching their caller's env.
+;;
+;; Shutt's full scope-set / frame-stamp hygiene (lifted symbols carrying
+;; provenance markers so introduced bindings can shadow without
+;; capturing) is research-grade and not implemented here. Notes for
+;; `lib/guest/reflective/hygiene.sx` candidate API below the std env.
+
+(define knl-bind-let-vals!
+  (fn (local bindings dyn-env)
+    (cond
+      ((or (nil? bindings) (= (length bindings) 0)) nil)
+      (:else
+        (let ((b (first bindings)))
+          (cond
+            ((not (and (list? b) (= (length b) 2)))
+              (error "$let: each binding must be (name expr)"))
+            ((not (string? (first b)))
+              (error "$let: binding name must be a symbol"))
+            (:else
+              (begin
+                (kernel-env-bind! local
+                                  (first b)
+                                  (kernel-eval (nth b 1) dyn-env))
+                (knl-bind-let-vals! local (rest bindings) dyn-env)))))))))
+
+(define kernel-let-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((< (length args) 2)
+          (error "$let: expects (bindings body...)"))
+        ((not (list? (first args)))
+          (error "$let: bindings must be a list"))
+        (:else
+          (let ((local (kernel-extend-env dyn-env)))
+            (knl-bind-let-vals! local (first args) dyn-env)
+            (knl-eval-body (rest args) local)))))))
+
+;; $let* — sequential let. Each binding sees prior names in scope.
+;; Implemented by nesting envs one per binding; the body runs in the
+;; innermost env, so later bindings shadow earlier ones if names repeat.
+(define knl-let*-step
+  (fn (bindings env body-forms)
+    (cond
+      ((or (nil? bindings) (= (length bindings) 0))
+        (knl-eval-body body-forms env))
+      (:else
+        (let ((b (first bindings)))
+          (cond
+            ((not (and (list? b) (= (length b) 2)))
+              (error "$let*: each binding must be (name expr)"))
+            ((not (string? (first b)))
+              (error "$let*: binding name must be a symbol"))
+            (:else
+              (let ((child (kernel-extend-env env)))
+                (kernel-env-bind! child
+                                  (first b)
+                                  (kernel-eval (nth b 1) env))
+                (knl-let*-step (rest bindings) child body-forms)))))))))
+
+(define kernel-let*-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((< (length args) 2)
+          (error "$let*: expects (bindings body...)"))
+        ((not (list? (first args)))
+          (error "$let*: bindings must be a list"))
+        (:else
+          (knl-let*-step (first args) dyn-env (rest args)))))))
+
+(define kernel-define-in!-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 3))
+          (error "$define-in!: expects (env-expr name expr)"))
+        ((not (string? (nth args 1)))
+          (error "$define-in!: name must be a symbol"))
+        (:else
+          (let ((target (kernel-eval (first args) dyn-env)))
+            (cond
+              ((not (kernel-env? target))
+                (error "$define-in!: first arg must evaluate to an env"))
+              (:else
+                (let ((v (kernel-eval (nth args 2) dyn-env)))
+                  (kernel-env-bind! target (nth args 1) v)
+                  v)))))))))
+
+(define
+  kernel-standard-env
+  (fn
+    ()
+    (let
+      ((env (kernel-base-env)))
+      (kernel-env-bind! env "$if" kernel-if-operative)
+      (kernel-env-bind! env "$define!" kernel-define!-operative)
+      (kernel-env-bind! env "$sequence" kernel-sequence-operative)
+      (kernel-env-bind! env "$quote"    kernel-quote-operative)
+      (kernel-env-bind! env "$quasiquote" kernel-quasiquote-operative)
+      (kernel-env-bind! env "$cond"   kernel-cond-operative)
+      (kernel-env-bind! env "$when"   kernel-when-operative)
+      (kernel-env-bind! env "$unless" kernel-unless-operative)
+      (kernel-env-bind! env "$and?"   kernel-and?-operative)
+      (kernel-env-bind! env "$or?"    kernel-or?-operative)
+      (kernel-env-bind! env "eval" kernel-eval-applicative)
+      (kernel-env-bind!
+        env
+        "make-environment"
+        kernel-make-environment-applicative)
+      (kernel-env-bind!
+        env
+        "get-current-environment"
+        kernel-get-current-env-operative)
+      (kernel-env-bind! env "+"
+        (knl-fold-app "+" (fn (a b) (+ a b)) 0 (fn (x) x)))
+      (kernel-env-bind! env "-"
+        (knl-fold-app "-" (fn (a b) (- a b)) 0 (fn (x) (- 0 x))))
+      (kernel-env-bind! env "*"
+        (knl-fold-app "*" (fn (a b) (* a b)) 1 (fn (x) x)))
+      (kernel-env-bind! env "/"
+        (knl-fold-app "/" (fn (a b) (/ a b)) 1 (fn (x) (/ 1 x))))
+      (kernel-env-bind! env "<"   (knl-chain-cmp "<"   (fn (a b) (< a b))))
+      (kernel-env-bind! env ">"   (knl-chain-cmp ">"   (fn (a b) (> a b))))
+      (kernel-env-bind! env "<=?" (knl-chain-cmp "<=?" (fn (a b) (<= a b))))
+      (kernel-env-bind! env ">=?" (knl-chain-cmp ">=?" (fn (a b) (>= a b))))
+      (kernel-env-bind! env "=?" kernel-eq?-applicative)
+      (kernel-env-bind! env "equal?" kernel-equal?-applicative)
+      (kernel-env-bind! env "eq?" kernel-eq?-applicative)
+      (kernel-env-bind! env "cons" kernel-cons-applicative)
+      (kernel-env-bind! env "car" kernel-car-applicative)
+      (kernel-env-bind! env "cdr" kernel-cdr-applicative)
+      (kernel-env-bind! env "list" kernel-list-applicative)
+      (kernel-env-bind! env "length" kernel-length-applicative)
+      (kernel-env-bind! env "null?" kernel-null?-applicative)
+      (kernel-env-bind! env "pair?" kernel-pair?-applicative)
+      (kernel-env-bind! env "map"    kernel-map-applicative)
+      (kernel-env-bind! env "filter" kernel-filter-applicative)
+      (kernel-env-bind! env "reduce" kernel-reduce-applicative)
+      (kernel-env-bind! env "apply"   kernel-apply-applicative)
+      (kernel-env-bind! env "append"  kernel-append-applicative)
+      (kernel-env-bind! env "reverse" kernel-reverse-applicative)
+      (kernel-env-bind! env "number?"  kernel-number?-applicative)
+      (kernel-env-bind! env "string?"  kernel-string?-applicative)
+      (kernel-env-bind! env "list?"    kernel-list?-applicative)
+      (kernel-env-bind! env "boolean?" kernel-boolean?-applicative)
+      (kernel-env-bind! env "symbol?"  kernel-symbol?-applicative)
+      (kernel-env-bind! env "not" kernel-not-applicative)
+      (kernel-env-bind! env "make-encapsulation-type"
+                            kernel-make-encap-type-applicative)
+      (kernel-env-bind! env "$let"         kernel-let-operative)
+      (kernel-env-bind! env "$let*"        kernel-let*-operative)
+      (kernel-env-bind! env "$define-in!"  kernel-define-in!-operative)
+      env)))

lib/kernel/tests/encap.sx

@@ -0,0 +1,183 @@
+;; lib/kernel/tests/encap.sx — exercises make-encapsulation-type.
+;;
+;; The Phase 5 Kernel idiom: build opaque types whose constructor,
+;; predicate, and accessor are all standard Kernel applicatives. The
+;; identity is per-call, so two `(make-encapsulation-type)` calls
+;; produce non-interchangeable families.
+
+(define ken-test-pass 0)
+(define ken-test-fail 0)
+(define ken-test-fails (list))
+
+(define
+  ken-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! ken-test-pass (+ ken-test-pass 1))
+      (begin
+        (set! ken-test-fail (+ ken-test-fail 1))
+        (append! ken-test-fails {:name name :actual actual :expected expected})))))
+
+(define ken-eval-in (fn (src env) (kernel-eval (kernel-parse src) env)))
+
+;; A helper that builds a standard env with `encap`/`pred?`/`decap`
+;; bound from a single call to make-encapsulation-type.
+(define
+  ken-make-encap-env
+  (fn
+    ()
+    (let
+      ((env (kernel-standard-env)))
+      (ken-eval-in "($define! triple (make-encapsulation-type))" env)
+      (ken-eval-in "($define! encap (car triple))" env)
+      (ken-eval-in "($define! pred? (car (cdr triple)))" env)
+      (ken-eval-in "($define! decap (car (cdr (cdr triple))))" env)
+      env)))
+
+;; ── construction ────────────────────────────────────────────────
+(ken-test
+  "make: returns 3-element list"
+  (ken-eval-in "(length (make-encapsulation-type))" (kernel-standard-env))
+  3)
+
+(ken-test
+  "make: first is applicative"
+  (kernel-applicative?
+    (ken-eval-in "(car (make-encapsulation-type))" (kernel-standard-env)))
+  true)
+
+(ken-test
+  "make: second is applicative"
+  (kernel-applicative?
+    (ken-eval-in
+      "(car (cdr (make-encapsulation-type)))"
+      (kernel-standard-env)))
+  true)
+
+(ken-test
+  "make: third is applicative"
+  (kernel-applicative?
+    (ken-eval-in
+      "(car (cdr (cdr (make-encapsulation-type))))"
+      (kernel-standard-env)))
+  true)
+
+;; ── round-trip ──────────────────────────────────────────────────
+(ken-test
+  "round-trip: number"
+  (ken-eval-in "(decap (encap 42))" (ken-make-encap-env))
+  42)
+
+(ken-test
+  "round-trip: string"
+  (ken-eval-in "(decap (encap ($quote hello)))" (ken-make-encap-env))
+  "hello")
+
+(ken-test
+  "round-trip: list"
+  (ken-eval-in "(decap (encap (list 1 2 3)))" (ken-make-encap-env))
+  (list 1 2 3))
+
+;; ── predicate ───────────────────────────────────────────────────
+(ken-test
+  "pred?: wrapped value"
+  (ken-eval-in "(pred? (encap 1))" (ken-make-encap-env))
+  true)
+
+(ken-test
+  "pred?: raw value"
+  (ken-eval-in "(pred? 1)" (ken-make-encap-env))
+  false)
+
+(ken-test
+  "pred?: raw string"
+  (ken-eval-in "(pred? ($quote foo))" (ken-make-encap-env))
+  false)
+
+(ken-test
+  "pred?: raw list"
+  (ken-eval-in "(pred? (list))" (ken-make-encap-env))
+  false)
+
+;; ── opacity: different families are not interchangeable ─────────
+(ken-test
+  "opacity: foreign value rejected by predicate"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in "($define! tA (make-encapsulation-type))" env)
+    (ken-eval-in "($define! tB (make-encapsulation-type))" env)
+    (ken-eval-in "($define! encA (car tA))" env)
+    (ken-eval-in "($define! predB (car (cdr tB)))" env)
+    (ken-eval-in "(predB (encA 42))" env))
+  false)
+
+(ken-test
+  "opacity: decap rejects foreign value"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in "($define! tA (make-encapsulation-type))" env)
+    (ken-eval-in "($define! tB (make-encapsulation-type))" env)
+    (ken-eval-in "($define! encA (car tA))" env)
+    (ken-eval-in "($define! decapB (car (cdr (cdr tB))))" env)
+    (guard (e (true :raised)) (ken-eval-in "(decapB (encA 42))" env)))
+  :raised)
+
+(ken-test
+  "opacity: decap rejects raw value"
+  (guard
+    (e (true :raised))
+    (ken-eval-in "(decap 42)" (ken-make-encap-env)))
+  :raised)
+
+;; ── promise: classic Kernel encapsulation use case ──────────────
+;; A "promise" wraps a thunk to compute on demand and memoises the
+;; first result. Built entirely with the standard encap idiom.
+(ken-test
+  "promise: force returns thunk result"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in
+      "($sequence\n         ($define! ptriple (make-encapsulation-type))\n         ($define! make-promise (car ptriple))\n         ($define! promise? (car (cdr ptriple)))\n         ($define! decode-promise (car (cdr (cdr ptriple))))\n         ($define! force ($lambda (p) ((decode-promise p))))\n         ($define! delay ($lambda (thunk) (make-promise thunk)))\n         (force (delay ($lambda () (+ 19 23)))))"
+      env))
+  42)
+
+(ken-test
+  "promise: promise? recognises its own type"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in
+      "($sequence\n         ($define! ptriple (make-encapsulation-type))\n         ($define! make-promise (car ptriple))\n         ($define! promise? (car (cdr ptriple)))\n         (promise? (make-promise ($lambda () 42))))"
+      env))
+  true)
+
+(ken-test
+  "promise: promise? false on plain value"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in
+      "($sequence\n         ($define! ptriple (make-encapsulation-type))\n         ($define! promise? (car (cdr ptriple)))\n         (promise? 99))"
+      env))
+  false)
+
+;; ── independent families don't leak ─────────────────────────────
+(ken-test
+  "two families: distinct identity"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in
+      "($sequence\n         ($define! t1 (make-encapsulation-type))\n         ($define! t2 (make-encapsulation-type))\n         ($define! enc1 (car t1))\n         ($define! pred2 (car (cdr t2)))\n         (pred2 (enc1 ($quote stuff))))"
+      env))
+  false)
+
+(ken-test
+  "same family: re-bound shares identity"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in
+      "($sequence\n         ($define! t (make-encapsulation-type))\n         ($define! e (car t))\n         ($define! p (car (cdr t)))\n         ($define! d (car (cdr (cdr t))))\n         (list (p (e 7)) (d (e 7))))"
+      env))
+  (list true 7))
+
+(define ken-tests-run! (fn () {:total (+ ken-test-pass ken-test-fail) :passed ken-test-pass :failed ken-test-fail :fails ken-test-fails}))

lib/kernel/tests/eval.sx

@@ -0,0 +1,270 @@
+;; lib/kernel/tests/eval.sx — exercises lib/kernel/eval.sx.
+;;
+;; Phase 2 covers literal evaluation, symbol lookup, and combiner
+;; dispatch (operative vs applicative). Standard-environment operatives
+;; ($if, $define!, $lambda, …) arrive in Phase 4, so tests build a
+;; minimal env on the fly and verify the dispatch contract directly.
+
+(define ke-test-pass 0)
+(define ke-test-fail 0)
+(define ke-test-fails (list))
+
+(define
+  ke-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! ke-test-pass (+ ke-test-pass 1))
+      (begin
+        (set! ke-test-fail (+ ke-test-fail 1))
+        (append! ke-test-fails {:name name :actual actual :expected expected})))))
+
+;; ── helpers ──────────────────────────────────────────────────────
+
+(define ke-eval-src (fn (src env) (kernel-eval (kernel-parse src) env)))
+
+(define
+  ke-make-test-env
+  (fn
+    ()
+    (let
+      ((env (kernel-make-env)))
+      (kernel-env-bind!
+        env
+        "+"
+        (kernel-make-primitive-applicative
+          (fn (args) (+ (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "list"
+        (kernel-make-primitive-applicative (fn (args) args)))
+      (kernel-env-bind!
+        env
+        "$quote"
+        (kernel-make-primitive-operative (fn (args dyn-env) (first args))))
+      (kernel-env-bind!
+        env
+        "$if"
+        (kernel-make-primitive-operative
+          (fn
+            (args dyn-env)
+            (if
+              (kernel-eval (first args) dyn-env)
+              (kernel-eval (nth args 1) dyn-env)
+              (kernel-eval (nth args 2) dyn-env)))))
+      env)))
+
+;; ── literal evaluation ───────────────────────────────────────────
+(ke-test "lit: number" (ke-eval-src "42" (kernel-make-env)) 42)
+(ke-test "lit: zero" (ke-eval-src "0" (kernel-make-env)) 0)
+(ke-test "lit: float" (ke-eval-src "3.14" (kernel-make-env)) 3.14)
+(ke-test "lit: true" (ke-eval-src "#t" (kernel-make-env)) true)
+(ke-test "lit: false" (ke-eval-src "#f" (kernel-make-env)) false)
+(ke-test "lit: string" (ke-eval-src "\"hello\"" (kernel-make-env)) "hello")
+(ke-test "lit: empty list" (ke-eval-src "()" (kernel-make-env)) (list))
+
+;; ── symbol lookup ────────────────────────────────────────────────
+(ke-test
+  "sym: bound to number"
+  (let
+    ((env (kernel-make-env)))
+    (kernel-env-bind! env "x" 100)
+    (ke-eval-src "x" env))
+  100)
+
+(ke-test
+  "sym: bound to string"
+  (let
+    ((env (kernel-make-env)))
+    (kernel-env-bind! env "name" "kernel")
+    (ke-eval-src "name" env))
+  "kernel")
+
+(ke-test
+  "sym: parent-chain lookup"
+  (let
+    ((p (kernel-make-env)))
+    (kernel-env-bind! p "outer" 1)
+    (let
+      ((c (kernel-extend-env p)))
+      (kernel-env-bind! c "inner" 2)
+      (+ (ke-eval-src "outer" c) (ke-eval-src "inner" c))))
+  3)
+
+(ke-test
+  "sym: child shadows parent"
+  (let
+    ((p (kernel-make-env)))
+    (kernel-env-bind! p "x" 1)
+    (let
+      ((c (kernel-extend-env p)))
+      (kernel-env-bind! c "x" 2)
+      (ke-eval-src "x" c)))
+  2)
+
+(ke-test
+  "env-has?: present"
+  (let
+    ((env (kernel-make-env)))
+    (kernel-env-bind! env "x" 1)
+    (kernel-env-has? env "x"))
+  true)
+
+(ke-test
+  "env-has?: missing"
+  (kernel-env-has? (kernel-make-env) "nope")
+  false)
+
+;; ── tagged-value predicates ─────────────────────────────────────
+(ke-test
+  "tag: operative?"
+  (kernel-operative? (kernel-make-primitive-operative (fn (a e) nil)))
+  true)
+
+(ke-test
+  "tag: applicative?"
+  (kernel-applicative? (kernel-make-primitive-applicative (fn (a) nil)))
+  true)
+
+(ke-test
+  "tag: combiner? operative"
+  (kernel-combiner? (kernel-make-primitive-operative (fn (a e) nil)))
+  true)
+
+(ke-test
+  "tag: combiner? applicative"
+  (kernel-combiner? (kernel-make-primitive-applicative (fn (a) nil)))
+  true)
+
+(ke-test "tag: combiner? number" (kernel-combiner? 42) false)
+
+(ke-test "tag: number is not operative" (kernel-operative? 42) false)
+
+;; ── wrap / unwrap ────────────────────────────────────────────────
+(ke-test
+  "wrap+unwrap roundtrip"
+  (let
+    ((op (kernel-make-primitive-operative (fn (a e) :sentinel))))
+    (= (kernel-unwrap (kernel-wrap op)) op))
+  true)
+
+(ke-test
+  "wrap produces applicative"
+  (kernel-applicative?
+    (kernel-wrap (kernel-make-primitive-operative (fn (a e) nil))))
+  true)
+
+(ke-test
+  "unwrap of primitive-applicative is operative"
+  (kernel-operative?
+    (kernel-unwrap (kernel-make-primitive-applicative (fn (a) nil))))
+  true)
+
+;; ── combiner dispatch — applicatives evaluate their args ─────────
+(ke-test
+  "applicative: simple call"
+  (ke-eval-src "(+ 2 3)" (ke-make-test-env))
+  5)
+
+(ke-test
+  "applicative: nested"
+  (ke-eval-src "(+ (+ 1 2) (+ 3 4))" (ke-make-test-env))
+  10)
+
+(ke-test
+  "applicative: receives evaluated args"
+  (let
+    ((env (ke-make-test-env)))
+    (kernel-env-bind! env "x" 10)
+    (kernel-env-bind! env "y" 20)
+    (ke-eval-src "(+ x y)" env))
+  30)
+
+(ke-test
+  "applicative: list builds an SX list of values"
+  (let
+    ((env (ke-make-test-env)))
+    (kernel-env-bind! env "a" 1)
+    (kernel-env-bind! env "b" 2)
+    (ke-eval-src "(list a b 99)" env))
+  (list 1 2 99))
+
+;; ── combiner dispatch — operatives DO NOT evaluate their args ───
+(ke-test
+  "operative: $quote returns symbol unevaluated"
+  (ke-eval-src "($quote foo)" (ke-make-test-env))
+  "foo")
+
+(ke-test
+  "operative: $quote returns list unevaluated"
+  (ke-eval-src "($quote (+ 1 2))" (ke-make-test-env))
+  (list "+" 1 2))
+
+(ke-test
+  "operative: $if true branch"
+  (ke-eval-src "($if #t 1 2)" (ke-make-test-env))
+  1)
+
+(ke-test
+  "operative: $if false branch"
+  (ke-eval-src "($if #f 1 2)" (ke-make-test-env))
+  2)
+
+(ke-test
+  "operative: $if doesn't eval untaken branch"
+  (ke-eval-src "($if #t 99 unbound)" (ke-make-test-env))
+  99)
+
+(ke-test
+  "operative: $if takes dynamic env for branches"
+  (let
+    ((env (ke-make-test-env)))
+    (kernel-env-bind! env "x" 7)
+    (ke-eval-src "($if #t x 0)" env))
+  7)
+
+;; ── operative built ON-THE-FLY can inspect raw expressions ──────
+(ke-test
+  "operative: sees raw symbol head"
+  (let
+    ((env (kernel-make-env)))
+    (kernel-env-bind!
+      env
+      "head"
+      (kernel-make-primitive-operative (fn (args dyn-env) (first args))))
+    (ke-eval-src "(head (+ 1 2))" env))
+  (list "+" 1 2))
+
+(ke-test
+  "operative: sees dynamic env"
+  (let
+    ((env (kernel-make-env)))
+    (kernel-env-bind! env "x" 999)
+    (kernel-env-bind!
+      env
+      "$probe"
+      (kernel-make-primitive-operative
+        (fn (args dyn-env) (kernel-env-lookup dyn-env "x"))))
+    (ke-eval-src "($probe ignored)" env))
+  999)
+
+;; ── error cases ──────────────────────────────────────────────────
+(ke-test
+  "error: unbound symbol"
+  (guard
+    (e (true :raised))
+    (kernel-eval (kernel-parse "nope") (kernel-make-env)))
+  :raised)
+
+(ke-test
+  "error: combine non-combiner"
+  (guard
+    (e (true :raised))
+    (let
+      ((env (kernel-make-env)))
+      (kernel-env-bind! env "x" 42)
+      (kernel-eval (kernel-parse "(x 1)") env)))
+  :raised)
+
+(define ke-tests-run! (fn () {:total (+ ke-test-pass ke-test-fail) :passed ke-test-pass :failed ke-test-fail :fails ke-test-fails}))

lib/kernel/tests/hygiene.sx

@@ -0,0 +1,220 @@
+;; lib/kernel/tests/hygiene.sx — exercises Phase 6 hygiene helpers.
+;;
+;; Kernel-on-SX is hygienic by default: $vau/$lambda close over their
+;; static env, and bind their formals (plus any $define!s in the body)
+;; in a CHILD env. The caller's env is only mutated when user code
+;; explicitly threads the env-param through `eval` or `$define-in!`.
+;;
+;; These tests verify the property, plus the Phase 6 helpers ($let and
+;; $define-in!). Shutt's full scope-set hygiene (lifted symbols with
+;; provenance markers) is research-grade and is NOT implemented — see
+;; the plan's reflective-API notes for the proposed approach.
+
+(define kh-test-pass 0)
+(define kh-test-fail 0)
+(define kh-test-fails (list))
+
+(define
+  kh-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! kh-test-pass (+ kh-test-pass 1))
+      (begin
+        (set! kh-test-fail (+ kh-test-fail 1))
+        (append! kh-test-fails {:name name :actual actual :expected expected})))))
+
+(define kh-eval-in (fn (src env) (kernel-eval (kernel-parse src) env)))
+
+;; ── Default hygiene: $define! inside operative body stays local ─
+
+(kh-test
+  "hygiene: vau body $define! doesn't escape"
+  (let
+    ((env (kernel-standard-env)))
+    (kh-eval-in "($define! x 1)" env)
+    (kh-eval-in
+      "($define! my-op ($vau () _ ($sequence ($define! x 999) x)))"
+      env)
+    (kh-eval-in "(my-op)" env)
+    (kh-eval-in "x" env))
+  1)
+
+(kh-test
+  "hygiene: vau body $define! visible inside body"
+  (let
+    ((env (kernel-standard-env)))
+    (kh-eval-in "($define! x 1)" env)
+    (kh-eval-in
+      "($define! my-op ($vau () _ ($sequence ($define! x 999) x)))"
+      env)
+    (kh-eval-in "(my-op)" env))
+  999)
+
+(kh-test
+  "hygiene: lambda body $define! doesn't escape"
+  (let
+    ((env (kernel-standard-env)))
+    (kh-eval-in "($define! y 50)" env)
+    (kh-eval-in "($define! f ($lambda () ($sequence ($define! y 7) y)))" env)
+    (kh-eval-in "(f)" env)
+    (kh-eval-in "y" env))
+  50)
+
+(kh-test
+  "hygiene: caller's binding visible inside operative"
+  (let
+    ((env (kernel-standard-env)))
+    (kh-eval-in "($define! caller-x 88)" env)
+    (kh-eval-in "($define! my-op ($vau () _ caller-x))" env)
+    (kh-eval-in "(my-op)" env))
+  88)
+
+;; ── $let — proper hygienic scoping ──────────────────────────────
+
+(kh-test
+  "let: returns body value"
+  (kh-eval-in "($let ((x 5)) (+ x 1))" (kernel-standard-env))
+  6)
+
+(kh-test
+  "let: multiple bindings"
+  (kh-eval-in "($let ((x 3) (y 4)) (+ x y))" (kernel-standard-env))
+  7)
+
+(kh-test
+  "let: bindings shadow outer"
+  (let
+    ((env (kernel-standard-env)))
+    (kh-eval-in "($define! x 1)" env)
+    (kh-eval-in "($let ((x 99)) x)" env))
+  99)
+
+(kh-test
+  "let: bindings don't leak after"
+  (let
+    ((env (kernel-standard-env)))
+    (kh-eval-in "($define! x 1)" env)
+    (kh-eval-in "($let ((x 99)) x)" env)
+    (kh-eval-in "x" env))
+  1)
+
+(kh-test
+  "let: parallel — RHS sees outer, not inner"
+  (let
+    ((env (kernel-standard-env)))
+    (kh-eval-in "($define! x 1)" env)
+    (kh-eval-in "($let ((x 10) (y x)) y)" env))
+  1)
+
+(kh-test
+  "let: nested"
+  (kh-eval-in "($let ((x 1)) ($let ((y 2)) (+ x y)))" (kernel-standard-env))
+  3)
+
+(kh-test
+  "let: error on malformed binding"
+  (guard
+    (e (true :raised))
+    (kh-eval-in "($let ((x)) x)" (kernel-standard-env)))
+  :raised)
+
+(kh-test
+  "let: error on non-symbol name"
+  (guard
+    (e (true :raised))
+    (kh-eval-in "($let ((1 2)) 1)" (kernel-standard-env)))
+  :raised)
+
+;; ── $define-in! — explicit env targeting ────────────────────────
+
+(kh-test
+  "define-in!: binds in chosen env, not dyn-env"
+  (let
+    ((env (kernel-standard-env)))
+    (kh-eval-in "($define! sandbox (make-environment))" env)
+    (kh-eval-in "($define-in! sandbox z 77)" env)
+    (kernel-env-has? (kh-eval-in "sandbox" env) "z"))
+  true)
+
+(kh-test
+  "define-in!: doesn't pollute caller"
+  (let
+    ((env (kernel-standard-env)))
+    (kh-eval-in "($define! sandbox (make-environment))" env)
+    (kh-eval-in "($define-in! sandbox z 77)" env)
+    (kernel-env-has? env "z"))
+  false)
+
+(kh-test
+  "define-in!: error on non-env target"
+  (guard
+    (e (true :raised))
+    (let
+      ((env (kernel-standard-env)))
+      (kh-eval-in "($define-in! 42 x 1)" env)))
+  :raised)
+
+;; ── Closure does NOT see post-definition caller binds ───────────
+;; The classic "lexical scope wins over dynamic" test.
+
+(kh-test
+  "lexical: closure sees its own static env"
+  (let
+    ((env (kernel-standard-env)))
+    (kh-eval-in "($define! x 1)" env)
+    (kh-eval-in "($define! get-x ($lambda () x))" env)
+    (kh-eval-in "($define! x 999)" env)
+    (kh-eval-in "(get-x)" env))
+  999)
+
+(kh-test
+  "lexical: $let-bound name invisible outside"
+  (guard
+    (e (true :raised))
+    (let
+      ((env (kernel-standard-env)))
+      (kh-eval-in "($let ((private 42)) private)" env)
+      (kh-eval-in "private" env)))
+  :raised)
+
+;; ── Operative + $let: hygiene compose ───────────────────────────
+
+(kh-test
+  "let-inside-vau: temp doesn't escape body"
+  (let
+    ((env (kernel-standard-env)))
+    (kh-eval-in "($define! x 1)" env)
+    (kh-eval-in "($define! op ($vau () _ ($let ((x 5)) x)))" env)
+    (kh-eval-in "(op)" env)
+    (kh-eval-in "x" env))
+  1)
+
+;; ── $let* — sequential let ──────────────────────────────────────
+(kh-test "let*: empty bindings"
+  (kh-eval-in "($let* () 42)" (kernel-standard-env)) 42)
+(kh-test "let*: single binding"
+  (kh-eval-in "($let* ((x 5)) (+ x 1))" (kernel-standard-env)) 6)
+(kh-test "let*: later sees earlier"
+  (kh-eval-in "($let* ((x 1) (y (+ x 1)) (z (+ y 1))) z)"
+              (kernel-standard-env)) 3)
+(kh-test "let*: bindings don't leak after"
+  (let ((env (kernel-standard-env)))
+    (kh-eval-in "($define! x 1)" env)
+    (kh-eval-in "($let* ((x 99) (y (+ x 1))) y)" env)
+    (kh-eval-in "x" env)) 1)
+(kh-test "let*: same-name later binding shadows earlier"
+  (kh-eval-in "($let* ((x 1) (x 2)) x)" (kernel-standard-env)) 2)
+(kh-test "let*: multi-expression body"
+  (kh-eval-in "($let* ((x 5)) ($define! double (+ x x)) double)"
+              (kernel-standard-env)) 10)
+(kh-test "let*: error on malformed binding"
+  (guard (e (true :raised))
+    (kh-eval-in "($let* ((x)) x)" (kernel-standard-env)))
+  :raised)
+(kh-test "let: multi-body"
+  (kh-eval-in "($let ((x 5)) ($define! tmp (+ x 1)) tmp)"
+              (kernel-standard-env)) 6)
+
+(define kh-tests-run! (fn () {:total (+ kh-test-pass kh-test-fail) :passed kh-test-pass :failed kh-test-fail :fails kh-test-fails}))

lib/kernel/tests/metacircular.sx

@@ -0,0 +1,162 @@
+;; lib/kernel/tests/metacircular.sx — Kernel-in-Kernel demo.
+;;
+;; Demonstrates reflective completeness: a Kernel program implements
+;; a recognisable subset of Kernel's own evaluation rules and produces
+;; matching values for a battery of test programs.
+;;
+;; This is a SHALLOW metacircular: it dispatches on expression shape
+;; itself (numbers, booleans, lists, symbols), recursively meta-evals
+;; each argument of an applicative call, and delegates only to the
+;; host evaluator for the leaf cases (operatives, symbol lookup). The
+;; point is to show that env-as-value, first-class operatives, and
+;; first-class evaluators all line up — enough so a Kernel program
+;; can itself reason about Kernel programs.
+
+(define kmc-test-pass 0)
+(define kmc-test-fail 0)
+(define kmc-test-fails (list))
+
+(define
+  kmc-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! kmc-test-pass (+ kmc-test-pass 1))
+      (begin
+        (set! kmc-test-fail (+ kmc-test-fail 1))
+        (append! kmc-test-fails {:name name :actual actual :expected expected})))))
+
+;; Build a Kernel env with m-eval and m-apply defined. The two refer
+;; to each other and to standard primitives, so we use the standard
+;; env as the static-env for both.
+(define
+  kmc-make-env
+  (fn
+    ()
+    (let
+      ((env (kernel-standard-env)))
+      (kernel-eval
+        (kernel-parse
+          "($define! m-eval\n           ($lambda (expr env)\n             ($cond\n               ((number? expr) expr)\n               ((boolean? expr) expr)\n               ((null? expr) expr)\n               ((symbol? expr) (eval expr env))\n               ((list? expr)\n                 ($let ((head-val (m-eval (car expr) env)))\n                   ($cond\n                     ((applicative? head-val)\n                       (apply head-val\n                         (map ($lambda (a) (m-eval a env)) (cdr expr))))\n                     (else (eval expr env)))))\n               (else expr))))")
+        env)
+      env)))
+
+(define
+  kmc-eval
+  (fn
+    (src)
+    (let
+      ((env (kmc-make-env)))
+      (kernel-eval
+        (kernel-parse
+          (str "(m-eval (quote " src ") (get-current-environment))"))
+        env))))
+
+;; ── literals self-evaluate via m-eval ──────────────────────────
+(kmc-test
+  "m-eval: integer literal"
+  (kernel-eval
+    (kernel-parse "(m-eval 42 (get-current-environment))")
+    (kmc-make-env))
+  42)
+
+(kmc-test
+  "m-eval: boolean true"
+  (kernel-eval
+    (kernel-parse "(m-eval #t (get-current-environment))")
+    (kmc-make-env))
+  true)
+
+(kmc-test
+  "m-eval: boolean false"
+  (kernel-eval
+    (kernel-parse "(m-eval #f (get-current-environment))")
+    (kmc-make-env))
+  false)
+
+(kmc-test
+  "m-eval: empty list"
+  (kernel-eval
+    (kernel-parse "(m-eval () (get-current-environment))")
+    (kmc-make-env))
+  (list))
+
+;; ── symbol lookup goes through env ─────────────────────────────
+(kmc-test
+  "m-eval: symbol lookup"
+  (let
+    ((env (kmc-make-env)))
+    (kernel-eval (kernel-parse "($define! shared-x 99)") env)
+    (kernel-eval
+      (kernel-parse "(m-eval ($quote shared-x) (get-current-environment))")
+      env))
+  99)
+
+;; ── applicative calls are dispatched by m-eval recursively ─────
+(kmc-test
+  "m-eval: addition"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote (+ 1 2)) (get-current-environment))")
+    (kmc-make-env))
+  3)
+
+(kmc-test
+  "m-eval: nested arithmetic"
+  (kernel-eval
+    (kernel-parse
+      "(m-eval ($quote (+ (* 2 3) (- 10 4))) (get-current-environment))")
+    (kmc-make-env))
+  12)
+
+(kmc-test
+  "m-eval: variadic +"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote (+ 1 2 3 4 5)) (get-current-environment))")
+    (kmc-make-env))
+  15)
+
+(kmc-test
+  "m-eval: list construction"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote (list 1 2 3)) (get-current-environment))")
+    (kmc-make-env))
+  (list 1 2 3))
+
+(kmc-test "m-eval: cons reverse-style"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote (cons 0 (list 1 2))) (get-current-environment))")
+    (kmc-make-env)) (list 0 1 2))
+
+(kmc-test "m-eval: nested apply"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote (apply + (list 10 20 30))) (get-current-environment))")
+    (kmc-make-env)) 60)
+
+;; ── operatives delegate to host eval (transparently for the caller) ─
+(kmc-test
+  "m-eval: $if true branch (via delegation)"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote ($if #t 1 2)) (get-current-environment))")
+    (kmc-make-env))
+  1)
+
+(kmc-test
+  "m-eval: $if false branch"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote ($if #f 1 2)) (get-current-environment))")
+    (kmc-make-env))
+  2)
+
+;; ── m-eval can call a user-defined lambda ──────────────────────
+(kmc-test
+  "m-eval: user lambda call"
+  (let
+    ((env (kmc-make-env)))
+    (kernel-eval (kernel-parse "($define! sq ($lambda (x) (* x x)))") env)
+    (kernel-eval
+      (kernel-parse "(m-eval ($quote (sq 7)) (get-current-environment))")
+      env))
+  49)
+
+(define kmc-tests-run! (fn () {:total (+ kmc-test-pass kmc-test-fail) :passed kmc-test-pass :failed kmc-test-fail :fails kmc-test-fails}))

lib/kernel/tests/parse.sx

@@ -0,0 +1,158 @@
+;; lib/kernel/tests/parse.sx — exercises lib/kernel/parser.sx.
+
+(define knl-test-pass 0)
+(define knl-test-fail 0)
+(define knl-test-fails (list))
+
+(define
+  knl-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! knl-test-pass (+ knl-test-pass 1))
+      (begin
+        (set! knl-test-fail (+ knl-test-fail 1))
+        (append! knl-test-fails {:name name :actual actual :expected expected})))))
+
+;; ── atoms: numbers ────────────────────────────────────────────────
+(knl-test "num: integer" (kernel-parse "42") 42)
+(knl-test "num: zero" (kernel-parse "0") 0)
+(knl-test "num: negative integer" (kernel-parse "-7") -7)
+(knl-test "num: positive sign" (kernel-parse "+5") 5)
+(knl-test "num: float" (kernel-parse "3.14") 3.14)
+(knl-test "num: negative float" (kernel-parse "-2.5") -2.5)
+(knl-test "num: leading dot" (kernel-parse ".5") 0.5)
+(knl-test "num: exponent" (kernel-parse "1e3") 1000)
+(knl-test "num: exponent with sign" (kernel-parse "2.5e-1") 0.25)
+(knl-test "num: capital E exponent" (kernel-parse "1E2") 100)
+
+;; ── atoms: booleans ───────────────────────────────────────────────
+(knl-test "bool: true" (kernel-parse "#t") true)
+(knl-test "bool: false" (kernel-parse "#f") false)
+
+;; ── atoms: empty list (Kernel nil) ────────────────────────────────
+(knl-test "nil: ()" (kernel-parse "()") (list))
+(knl-test "nil: (= () (list))" (= (kernel-parse "()") (list)) true)
+
+;; ── atoms: symbols ────────────────────────────────────────────────
+(knl-test "sym: word" (kernel-parse "foo") "foo")
+(knl-test "sym: hyphenated" (kernel-parse "foo-bar") "foo-bar")
+(knl-test "sym: dollar-bang" (kernel-parse "$define!") "$define!")
+(knl-test "sym: question" (kernel-parse "null?") "null?")
+(knl-test "sym: lt-eq" (kernel-parse "<=") "<=")
+(knl-test "sym: bare plus" (kernel-parse "+") "+")
+(knl-test "sym: bare minus" (kernel-parse "-") "-")
+(knl-test "sym: plus-letter" (kernel-parse "+a") "+a")
+(knl-test "sym: arrow" (kernel-parse "->") "->")
+(knl-test "sym: dot-prefixed" (kernel-parse ".foo") ".foo")
+
+;; ── atoms: strings ────────────────────────────────────────────────
+(knl-test "str: empty" (kernel-string-value (kernel-parse "\"\"")) "")
+(knl-test
+  "str: hello"
+  (kernel-string-value (kernel-parse "\"hello\""))
+  "hello")
+(knl-test "str: predicate" (kernel-string? (kernel-parse "\"x\"")) true)
+(knl-test "str: not symbol" (kernel-string? (kernel-parse "x")) false)
+(knl-test
+  "str: escape newline"
+  (kernel-string-value (kernel-parse "\"a\\nb\""))
+  "a\nb")
+(knl-test
+  "str: escape tab"
+  (kernel-string-value (kernel-parse "\"a\\tb\""))
+  "a\tb")
+(knl-test
+  "str: escape quote"
+  (kernel-string-value (kernel-parse "\"a\\\"b\""))
+  "a\"b")
+(knl-test
+  "str: escape backslash"
+  (kernel-string-value (kernel-parse "\"a\\\\b\""))
+  "a\\b")
+
+;; ── lists ─────────────────────────────────────────────────────────
+(knl-test "list: flat" (kernel-parse "(a b c)") (list "a" "b" "c"))
+(knl-test
+  "list: nested"
+  (kernel-parse "(a (b c) d)")
+  (list "a" (list "b" "c") "d"))
+(knl-test
+  "list: deeply nested"
+  (kernel-parse "(((x)))")
+  (list (list (list "x"))))
+(knl-test
+  "list: mixed atoms"
+  (kernel-parse "(1 #t foo)")
+  (list 1 true "foo"))
+(knl-test
+  "list: empty inside"
+  (kernel-parse "(a () b)")
+  (list "a" (list) "b"))
+
+;; ── whitespace + comments ─────────────────────────────────────────
+(knl-test "ws: leading" (kernel-parse "   42") 42)
+(knl-test "ws: trailing" (kernel-parse "42   ") 42)
+(knl-test "ws: tabs/newlines" (kernel-parse "\n\t  42 \n") 42)
+(knl-test "comment: line" (kernel-parse "; nope\n42") 42)
+(knl-test "comment: trailing" (kernel-parse "42 ; tail") 42)
+(knl-test
+  "comment: inside list"
+  (kernel-parse "(a ; mid\n  b)")
+  (list "a" "b"))
+
+;; ── parse-all ─────────────────────────────────────────────────────
+(knl-test "all: empty input" (kernel-parse-all "") (list))
+(knl-test "all: only whitespace" (kernel-parse-all "   ") (list))
+(knl-test "all: only comment" (kernel-parse-all "; nope") (list))
+(knl-test
+  "all: three forms"
+  (kernel-parse-all "1 2 3")
+  (list 1 2 3))
+(knl-test
+  "all: mixed"
+  (kernel-parse-all "($if #t 1 2) foo")
+  (list (list "$if" true 1 2) "foo"))
+
+;; ── classic Kernel programs (smoke) ───────────────────────────────
+(knl-test
+  "klisp: vau form"
+  (kernel-parse "($vau (x e) e (eval x e))")
+  (list "$vau" (list "x" "e") "e" (list "eval" "x" "e")))
+(knl-test
+  "klisp: define lambda"
+  (kernel-parse "($define! sq ($lambda (x) (* x x)))")
+  (list "$define!" "sq" (list "$lambda" (list "x") (list "*" "x" "x"))))
+
+;; ── round-trip identity for primitive symbols ─────────────────────
+(knl-test "identity: $vau" (kernel-parse "$vau") "$vau")
+(knl-test "identity: $lambda" (kernel-parse "$lambda") "$lambda")
+(knl-test "identity: wrap" (kernel-parse "wrap") "wrap")
+(knl-test "identity: unwrap" (kernel-parse "unwrap") "unwrap")
+
+;; ── reader macros ─────────────────────────────────────────────────
+(knl-test "reader: 'foo  → ($quote foo)"
+  (kernel-parse "'foo") (list "$quote" "foo"))
+(knl-test "reader: '(a b c)"
+  (kernel-parse "'(a b c)") (list "$quote" (list "a" "b" "c")))
+(knl-test "reader: nested quotes"
+  (kernel-parse "''x")
+  (list "$quote" (list "$quote" "x")))
+(knl-test "reader: ` quasiquote"
+  (kernel-parse "`x") (list "$quasiquote" "x"))
+(knl-test "reader: , unquote"
+  (kernel-parse ",x") (list "$unquote" "x"))
+(knl-test "reader: ,@ unquote-splicing"
+  (kernel-parse ",@x") (list "$unquote-splicing" "x"))
+(knl-test "reader: quasi-mix"
+  (kernel-parse "`(a ,b ,@c)")
+  (list "$quasiquote"
+        (list "a"
+              (list "$unquote" "b")
+              (list "$unquote-splicing" "c"))))
+(knl-test "reader: quote separates from neighbouring atom"
+  (kernel-parse "(a 'b c)")
+  (list "a" (list "$quote" "b") "c"))
+
+(define knl-tests-run! (fn () {:total (+ knl-test-pass knl-test-fail) :passed knl-test-pass :failed knl-test-fail :fails knl-test-fails}))

lib/kernel/tests/standard.sx

@@ -0,0 +1,445 @@
+;; lib/kernel/tests/standard.sx — exercises the Kernel standard env.
+;;
+;; Phase 4 tests verify that the standard env is rich enough to run
+;; classic Kernel programs: factorial via recursion, list operations,
+;; first-class environment manipulation. Each test starts from a fresh
+;; standard env via `(kernel-standard-env)`.
+
+(define ks-test-pass 0)
+(define ks-test-fail 0)
+(define ks-test-fails (list))
+
+(define
+  ks-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! ks-test-pass (+ ks-test-pass 1))
+      (begin
+        (set! ks-test-fail (+ ks-test-fail 1))
+        (append! ks-test-fails {:name name :actual actual :expected expected})))))
+
+(define
+  ks-eval
+  (fn (src) (kernel-eval (kernel-parse src) (kernel-standard-env))))
+
+(define ks-eval-in (fn (src env) (kernel-eval (kernel-parse src) env)))
+
+(define
+  ks-eval-all
+  (fn (src env) (kernel-eval-program (kernel-parse-all src) env)))
+
+;; ── $if ──────────────────────────────────────────────────────────
+(ks-test "if: true branch" (ks-eval "($if #t 1 2)") 1)
+(ks-test "if: false branch" (ks-eval "($if #f 1 2)") 2)
+(ks-test "if: predicate"
+  (ks-eval "($if (<=? 1 2) ($quote yes) ($quote no))") "yes")
+(ks-test
+  "if: untaken branch not evaluated"
+  (ks-eval "($if #t 42 nope)")
+  42)
+
+;; ── $define! + arithmetic ───────────────────────────────────────
+(ks-test
+  "define!: returns value"
+  (let ((env (kernel-standard-env))) (ks-eval-in "($define! x 5)" env))
+  5)
+
+(ks-test
+  "define!: bound in env"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in "($define! x 5)" env)
+    (ks-eval-in "x" env))
+  5)
+
+(ks-test "arith: +" (ks-eval "(+ 2 3)") 5)
+(ks-test "arith: -" (ks-eval "(- 10 4)") 6)
+(ks-test "arith: *" (ks-eval "(* 6 7)") 42)
+(ks-test "arith: /" (ks-eval "(/ 20 5)") 4)
+(ks-test "cmp: <  true" (ks-eval "(< 1 2)") true)
+(ks-test "cmp: <  false" (ks-eval "(< 2 1)") false)
+(ks-test "cmp: >=" (ks-eval "(>=? 2 2)") true)
+(ks-test "cmp: <=" (ks-eval "(<=? 2 3)") true)
+(ks-test "cmp: =" (ks-eval "(=? 7 7)") true)
+
+;; ── $sequence ────────────────────────────────────────────────────
+(ks-test "sequence: empty" (ks-eval "($sequence)") nil)
+(ks-test "sequence: single" (ks-eval "($sequence 99)") 99)
+(ks-test
+  "sequence: multi-effect"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in "($sequence ($define! a 1) ($define! b 2) (+ a b))" env))
+  3)
+
+;; ── list primitives ──────────────────────────────────────────────
+(ks-test
+  "list: builds"
+  (ks-eval "(list 1 2 3)")
+  (list 1 2 3))
+(ks-test "list: empty" (ks-eval "(list)") (list))
+(ks-test
+  "cons: prepend"
+  (ks-eval "(cons 0 (list 1 2 3))")
+  (list 0 1 2 3))
+(ks-test "car: head" (ks-eval "(car (list 10 20 30))") 10)
+(ks-test
+  "cdr: tail"
+  (ks-eval "(cdr (list 10 20 30))")
+  (list 20 30))
+(ks-test "length: 3" (ks-eval "(length (list 1 2 3))") 3)
+(ks-test "length: 0" (ks-eval "(length (list))") 0)
+(ks-test "null?: empty" (ks-eval "(null? (list))") true)
+(ks-test "null?: nonempty" (ks-eval "(null? (list 1))") false)
+(ks-test "pair?: empty" (ks-eval "(pair? (list))") false)
+(ks-test "pair?: nonempty" (ks-eval "(pair? (list 1))") true)
+
+;; ── $quote ───────────────────────────────────────────────────────
+(ks-test "quote: symbol" (ks-eval "($quote foo)") "foo")
+(ks-test
+  "quote: list"
+  (ks-eval "($quote (+ 1 2))")
+  (list "+" 1 2))
+
+;; ── boolean / not ────────────────────────────────────────────────
+(ks-test "not: true" (ks-eval "(not #t)") false)
+(ks-test "not: false" (ks-eval "(not #f)") true)
+
+;; ── factorial ────────────────────────────────────────────────────
+(ks-test
+  "factorial: 5!"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! factorial ($lambda (n) ($if (<=? n 1) 1 (* n (factorial (- n 1))))))"
+      env)
+    (ks-eval-in "(factorial 5)" env))
+  120)
+
+(ks-test
+  "factorial: 0! = 1"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! factorial ($lambda (n) ($if (<=? n 1) 1 (* n (factorial (- n 1))))))"
+      env)
+    (ks-eval-in "(factorial 0)" env))
+  1)
+
+(ks-test
+  "factorial: 10!"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! factorial ($lambda (n) ($if (<=? n 1) 1 (* n (factorial (- n 1))))))"
+      env)
+    (ks-eval-in "(factorial 10)" env))
+  3628800)
+
+;; ── recursive list operations ────────────────────────────────────
+(ks-test
+  "sum: recursive over list"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! sum ($lambda (xs) ($if (null? xs) 0 (+ (car xs) (sum (cdr xs))))))"
+      env)
+    (ks-eval-in "(sum (list 1 2 3 4 5))" env))
+  15)
+
+(ks-test
+  "len: recursive count"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! mylen ($lambda (xs) ($if (null? xs) 0 (+ 1 (mylen (cdr xs))))))"
+      env)
+    (ks-eval-in "(mylen (list 1 2 3 4))" env))
+  4)
+
+(ks-test
+  "map-add1: build new list"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! add1-all ($lambda (xs) ($if (null? xs) (list) (cons (+ 1 (car xs)) (add1-all (cdr xs))))))"
+      env)
+    (ks-eval-in "(add1-all (list 10 20 30))" env))
+  (list 11 21 31))
+
+;; ── eval as a first-class applicative ────────────────────────────
+(ks-test
+  "eval: applies to constructed form"
+  (ks-eval "(eval (list ($quote +) 2 3) (get-current-environment))")
+  5)
+
+(ks-test
+  "eval: with a fresh make-environment"
+  (guard
+    (e (true :raised))
+    (ks-eval "(eval ($quote (+ 1 2)) (make-environment))"))
+  :raised)
+
+(ks-test
+  "eval: in extended env sees parent's bindings"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in "($define! shared 7)" env)
+    (ks-eval-in
+      "(eval ($quote shared) (make-environment (get-current-environment)))"
+      env))
+  7)
+
+;; ── get-current-environment ──────────────────────────────────────
+(ks-test
+  "get-current-environment: returns env"
+  (kernel-env? (ks-eval "(get-current-environment)"))
+  true)
+
+(ks-test
+  "get-current-environment: contains $if"
+  (let
+    ((env (ks-eval "(get-current-environment)")))
+    (kernel-env-has? env "$if"))
+  true)
+
+(ks-test
+  "make-environment: empty"
+  (let ((env (ks-eval "(make-environment)"))) (kernel-env-has? env "$if"))
+  false)
+
+(ks-test
+  "make-environment: child sees parent"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in "($define! marker 123)" env)
+    (let
+      ((child (ks-eval-in "(make-environment (get-current-environment))" env)))
+      (kernel-env-has? child "marker")))
+  true)
+
+;; ── closures and lexical scope ───────────────────────────────────
+(ks-test
+  "closure: captures binding"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! make-adder ($lambda (n) ($lambda (x) (+ x n))))"
+      env)
+    (ks-eval-in "($define! add5 (make-adder 5))" env)
+    (ks-eval-in "(add5 10)" env))
+  15)
+
+(ks-test
+  "closure: nested lookups"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! curry-add ($lambda (a) ($lambda (b) ($lambda (c) (+ a (+ b c))))))"
+      env)
+    (ks-eval-in "(((curry-add 1) 2) 3)" env))
+  6)
+
+;; ── operative defined in standard env can reach $define! ─────────
+(ks-test
+  "custom: define-via-vau"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! $let-it ($vau (name expr) e ($sequence ($define! tmp (eval expr e)) (eval (list ($quote $define!) name (list ($quote $quote) tmp)) e) tmp)))"
+      env)
+    (ks-eval-in "($let-it z 77)" env)
+    (ks-eval-in "z" env))
+  77)
+
+;; ── quasiquote ──────────────────────────────────────────────────
+(ks-test "qq: plain atom"      (ks-eval "`hello") "hello")
+(ks-test "qq: plain list"      (ks-eval "`(a b c)") (list "a" "b" "c"))
+(ks-test "qq: unquote splices value"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! x 42)" env)
+    (ks-eval-in "`(a ,x b)" env)) (list "a" 42 "b"))
+(ks-test "qq: unquote-splicing splices list"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! xs (list 1 2 3))" env)
+    (ks-eval-in "`(a ,@xs b)" env)) (list "a" 1 2 3 "b"))
+(ks-test "qq: unquote-splicing at end"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! xs (list 9 8))" env)
+    (ks-eval-in "`(a b ,@xs)" env)) (list "a" "b" 9 8))
+(ks-test "qq: unquote-splicing at start"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! xs (list 1 2))" env)
+    (ks-eval-in "`(,@xs c)" env)) (list 1 2 "c"))
+(ks-test "qq: nested list with unquote inside"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! x 5)" env)
+    (ks-eval-in "`(a (b ,x) c)" env))
+  (list "a" (list "b" 5) "c"))
+(ks-test "qq: error on bare unquote-splicing into non-list"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! x 42)" env)
+    (guard (e (true :raised))
+      (ks-eval-in "`(a ,@x b)" env)))
+  :raised)
+
+;; ── $cond / $when / $unless ─────────────────────────────────────
+(ks-test "cond: first match"
+  (ks-eval "($cond (#f 1) (#t 2) (#t 3))") 2)
+(ks-test "cond: else fallback"
+  (ks-eval "($cond (#f 1) (else 99))") 99)
+(ks-test "cond: no match returns nil"
+  (ks-eval "($cond (#f 1) (#f 2))") nil)
+(ks-test "cond: empty clauses returns nil"
+  (ks-eval "($cond)") nil)
+(ks-test "cond: multi-expr body"
+  (ks-eval "($cond (#t 1 2 3))") 3)
+(ks-test "cond: doesn't evaluate untaken clauses"
+  ;; If the second clause's test were evaluated, the unbound `nope` would error.
+  (ks-eval "($cond (#t 7) (nope ignored))") 7)
+(ks-test "cond: predicate evaluation"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! n 5)" env)
+    (ks-eval-in "($cond ((< n 0) ($quote negative)) ((= n 0) ($quote zero)) (else ($quote positive)))" env))
+  "positive")
+
+(ks-test "when: true runs body"
+  (ks-eval "($when #t 1 2 3)") 3)
+(ks-test "when: false returns nil"
+  (ks-eval "($when #f 1 2 3)") nil)
+(ks-test "when: skips body when false"
+  (ks-eval "($when #f nope)") nil)
+
+(ks-test "unless: false runs body"
+  (ks-eval "($unless #f 99)") 99)
+(ks-test "unless: true returns nil"
+  (ks-eval "($unless #t 99)") nil)
+(ks-test "unless: skips body when true"
+  (ks-eval "($unless #t nope)") nil)
+
+;; ── $and? / $or? short-circuit ──────────────────────────────────
+(ks-test "and: empty returns true"   (ks-eval "($and?)") true)
+(ks-test "and: single returns value" (ks-eval "($and? 42)") 42)
+(ks-test "and: all true returns last"
+  (ks-eval "($and? 1 2 3)") 3)
+(ks-test "and: first false short-circuits"
+  (ks-eval "($and? #f nope)") false)
+(ks-test "and: false in middle short-circuits"
+  (ks-eval "($and? 1 #f nope)") false)
+(ks-test "or: empty returns false"  (ks-eval "($or?)") false)
+(ks-test "or: single returns value" (ks-eval "($or? 42)") 42)
+(ks-test "or: first truthy short-circuits"
+  (ks-eval "($or? 99 nope)") 99)
+(ks-test "or: all false returns last"
+  (ks-eval "($or? #f #f #f)") false)
+(ks-test "or: middle truthy"
+  (ks-eval "($or? #f 42 nope)") 42)
+
+;; ── variadic arithmetic ─────────────────────────────────────────
+(ks-test "+: zero args = 0"    (ks-eval "(+)") 0)
+(ks-test "+: one arg = arg"    (ks-eval "(+ 7)") 7)
+(ks-test "+: two args"         (ks-eval "(+ 3 4)") 7)
+(ks-test "+: five args"        (ks-eval "(+ 1 2 3 4 5)") 15)
+
+(ks-test "*: zero args = 1"    (ks-eval "(*)") 1)
+(ks-test "*: one arg"          (ks-eval "(* 7)") 7)
+(ks-test "*: four args"        (ks-eval "(* 1 2 3 4)") 24)
+
+(ks-test "-: one arg negates"  (ks-eval "(- 10)") -10)
+(ks-test "-: two args"         (ks-eval "(- 10 3)") 7)
+(ks-test "-: four args fold"   (ks-eval "(- 100 1 2 3)") 94)
+
+(ks-test "/: two args"         (ks-eval "(/ 20 5)") 4)
+(ks-test "/: three args fold"  (ks-eval "(/ 100 2 5)") 10)
+
+;; ── variadic chained comparison ─────────────────────────────────
+(ks-test "<: chained ascending"  (ks-eval "(< 1 2 3 4 5)") true)
+(ks-test "<: not strict"          (ks-eval "(< 1 2 2 3)") false)
+(ks-test "<: anti-monotonic"      (ks-eval "(< 5 3)") false)
+(ks-test ">: chained descending" (ks-eval "(> 5 4 3 2 1)") true)
+(ks-test "<=? ascending equals"   (ks-eval "(<=? 1 1 2 3 3)") true)
+(ks-test "<=? violation"          (ks-eval "(<=? 1 2 1)") false)
+(ks-test ">=? descending equals" (ks-eval "(>=? 3 3 2 1)") true)
+
+;; ── list combinators ────────────────────────────────────────────
+(ks-test "map: square"
+  (ks-eval "(map ($lambda (x) (* x x)) (list 1 2 3 4))")
+  (list 1 4 9 16))
+(ks-test "map: empty list"
+  (ks-eval "(map ($lambda (x) x) (list))") (list))
+(ks-test "map: identity preserves"
+  (ks-eval "(map ($lambda (x) x) (list 1 2 3))") (list 1 2 3))
+(ks-test "map: with closure over outer"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! k 10)" env)
+    (ks-eval-in "(map ($lambda (x) (+ x k)) (list 1 2 3))" env))
+  (list 11 12 13))
+
+(ks-test "filter: positives"
+  (ks-eval "(filter ($lambda (x) (< 0 x)) (list -2 -1 0 1 2))")
+  (list 1 2))
+(ks-test "filter: empty result"
+  (ks-eval "(filter ($lambda (x) #f) (list 1 2 3))") (list))
+(ks-test "filter: all match"
+  (ks-eval "(filter ($lambda (x) #t) (list 1 2 3))") (list 1 2 3))
+
+(ks-test "reduce: sum"
+  (ks-eval "(reduce ($lambda (a b) (+ a b)) 0 (list 1 2 3 4 5))") 15)
+(ks-test "reduce: product"
+  (ks-eval "(reduce ($lambda (a b) (* a b)) 1 (list 1 2 3 4))") 24)
+(ks-test "reduce: empty returns init"
+  (ks-eval "(reduce ($lambda (a b) (+ a b)) 42 (list))") 42)
+(ks-test "reduce: build list"
+  (ks-eval "(reduce ($lambda (acc x) (cons x acc)) () (list 1 2 3))")
+  (list 3 2 1))
+
+;; ── apply ────────────────────────────────────────────────────────
+(ks-test "apply: + over list"
+  (ks-eval "(apply + (list 1 2 3 4 5))") 15)
+(ks-test "apply: lambda"
+  (ks-eval "(apply ($lambda (a b c) (* a (+ b c))) (list 2 3 4))") 14)
+(ks-test "apply: list identity"
+  (ks-eval "(apply list (list 1 2 3))") (list 1 2 3))
+(ks-test "apply: empty args list"
+  (ks-eval "(apply + (list))") 0)
+(ks-test "apply: single arg list"
+  (ks-eval "(apply ($lambda (x) (* x 10)) (list 7))") 70)
+(ks-test "apply: built via map+apply"
+  ;; (apply + (map ($lambda (x) (* x x)) (list 1 2 3))) → 1+4+9 = 14
+  (ks-eval
+    "(apply + (map ($lambda (x) (* x x)) (list 1 2 3)))") 14)
+(ks-test "apply: error on non-list args"
+  (guard (e (true :raised))
+    (ks-eval "(apply + 5)"))
+  :raised)
+
+;; ── append / reverse ────────────────────────────────────────────
+(ks-test "append: two lists"
+  (ks-eval "(append (list 1 2) (list 3 4))") (list 1 2 3 4))
+(ks-test "append: three lists"
+  (ks-eval "(append (list 1) (list 2) (list 3))") (list 1 2 3))
+(ks-test "append: empty list"
+  (ks-eval "(append)") (list))
+(ks-test "append: one list"
+  (ks-eval "(append (list 1 2 3))") (list 1 2 3))
+(ks-test "append: empty + nonempty"
+  (ks-eval "(append (list) (list 1 2))") (list 1 2))
+(ks-test "append: nonempty + empty"
+  (ks-eval "(append (list 1 2) (list))") (list 1 2))
+(ks-test "append: error on non-list"
+  (guard (e (true :raised))
+    (ks-eval "(append (list 1) 5)"))
+  :raised)
+
+(ks-test "reverse: four elements"
+  (ks-eval "(reverse (list 1 2 3 4))") (list 4 3 2 1))
+(ks-test "reverse: empty"
+  (ks-eval "(reverse (list))") (list))
+(ks-test "reverse: single"
+  (ks-eval "(reverse (list 99))") (list 99))
+(ks-test "reverse: double reverse is identity"
+  (ks-eval "(reverse (reverse (list 1 2 3)))") (list 1 2 3))
+
+(define ks-tests-run! (fn () {:total (+ ks-test-pass ks-test-fail) :passed ks-test-pass :failed ks-test-fail :fails ks-test-fails}))

lib/kernel/tests/vau.sx

@@ -0,0 +1,309 @@
+;; lib/kernel/tests/vau.sx — exercises lib/kernel/runtime.sx.
+;;
+;; Verifies the Phase 3 promise: user-defined operatives and applicatives
+;; constructible from inside the language. Tests build a Kernel
+;; base-env, bind a few helper applicatives (+, *, list, =, $if), and
+;; run programs that construct and use custom combiners.
+
+(define kv-test-pass 0)
+(define kv-test-fail 0)
+(define kv-test-fails (list))
+
+(define
+  kv-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! kv-test-pass (+ kv-test-pass 1))
+      (begin
+        (set! kv-test-fail (+ kv-test-fail 1))
+        (append! kv-test-fails {:name name :actual actual :expected expected})))))
+
+(define kv-eval-src (fn (src env) (kernel-eval (kernel-parse src) env)))
+
+(define
+  kv-make-env
+  (fn
+    ()
+    (let
+      ((env (kernel-base-env)))
+      (kernel-env-bind!
+        env
+        "+"
+        (kernel-make-primitive-applicative
+          (fn (args) (+ (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "*"
+        (kernel-make-primitive-applicative
+          (fn (args) (* (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "-"
+        (kernel-make-primitive-applicative
+          (fn (args) (- (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "="
+        (kernel-make-primitive-applicative
+          (fn (args) (= (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "list"
+        (kernel-make-primitive-applicative (fn (args) args)))
+      (kernel-env-bind!
+        env
+        "cons"
+        (kernel-make-primitive-applicative
+          (fn (args) (cons (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "$quote"
+        (kernel-make-primitive-operative (fn (args dyn-env) (first args))))
+      (kernel-env-bind!
+        env
+        "$if"
+        (kernel-make-primitive-operative
+          (fn
+            (args dyn-env)
+            (if
+              (kernel-eval (first args) dyn-env)
+              (kernel-eval (nth args 1) dyn-env)
+              (kernel-eval (nth args 2) dyn-env)))))
+      env)))
+
+;; ── $vau: builds an operative ───────────────────────────────────
+(kv-test
+  "vau: identity returns first arg unevaluated"
+  (kv-eval-src "(($vau (a) _ a) hello)" (kv-make-env))
+  "hello")
+
+(kv-test
+  "vau: returns args as raw expressions"
+  (kv-eval-src "(($vau (a b) _ (list a b)) (+ 1 2) (+ 3 4))" (kv-make-env))
+  (list (list "+" 1 2) (list "+" 3 4)))
+
+(kv-test
+  "vau: env-param is a kernel env"
+  (kernel-env? (kv-eval-src "(($vau () e e))" (kv-make-env)))
+  true)
+
+(kv-test
+  "vau: returns operative"
+  (kernel-operative? (kv-eval-src "($vau (x) _ x)" (kv-make-env)))
+  true)
+
+(kv-test
+  "vau: returns operative not applicative"
+  (kernel-applicative? (kv-eval-src "($vau (x) _ x)" (kv-make-env)))
+  false)
+
+(kv-test
+  "vau: zero-arg body"
+  (kv-eval-src "(($vau () _ 42))" (kv-make-env))
+  42)
+
+(kv-test
+  "vau: static-env closure captured"
+  (let
+    ((outer (kv-make-env)))
+    (kernel-env-bind! outer "captured" 17)
+    (let
+      ((op (kv-eval-src "($vau () _ captured)" outer))
+        (caller (kv-make-env)))
+      (kernel-env-bind! caller "captured" 99)
+      (kernel-combine op (list) caller)))
+  17)
+
+(kv-test
+  "vau: env-param exposes caller's dynamic env"
+  (let
+    ((outer (kv-make-env)))
+    (kernel-env-bind! outer "x" 1)
+    (let
+      ((op (kv-eval-src "($vau () e e)" outer)) (caller (kv-make-env)))
+      (kernel-env-bind! caller "x" 2)
+      (let
+        ((e-val (kernel-combine op (list) caller)))
+        (kernel-env-lookup e-val "x"))))
+  2)
+
+;; ── $lambda: applicatives evaluate their args ───────────────────
+(kv-test
+  "lambda: identity"
+  (kv-eval-src "(($lambda (x) x) 42)" (kv-make-env))
+  42)
+
+(kv-test
+  "lambda: addition"
+  (kv-eval-src "(($lambda (x y) (+ x y)) 3 4)" (kv-make-env))
+  7)
+
+(kv-test
+  "lambda: args are evaluated before bind"
+  (kv-eval-src "(($lambda (x) x) (+ 2 3))" (kv-make-env))
+  5)
+
+(kv-test
+  "lambda: zero args"
+  (kv-eval-src "(($lambda () 99))" (kv-make-env))
+  99)
+
+(kv-test
+  "lambda: returns applicative"
+  (kernel-applicative? (kv-eval-src "($lambda (x) x)" (kv-make-env)))
+  true)
+
+(kv-test
+  "lambda: returns applicative not operative"
+  (kernel-operative? (kv-eval-src "($lambda (x) x)" (kv-make-env)))
+  false)
+
+(kv-test
+  "lambda: higher-order"
+  (kv-eval-src "(($lambda (f) (f 10)) ($lambda (x) (+ x 1)))" (kv-make-env))
+  11)
+
+;; ── wrap / unwrap as user-callable applicatives ─────────────────
+
+(kv-test
+  "wrap: makes applicative from operative"
+  (kernel-applicative? (kv-eval-src "(wrap ($vau (x) _ x))" (kv-make-env)))
+  true)
+
+(kv-test
+  "wrap: result evaluates its arg"
+  (kv-eval-src "((wrap ($vau (x) _ x)) (+ 1 2))" (kv-make-env))
+  3)
+
+(kv-test
+  "unwrap: extracts operative from applicative"
+  (kernel-operative? (kv-eval-src "(unwrap ($lambda (x) x))" (kv-make-env)))
+  true)
+
+(kv-test
+  "wrap/unwrap roundtrip preserves identity"
+  (kv-eval-src
+    "(($lambda (op) (= op (unwrap (wrap op)))) ($vau (x) _ x))"
+    (kv-make-env))
+  true)
+
+;; ── operative? / applicative? as user-visible predicates ────────
+
+(kv-test
+  "operative? on vau result"
+  (kv-eval-src "(operative? ($vau (x) _ x))" (kv-make-env))
+  true)
+
+(kv-test
+  "operative? on lambda result"
+  (kv-eval-src "(operative? ($lambda (x) x))" (kv-make-env))
+  false)
+
+(kv-test
+  "applicative? on lambda result"
+  (kv-eval-src "(applicative? ($lambda (x) x))" (kv-make-env))
+  true)
+
+(kv-test
+  "applicative? on vau result"
+  (kv-eval-src "(applicative? ($vau (x) _ x))" (kv-make-env))
+  false)
+
+(kv-test
+  "operative? on number"
+  (kv-eval-src "(operative? 42)" (kv-make-env))
+  false)
+
+;; ── Build BOTH layers from user code ────────────────────────────
+;; The headline Phase 3 test: defining an operative on top of an
+;; applicative defined on top of a vau.
+
+(kv-test
+  "custom: applicative + operative compose"
+  (let
+    ((env (kv-make-env)))
+    (kernel-env-bind! env "square" (kv-eval-src "($lambda (x) (* x x))" env))
+    (kv-eval-src "(square 4)" env))
+  16)
+
+(kv-test "custom: operative captures argument syntax"
+  ;; ($capture x) returns the raw expression `x`, regardless of value.
+  (let ((env (kv-make-env)))
+    (kernel-env-bind! env "$capture"
+      (kv-eval-src "($vau (form) _ form)" env))
+    (kv-eval-src "($capture (+ 1 2))" env))
+  (list "+" 1 2))
+
+(kv-test "custom: applicative re-wraps an operative"
+  ;; Build a captured operative, then wrap it into an applicative that
+  ;; evaluates args before re-entry. This exercises wrap+$vau composed.
+  (let ((env (kv-make-env)))
+    (kernel-env-bind! env "id-app"
+      (kv-eval-src "(wrap ($vau (x) _ x))" env))
+    (kv-eval-src "(id-app (+ 10 20))" env))
+  30)
+
+;; ── Error cases ──────────────────────────────────────────────────
+
+(kv-test
+  "vau: rejects non-list formals"
+  (guard (e (true :raised)) (kv-eval-src "($vau x _ x)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "vau: rejects non-symbol formal"
+  (guard (e (true :raised)) (kv-eval-src "($vau (1) _ x)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "vau: rejects non-symbol env-param"
+  (guard (e (true :raised)) (kv-eval-src "($vau (x) 7 x)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "vau: too few args at call site"
+  (guard
+    (e (true :raised))
+    (kv-eval-src "(($vau (x y) _ x) 1)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "vau: too many args at call site"
+  (guard
+    (e (true :raised))
+    (kv-eval-src "(($vau (x) _ x) 1 2)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "wrap: rejects non-operative"
+  (guard (e (true :raised)) (kv-eval-src "(wrap 42)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "unwrap: rejects non-applicative"
+  (guard (e (true :raised)) (kv-eval-src "(unwrap 42)" (kv-make-env)))
+  :raised)
+
+;; ── Multi-expression body (implicit $sequence) ──────────────────
+
+(kv-test "lambda: two body forms — value of last"
+  (kv-eval-src "(($lambda (n) (+ n 1) (+ n 10)) 5)" (kv-make-env)) 15)
+
+(kv-test "lambda: three body forms"
+  (kv-eval-src "(($lambda (n) n (+ n 1) (+ n 2)) 10)" (kv-make-env)) 12)
+
+(kv-test "vau: two body forms"
+  (kv-eval-src "(($vau (a b) _ a (list a b)) 7 8)" (kv-make-env))
+  (list 7 8))
+
+(kv-test "lambda: $define! in early body visible in later body"
+  (kv-eval-src
+    "(($lambda (n) ($define! double (+ n n)) double) 6)"
+    (kv-make-env)) 12)
+
+(kv-test "lambda: zero-arg multi-body"
+  (kv-eval-src "(($lambda () 1 2 3))" (kv-make-env)) 3)
+
+(define kv-tests-run! (fn () {:total (+ kv-test-pass kv-test-fail) :passed kv-test-pass :failed kv-test-fail :fails kv-test-fails}))

lib/minikanren/clpfd.sx

@@ -0,0 +1,590 @@
+;; 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
+            ((s3 (c s2)))
+            (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
+            ((s3 (c s2)))
+            (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
+            ((s3 (c s2)))
+            (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
+            ((s3 (c s2)))
+            (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-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))
+        (: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
+            ((s3 (c s2)))
+            (cond ((= s3 nil) mzero) (:else (unit s3)))))))))
+
+;; --- fd-times (x * y = z, ground-cases propagator) ---
+
+(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))))
+        (: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
+            ((s3 (c s2)))
+            (cond ((= s3 nil) mzero) (:else (unit s3)))))))))

lib/minikanren/conda.sx

@@ -0,0 +1,42 @@
+;; 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))))

lib/minikanren/conde.sx

@@ -0,0 +1,39 @@
+;; 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)))))

lib/minikanren/condu.sx

@@ -0,0 +1,58 @@
+;; 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))))

lib/minikanren/defrel.sx

@@ -0,0 +1,25 @@
+;; 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)))))

lib/minikanren/fd.sx

@@ -0,0 +1,25 @@
+;; 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))))))

lib/minikanren/fresh.sx

@@ -0,0 +1,23 @@
+;; 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))))

lib/minikanren/goals.sx

@@ -0,0 +1,58 @@
+;; 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)))

lib/minikanren/intarith.sx

@@ -0,0 +1,151 @@
+;; 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)))))

lib/minikanren/matche.sx

@@ -0,0 +1,76 @@
+;; 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)))

lib/minikanren/nafc.sx

@@ -0,0 +1,24 @@
+;; 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)))))

lib/minikanren/peano.sx

@@ -0,0 +1,51 @@
+;; 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))))))

lib/minikanren/project.sx

@@ -0,0 +1,25 @@
+;; 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))))))

lib/minikanren/queens.sx

@@ -0,0 +1,67 @@
+;; 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)))))

lib/minikanren/relations.sx

@@ -0,0 +1,361 @@
+;; 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))))))

lib/minikanren/run.sx

@@ -0,0 +1,56 @@
+;; 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))))

lib/minikanren/stream.sx

@@ -0,0 +1,66 @@
+;; 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)))))))

lib/minikanren/tabling.sx

@@ -0,0 +1,157 @@
+;; 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))))))))

lib/minikanren/tests/appendo3.sx

@@ -0,0 +1,49 @@
+;; 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!)

lib/minikanren/tests/arith-prog.sx

@@ -0,0 +1,33 @@
+;; 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!)

lib/minikanren/tests/btree-walko.sx

@@ -0,0 +1,54 @@
+;; 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!)

lib/minikanren/tests/classics.sx

@@ -0,0 +1,87 @@
+;; 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!)

lib/minikanren/tests/clpfd-distinct.sx

@@ -0,0 +1,52 @@
+;; 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!)

lib/minikanren/tests/clpfd-domains.sx

@@ -0,0 +1,133 @@
+;; 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!)

lib/minikanren/tests/clpfd-in-label.sx

@@ -0,0 +1,120 @@
+;; 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!)

lib/minikanren/tests/clpfd-neq.sx

@@ -0,0 +1,82 @@
+;; 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!)

lib/minikanren/tests/clpfd-ord.sx

@@ -0,0 +1,128 @@
+;; 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!)

lib/minikanren/tests/clpfd-plus.sx

@@ -0,0 +1,62 @@
+;; 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!)

lib/minikanren/tests/clpfd-times.sx

@@ -0,0 +1,85 @@
+;; 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!)

lib/minikanren/tests/conda.sx

@@ -0,0 +1,75 @@
+;; 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!)

lib/minikanren/tests/conde.sx

@@ -0,0 +1,89 @@
+;; 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!)

lib/minikanren/tests/condu.sx

@@ -0,0 +1,86 @@
+;; 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!)

lib/minikanren/tests/counto.sx

@@ -0,0 +1,35 @@
+;; 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!)

lib/minikanren/tests/cyclic-graph.sx

@@ -0,0 +1,48 @@
+;; 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!)

lib/minikanren/tests/defrel.sx

@@ -0,0 +1,40 @@
+;; 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!)

lib/minikanren/tests/enumerate.sx

@@ -0,0 +1,31 @@
+;; 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!)

lib/minikanren/tests/fd.sx

@@ -0,0 +1,75 @@
+;; 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!)

lib/minikanren/tests/flat-mapo.sx

@@ -0,0 +1,39 @@
+;; lib/minikanren/tests/flat-mapo.sx — concatMap-style relation.
+
+(mk-test
+  "flat-mapo-empty"
+  (run* q (flat-mapo (fn (x r) (== r (list x x))) (list) q))
+  (list (list)))
+
+(mk-test
+  "flat-mapo-duplicate-each"
+  (run*
+    q
+    (flat-mapo
+      (fn (x r) (== r (list x x)))
+      (list 1 2 3)
+      q))
+  (list
+    (list 1 1 2 2 3 3)))
+
+(mk-test
+  "flat-mapo-empty-from-each"
+  (run* q (flat-mapo (fn (x r) (== r (list))) (list :a :b :c) q))
+  (list (list)))
+
+(mk-test
+  "flat-mapo-singleton-from-each-is-identity"
+  (run* q (flat-mapo (fn (x r) (== r (list x))) (list :a :b :c) q))
+  (list (list :a :b :c)))
+
+(mk-test
+  "flat-mapo-tag-each"
+  (run*
+    q
+    (flat-mapo
+      (fn (x r) (== r (list :tag x)))
+      (list 1 2)
+      q))
+  (list (list :tag 1 :tag 2)))
+
+(mk-tests-run!)

lib/minikanren/tests/flatteno.sx

@@ -0,0 +1,42 @@
+(mk-test "flatteno-empty" (run* q (flatteno (list) q)) (list (list)))
+
+(mk-test
+  "flatteno-atom"
+  (run* q (flatteno 5 q))
+  (list (list 5)))
+
+(mk-test
+  "flatteno-flat-list"
+  (run* q (flatteno (list 1 2 3) q))
+  (list (list 1 2 3)))
+
+(mk-test
+  "flatteno-singleton"
+  (run* q (flatteno (list 1) q))
+  (list (list 1)))
+
+(mk-test
+  "flatteno-nested-once"
+  (run*
+    q
+    (flatteno (list 1 (list 2 3) 4) q))
+  (list (list 1 2 3 4)))
+
+(mk-test
+  "flatteno-nested-twice"
+  (run*
+    q
+    (flatteno
+      (list
+        1
+        (list 2 (list 3 4))
+        5)
+      q))
+  (list (list 1 2 3 4 5)))
+
+(mk-test
+  "flatteno-keywords"
+  (run* q (flatteno (list :a (list :b :c) :d) q))
+  (list (list :a :b :c :d)))
+
+(mk-tests-run!)

lib/minikanren/tests/foldl-o.sx

@@ -0,0 +1,48 @@
+;; lib/minikanren/tests/foldl-o.sx — relational left fold.
+
+(mk-test
+  "foldl-o-empty"
+  (run* q (foldl-o pluso-i (list) 42 q))
+  (list 42))
+
+(mk-test
+  "foldl-o-sum"
+  (run*
+    q
+    (foldl-o
+      pluso-i
+      (list 1 2 3 4 5)
+      0
+      q))
+  (list 15))
+
+(mk-test
+  "foldl-o-product"
+  (run*
+    q
+    (foldl-o
+      *o-i
+      (list 1 2 3 4)
+      1
+      q))
+  (list 24))
+
+(mk-test
+  "foldl-o-reverse-via-flip-conso"
+  (run*
+    q
+    (foldl-o
+      (fn (acc x r) (conso x acc r))
+      (list 1 2 3 4)
+      (list)
+      q))
+  (list (list 4 3 2 1)))
+
+(mk-test
+  "foldl-o-with-init"
+  (run*
+    q
+    (foldl-o pluso-i (list 1 2 3) 100 q))
+  (list 106))
+
+(mk-tests-run!)

lib/minikanren/tests/foldr-o.sx

@@ -0,0 +1,38 @@
+;; lib/minikanren/tests/foldr-o.sx — relational right fold.
+
+(mk-test
+  "foldr-o-empty"
+  (run* q (foldr-o conso (list) (list 99) q))
+  (list (list 99)))
+
+(mk-test
+  "foldr-o-conso-rebuilds-list"
+  (run* q (foldr-o conso (list 1 2 3) (list) q))
+  (list (list 1 2 3)))
+
+(mk-test
+  "foldr-o-appendo-flattens"
+  (run*
+    q
+    (foldr-o
+      appendo
+      (list
+        (list 1 2)
+        (list 3)
+        (list 4 5))
+      (list)
+      q))
+  (list (list 1 2 3 4 5)))
+
+(mk-test
+  "foldr-o-with-acc-init"
+  (run*
+    q
+    (foldr-o
+      conso
+      (list 1 2)
+      (list 9 9)
+      q))
+  (list (list 1 2 9 9)))
+
+(mk-tests-run!)

lib/minikanren/tests/fresh.sx

@@ -0,0 +1,101 @@
+;; lib/minikanren/tests/fresh.sx — Phase 2 piece B tests for `fresh`.
+
+;; --- empty fresh: pure goal grouping ---
+
+(mk-test
+  "fresh-empty-vars-equiv-conj"
+  (stream-take 5 ((fresh () (== 1 1)) empty-s))
+  (list empty-s))
+
+(mk-test
+  "fresh-empty-vars-no-goals-is-succeed"
+  (stream-take 5 ((fresh ()) empty-s))
+  (list empty-s))
+
+;; --- single var ---
+
+(mk-test
+  "fresh-one-var-bound"
+  (let
+    ((s (first (stream-take 5 ((fresh (x) (== x 7)) empty-s)))))
+    (first (vals s)))
+  7)
+
+;; --- multiple vars + multiple goals ---
+
+(mk-test
+  "fresh-two-vars-three-goals"
+  (let
+    ((q (mk-var "q"))
+      (g
+        (fresh
+          (x y)
+          (== x 10)
+          (== y 20)
+          (== q (list x y)))))
+    (mk-walk* q (first (stream-take 5 (g empty-s)))))
+  (list 10 20))
+
+(mk-test
+  "fresh-three-vars"
+  (let
+    ((q (mk-var "q"))
+      (g
+        (fresh
+          (a b c)
+          (== a 1)
+          (== b 2)
+          (== c 3)
+          (== q (list a b c)))))
+    (mk-walk* q (first (stream-take 5 (g empty-s)))))
+  (list 1 2 3))
+
+;; --- fresh interacts with disj ---
+
+(mk-test
+  "fresh-with-disj"
+  (let
+    ((q (mk-var "q")))
+    (let
+      ((g (fresh (x) (mk-disj (== x 1) (== x 2)) (== q x))))
+      (let
+        ((res (stream-take 5 (g empty-s))))
+        (map (fn (s) (mk-walk q s)) res))))
+  (list 1 2))
+
+;; --- nested fresh ---
+
+(mk-test
+  "fresh-nested"
+  (let
+    ((q (mk-var "q"))
+      (g
+        (fresh
+          (x)
+          (fresh
+            (y)
+            (== x 1)
+            (== y 2)
+            (== q (list x y))))))
+    (mk-walk* q (first (stream-take 5 (g empty-s)))))
+  (list 1 2))
+
+;; --- call-fresh (functional alternative) ---
+
+(mk-test
+  "call-fresh-binds-and-walks"
+  (let
+    ((s (first (stream-take 5 ((call-fresh (fn (x) (== x 99))) empty-s)))))
+    (first (vals s)))
+  99)
+
+(mk-test
+  "call-fresh-distinct-from-outer-vars"
+  (let
+    ((q (mk-var "q")))
+    (let
+      ((g (call-fresh (fn (x) (mk-conj (== x 5) (== q (list x x)))))))
+      (mk-walk* q (first (stream-take 5 (g empty-s))))))
+  (list 5 5))
+
+(mk-tests-run!)

lib/minikanren/tests/goals.sx

@@ -0,0 +1,260 @@
+;; lib/minikanren/tests/goals.sx — Phase 2 tests for stream.sx + goals.sx.
+;;
+;; Streams use a tagged shape internally (`(:s head tail)`) so that mature
+;; cells can have thunk tails — SX has no improper pairs. Test assertions
+;; therefore stream-take into a plain SX list, or check goal effects via
+;; mk-walk on the resulting subst, instead of inspecting raw streams.
+
+;; --- stream-take base cases (input streams use s-cons / mzero) ---
+
+(mk-test
+  "stream-take-zero-from-mature"
+  (stream-take 0 (s-cons (empty-subst) mzero))
+  (list))
+
+(mk-test "stream-take-from-mzero" (stream-take 5 mzero) (list))
+
+(mk-test
+  "stream-take-mature-pair"
+  (stream-take 5 (s-cons :a (s-cons :b mzero)))
+  (list :a :b))
+
+(mk-test
+  "stream-take-fewer-than-available"
+  (stream-take 1 (s-cons :a (s-cons :b mzero)))
+  (list :a))
+
+(mk-test
+  "stream-take-all-with-neg-1"
+  (stream-take -1 (s-cons :a (s-cons :b (s-cons :c mzero))))
+  (list :a :b :c))
+
+;; --- stream-take forces immature thunks ---
+
+(mk-test
+  "stream-take-forces-thunk"
+  (stream-take 5 (fn () (s-cons :x mzero)))
+  (list :x))
+
+(mk-test
+  "stream-take-forces-nested-thunks"
+  (stream-take 5 (fn () (fn () (s-cons :y mzero))))
+  (list :y))
+
+;; --- mk-mplus interleaves ---
+
+(mk-test
+  "mplus-empty-left"
+  (stream-take 5 (mk-mplus mzero (s-cons :r mzero)))
+  (list :r))
+
+(mk-test
+  "mplus-empty-right"
+  (stream-take 5 (mk-mplus (s-cons :l mzero) mzero))
+  (list :l))
+
+(mk-test
+  "mplus-mature-mature"
+  (stream-take
+    5
+    (mk-mplus (s-cons :a (s-cons :b mzero)) (s-cons :c (s-cons :d mzero))))
+  (list :a :b :c :d))
+
+(mk-test
+  "mplus-with-paused-left-swaps"
+  (stream-take
+    5
+    (mk-mplus
+      (fn () (s-cons :a (s-cons :b mzero)))
+      (s-cons :c (s-cons :d mzero))))
+  (list :c :d :a :b))
+
+;; --- mk-bind ---
+
+(mk-test
+  "bind-empty-stream"
+  (stream-take 5 (mk-bind mzero (fn (s) (unit s))))
+  (list))
+
+(mk-test
+  "bind-singleton-identity"
+  (stream-take
+    5
+    (mk-bind (s-cons 5 mzero) (fn (x) (unit x))))
+  (list 5))
+
+(mk-test
+  "bind-flat-multi"
+  (stream-take
+    10
+    (mk-bind
+      (s-cons 1 (s-cons 2 mzero))
+      (fn (x) (s-cons x (s-cons (* x 10) mzero)))))
+  (list 1 10 2 20))
+
+(mk-test
+  "bind-fail-prunes-some"
+  (stream-take
+    10
+    (mk-bind
+      (s-cons 1 (s-cons 2 (s-cons 3 mzero)))
+      (fn (x) (if (= x 2) mzero (unit x)))))
+  (list 1 3))
+
+;; --- core goals: succeed / fail ---
+
+(mk-test
+  "succeed-yields-singleton"
+  (stream-take 5 (succeed empty-s))
+  (list empty-s))
+
+(mk-test "fail-yields-mzero" (stream-take 5 (fail empty-s)) (list))
+
+;; --- == ---
+
+(mk-test
+  "eq-ground-success"
+  (stream-take 5 ((== 1 1) empty-s))
+  (list empty-s))
+
+(mk-test
+  "eq-ground-failure"
+  (stream-take 5 ((== 1 2) empty-s))
+  (list))
+
+(mk-test
+  "eq-binds-var"
+  (let
+    ((x (mk-var "x")))
+    (mk-walk
+      x
+      (first (stream-take 5 ((== x 7) empty-s)))))
+  7)
+
+(mk-test
+  "eq-list-success"
+  (let
+    ((x (mk-var "x")))
+    (mk-walk
+      x
+      (first
+        (stream-take
+          5
+          ((== x (list 1 2)) empty-s)))))
+  (list 1 2))
+
+(mk-test
+  "eq-list-mismatch-fails"
+  (stream-take
+    5
+    ((== (list 1 2) (list 1 3)) empty-s))
+  (list))
+
+;; --- conj2 / mk-conj ---
+
+(mk-test
+  "conj2-both-bind"
+  (let
+    ((x (mk-var "x")) (y (mk-var "y")))
+    (let
+      ((s (first (stream-take 5 ((conj2 (== x 1) (== y 2)) empty-s)))))
+      (list (mk-walk x s) (mk-walk y s))))
+  (list 1 2))
+
+(mk-test
+  "conj2-conflict-empty"
+  (let
+    ((x (mk-var "x")))
+    (stream-take
+      5
+      ((conj2 (== x 1) (== x 2)) empty-s)))
+  (list))
+
+(mk-test
+  "conj-empty-is-succeed"
+  (stream-take 5 ((mk-conj) empty-s))
+  (list empty-s))
+
+(mk-test
+  "conj-single-is-goal"
+  (let
+    ((x (mk-var "x")))
+    (mk-walk
+      x
+      (first
+        (stream-take 5 ((mk-conj (== x 99)) empty-s)))))
+  99)
+
+(mk-test
+  "conj-three-bindings"
+  (let
+    ((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z")))
+    (let
+      ((s (first (stream-take 5 ((mk-conj (== x 1) (== y 2) (== z 3)) empty-s)))))
+      (list (mk-walk x s) (mk-walk y s) (mk-walk z s))))
+  (list 1 2 3))
+
+;; --- disj2 / mk-disj ---
+
+(mk-test
+  "disj2-both-succeed"
+  (let
+    ((q (mk-var "q")))
+    (let
+      ((res (stream-take 5 ((disj2 (== q 1) (== q 2)) empty-s))))
+      (map (fn (s) (mk-walk q s)) res)))
+  (list 1 2))
+
+(mk-test
+  "disj2-fail-or-succeed"
+  (let
+    ((q (mk-var "q")))
+    (let
+      ((res (stream-take 5 ((disj2 fail (== q 5)) empty-s))))
+      (map (fn (s) (mk-walk q s)) res)))
+  (list 5))
+
+(mk-test
+  "disj-empty-is-fail"
+  (stream-take 5 ((mk-disj) empty-s))
+  (list))
+
+(mk-test
+  "disj-three-clauses"
+  (let
+    ((q (mk-var "q")))
+    (let
+      ((res (stream-take 5 ((mk-disj (== q "a") (== q "b") (== q "c")) empty-s))))
+      (map (fn (s) (mk-walk q s)) res)))
+  (list "a" "b" "c"))
+
+;; --- conj/disj nesting ---
+
+(mk-test
+  "disj-of-conj"
+  (let
+    ((x (mk-var "x")) (y (mk-var "y")))
+    (let
+      ((res (stream-take 5 ((mk-disj (mk-conj (== x 1) (== y 2)) (mk-conj (== x 3) (== y 4))) empty-s))))
+      (map (fn (s) (list (mk-walk x s) (mk-walk y s))) res)))
+  (list (list 1 2) (list 3 4)))
+
+;; --- ==-check ---
+
+(mk-test
+  "eq-check-no-occurs-fails"
+  (let
+    ((x (mk-var "x")))
+    (stream-take 5 ((==-check x (list 1 x)) empty-s)))
+  (list))
+
+(mk-test
+  "eq-check-no-occurs-non-occurring-succeeds"
+  (let
+    ((x (mk-var "x")))
+    (mk-walk
+      x
+      (first (stream-take 5 ((==-check x 5) empty-s)))))
+  5)
+
+(mk-tests-run!)

lib/minikanren/tests/graph.sx

@@ -0,0 +1,70 @@
+;; lib/minikanren/tests/graph.sx — directed-graph reachability via patho.
+
+(define
+  test-edges
+  (list (list :a :b) (list :b :c) (list :c :d) (list :a :c) (list :d :e)))
+
+(define edgeo (fn (from to) (membero (list from to) test-edges)))
+
+(define
+  patho
+  (fn
+    (x y path)
+    (conde
+      ((edgeo x y) (== path (list x y)))
+      ((fresh (z mid-path) (edgeo x z) (patho z y mid-path) (conso x mid-path path))))))
+
+;; --- direct edges ---
+
+(mk-test "patho-direct" (run* q (patho :a :b q)) (list (list :a :b)))
+
+(mk-test "patho-no-direct-edge" (run* q (patho :e :a q)) (list))
+
+;; --- indirect ---
+
+(mk-test
+  "patho-multi-hop"
+  (let
+    ((paths (run* q (patho :a :d q))))
+    (and
+      (= (len paths) 2)
+      (and
+        (some (fn (p) (= p (list :a :b :c :d))) paths)
+        (some (fn (p) (= p (list :a :c :d))) paths))))
+  true)
+
+(mk-test
+  "patho-to-leaf"
+  (let
+    ((paths (run* q (patho :a :e q))))
+    (and
+      (= (len paths) 2)
+      (and
+        (some (fn (p) (= p (list :a :b :c :d :e))) paths)
+        (some (fn (p) (= p (list :a :c :d :e))) paths))))
+  true)
+
+;; --- enumeration with multiplicity ---
+;; Each path contributes one tuple, so reachable nodes can repeat. Here
+;; targets are: b (1 path), c (2 paths), d (2 paths), e (2 paths) = 7.
+
+(mk-test
+  "patho-enumerate-from-a-with-multiplicity"
+  (let
+    ((targets (run* q (fresh (path) (patho :a q path)))))
+    (and
+      (= (len targets) 7)
+      (and
+        (some (fn (t) (= t :b)) targets)
+        (and
+          (some (fn (t) (= t :c)) targets)
+          (and
+            (some (fn (t) (= t :d)) targets)
+            (some (fn (t) (= t :e)) targets))))))
+  true)
+
+;; --- unreachable target ---
+
+(mk-test "patho-unreachable" (run* q (patho :a :z q)) (list))
+
+(mk-tests-run!)

lib/minikanren/tests/intarith.sx

@@ -0,0 +1,103 @@
+;; lib/minikanren/tests/intarith.sx — ground-only integer arithmetic
+;; goals that escape into host operations via project.
+
+;; --- pluso-i ---
+
+(mk-test
+  "pluso-i-forward"
+  (run* q (pluso-i 7 8 q))
+  (list 15))
+(mk-test
+  "pluso-i-zero"
+  (run* q (pluso-i 0 0 q))
+  (list 0))
+(mk-test
+  "pluso-i-negatives"
+  (run* q (pluso-i -5 3 q))
+  (list -2))
+(mk-test
+  "pluso-i-non-ground-fails"
+  (run* q (fresh (a) (pluso-i a 3 5)))
+  (list))
+
+;; --- minuso-i ---
+
+(mk-test
+  "minuso-i-forward"
+  (run* q (minuso-i 10 4 q))
+  (list 6))
+(mk-test
+  "minuso-i-zero"
+  (run* q (minuso-i 5 5 q))
+  (list 0))
+
+;; --- *o-i ---
+
+(mk-test
+  "times-i-forward"
+  (run* q (*o-i 6 7 q))
+  (list 42))
+(mk-test
+  "times-i-by-zero"
+  (run* q (*o-i 0 99 q))
+  (list 0))
+(mk-test
+  "times-i-by-one"
+  (run* q (*o-i 1 17 q))
+  (list 17))
+
+;; --- comparisons ---
+
+(mk-test
+  "lto-i-true"
+  (run 1 q (lto-i 2 5))
+  (list (make-symbol "_.0")))
+(mk-test "lto-i-false" (run* q (lto-i 5 2)) (list))
+(mk-test "lto-i-equal-false" (run* q (lto-i 3 3)) (list))
+
+(mk-test
+  "lteo-i-equal"
+  (run 1 q (lteo-i 4 4))
+  (list (make-symbol "_.0")))
+(mk-test
+  "lteo-i-less"
+  (run 1 q (lteo-i 1 4))
+  (list (make-symbol "_.0")))
+(mk-test "lteo-i-more" (run* q (lteo-i 9 4)) (list))
+
+(mk-test
+  "neqo-i-different"
+  (run 1 q (neqo-i 3 5))
+  (list (make-symbol "_.0")))
+(mk-test "neqo-i-same" (run* q (neqo-i 3 3)) (list))
+
+;; --- composition with relational vars ---
+
+(mk-test
+  "intarith-with-membero"
+  (run*
+    q
+    (fresh
+      (x)
+      (membero
+        x
+        (list 1 2 3 4 5))
+      (lto-i x 3)
+      (== q x)))
+  (list 1 2))
+
+(mk-test "even-i-pos" (run* q (even-i 4)) (list (make-symbol "_.0")))
+
+(mk-test "even-i-neg" (run* q (even-i 5)) (list))
+
+(mk-test "odd-i-pos" (run* q (odd-i 7)) (list (make-symbol "_.0")))
+
+(mk-test "odd-i-neg" (run* q (odd-i 4)) (list))
+
+(mk-test
+  "even-i-filter"
+  (run* q (fresh (x) (membero x (list 1 2 3 4 5 6)) (even-i x) (== q x)))
+  (list 2 4 6))
+
+(mk-tests-run!)
+

lib/minikanren/tests/iterate-no.sx

@@ -0,0 +1,38 @@
+;; lib/minikanren/tests/iterate-no.sx — iterated relation application.
+
+(define
+  mk-nat
+  (fn (n) (if (= n 0) :z (list :s (mk-nat (- n 1))))))
+
+(mk-test
+  "iterate-no-zero"
+  (run*
+    q
+    (iterate-no
+      (fn (a b) (== b (list :wrap a)))
+      (mk-nat 0)
+      :seed q))
+  (list :seed))
+
+(mk-test
+  "iterate-no-three-wraps"
+  (run*
+    q
+    (iterate-no (fn (a b) (== b (list :wrap a))) (mk-nat 3) :x q))
+  (list (list :wrap (list :wrap (list :wrap :x)))))
+
+(mk-test
+  "iterate-no-succ-three-times"
+  (run*
+    q
+    (iterate-no (fn (a b) (== b (list :s a))) (mk-nat 3) :z q))
+  (list (mk-nat 3)))
+
+(mk-test
+  "iterate-no-with-list-cons"
+  (run*
+    q
+    (iterate-no (fn (a b) (conso :a a b)) (mk-nat 4) (list) q))
+  (list (list :a :a :a :a)))
+
+(mk-tests-run!)

lib/minikanren/tests/lasto.sx

@@ -0,0 +1,38 @@
+;; lib/minikanren/tests/lasto.sx — last-element + init-without-last.
+
+(mk-test
+  "lasto-singleton"
+  (run* q (lasto (list 5) q))
+  (list 5))
+(mk-test
+  "lasto-multi"
+  (run* q (lasto (list 1 2 3 4) q))
+  (list 4))
+(mk-test "lasto-empty" (run* q (lasto (list) q)) (list))
+
+(mk-test "lasto-strings" (run* q (lasto (list "a" "b" "c") q)) (list "c"))
+
+(mk-test
+  "init-o-multi"
+  (run* q (init-o (list 1 2 3 4) q))
+  (list (list 1 2 3)))
+
+(mk-test
+  "init-o-singleton"
+  (run* q (init-o (list 7) q))
+  (list (list)))
+
+(mk-test "init-o-empty" (run* q (init-o (list) q)) (list))
+
+(mk-test
+  "lasto-init-o-roundtrip"
+  (run*
+    q
+    (fresh
+      (init last)
+      (lasto (list 1 2 3 4) last)
+      (init-o (list 1 2 3 4) init)
+      (appendo init (list last) q)))
+  (list (list 1 2 3 4)))
+
+(mk-tests-run!)

lib/minikanren/tests/latin.sx

@@ -0,0 +1,61 @@
+;; lib/minikanren/tests/latin.sx — 2x2 Latin square via ino + all-distincto.
+;;
+;; A 2x2 Latin square has 2 distinct fillings:
+;;   ((1 2) (2 1))  and  ((2 1) (1 2)).
+;; The 3x3 version has 12 fillings but takes minutes under naive search;
+;; full CLP(FD) (Phase 6 proper) would handle it in milliseconds.
+
+(define
+  latin-2x2
+  (fn
+    (cells)
+    (let
+      ((c11 (nth cells 0))
+        (c12 (nth cells 1))
+        (c21 (nth cells 2))
+        (c22 (nth cells 3))
+        (dom (list 1 2)))
+      (mk-conj
+        (ino c11 dom)
+        (ino c12 dom)
+        (ino c21 dom)
+        (ino c22 dom)
+        (all-distincto (list c11 c12))
+        (all-distincto (list c21 c22))
+        (all-distincto (list c11 c21))
+        (all-distincto (list c12 c22))))))   ;; col 2
+
+(mk-test
+  "latin-2x2-count"
+  (let
+    ((squares (run* q (fresh (a b c d) (== q (list a b c d)) (latin-2x2 (list a b c d))))))
+    (len squares))
+  2)
+
+(mk-test
+  "latin-2x2-as-set"
+  (let
+    ((squares (run* q (fresh (a b c d) (== q (list a b c d)) (latin-2x2 (list a b c d))))))
+    (and
+      (= (len squares) 2)
+      (and
+        (some
+          (fn (s) (= s (list 1 2 2 1)))
+          squares)
+        (some
+          (fn (s) (= s (list 2 1 1 2)))
+          squares))))
+  true)
+
+(mk-test
+  "latin-2x2-with-clue"
+  (run*
+    q
+    (fresh
+      (a b c d)
+      (== a 1)
+      (== q (list a b c d))
+      (latin-2x2 (list a b c d))))
+  (list (list 1 2 2 1)))
+
+(mk-tests-run!)

lib/minikanren/tests/laziness.sx

@@ -0,0 +1,77 @@
+;; lib/minikanren/tests/laziness.sx — verify Zzz wrapping (in conde)
+;; lets infinitely-recursive relations produce finite prefixes via run-n.
+
+;; --- a relation that has no base case but conde-protects via Zzz ---
+
+(define
+  listo-aux
+  (fn
+    (l)
+    (conde ((nullo l)) ((fresh (a d) (conso a d l) (listo-aux d))))))
+
+(mk-test
+  "infinite-relation-truncates-via-run-n"
+  (run 4 q (listo-aux q))
+  (list
+    (list)
+    (list (make-symbol "_.0"))
+    (list (make-symbol "_.0") (make-symbol "_.1"))
+    (list (make-symbol "_.0") (make-symbol "_.1") (make-symbol "_.2"))))
+
+;; --- two infinite generators interleaved via mk-disj must both produce
+;;     answers (no starvation) — the fairness test ---
+
+(define
+  ones-gen
+  (fn
+    (l)
+    (conde
+      ((== l (list)))
+      ((fresh (d) (conso 1 d l) (ones-gen d))))))
+
+(define
+  twos-gen
+  (fn
+    (l)
+    (conde
+      ((== l (list)))
+      ((fresh (d) (conso 2 d l) (twos-gen d))))))
+
+(mk-test
+  "interleaving-keeps-both-streams-alive"
+  (let
+    ((res (run 4 q (mk-disj (ones-gen q) (twos-gen q)))))
+    (and
+      (= (len res) 4)
+      (and
+        (some
+          (fn
+            (x)
+            (and
+              (list? x)
+              (and (not (empty? x)) (= (first x) 1))))
+          res)
+        (some
+          (fn
+            (x)
+            (and
+              (list? x)
+              (and (not (empty? x)) (= (first x) 2))))
+          res))))
+  true)
+
+;; --- run* terminates on a relation whose conde has finite base case
+;;     reached from any starting point ---
+
+(mk-test
+  "run-star-terminates-on-bounded-relation"
+  (run*
+    q
+    (fresh
+      (l)
+      (== l (list 1 2 3))
+      (listo l)
+      (== q :ok)))
+  (list :ok))
+
+(mk-tests-run!)

lib/minikanren/tests/lengtho-i.sx

@@ -0,0 +1,28 @@
+;; lib/minikanren/tests/lengtho-i.sx — integer-indexed length (fast).
+
+(mk-test "lengtho-i-empty" (run* q (lengtho-i (list) q)) (list 0))
+(mk-test
+  "lengtho-i-singleton"
+  (run* q (lengtho-i (list :a) q))
+  (list 1))
+(mk-test
+  "lengtho-i-three"
+  (run* q (lengtho-i (list 1 2 3) q))
+  (list 3))
+(mk-test
+  "lengtho-i-five"
+  (run*
+    q
+    (lengtho-i
+      (list 1 2 3 4 5)
+      q))
+  (list 5))
+
+(mk-test
+  "lengtho-i-mixed-types"
+  (run*
+    q
+    (lengtho-i (list 1 "two" :three (list 4 5)) q))
+  (list 4))
+
+(mk-tests-run!)

lib/minikanren/tests/list-relations.sx

@@ -0,0 +1,126 @@
+;; lib/minikanren/tests/list-relations.sx — rembero, assoco, nth-o, samelengtho.
+
+;; --- rembero (remove first occurrence) ---
+
+(mk-test
+  "rembero-element-present"
+  (run*
+    q
+    (rembero 2 (list 1 2 3 2) q))
+  (list (list 1 3 2)))
+
+(mk-test
+  "rembero-element-not-present"
+  (run* q (rembero 99 (list 1 2 3) q))
+  (list (list 1 2 3)))
+
+(mk-test
+  "rembero-empty"
+  (run* q (rembero 1 (list) q))
+  (list (list)))
+
+(mk-test
+  "rembero-only-element"
+  (run* q (rembero 5 (list 5) q))
+  (list (list)))
+
+(mk-test
+  "rembero-first-of-many"
+  (run*
+    q
+    (rembero 1 (list 1 2 3 4) q))
+  (list (list 2 3 4)))
+
+;; --- assoco (alist lookup) ---
+
+(define
+  test-pairs
+  (list
+    (list "alice" 30)
+    (list "bob" 25)
+    (list "carol" 35)))
+
+(mk-test
+  "assoco-found"
+  (run* q (assoco "bob" test-pairs q))
+  (list 25))
+
+(mk-test
+  "assoco-first"
+  (run* q (assoco "alice" test-pairs q))
+  (list 30))
+
+(mk-test "assoco-missing" (run* q (assoco "dave" test-pairs q)) (list))
+
+(mk-test
+  "assoco-find-keys-with-value"
+  (run* q (assoco q test-pairs 25))
+  (list "bob"))
+
+;; --- nth-o (Peano-indexed access) ---
+
+(mk-test
+  "nth-o-zero"
+  (run* q (nth-o :z (list 10 20 30) q))
+  (list 10))
+
+(mk-test
+  "nth-o-one"
+  (run* q (nth-o (list :s :z) (list 10 20 30) q))
+  (list 20))
+
+(mk-test
+  "nth-o-two"
+  (run*
+    q
+    (nth-o (list :s (list :s :z)) (list 10 20 30) q))
+  (list 30))
+
+(mk-test
+  "nth-o-out-of-range"
+  (run*
+    q
+    (nth-o
+      (list :s (list :s (list :s :z)))
+      (list 10 20 30)
+      q))
+  (list))
+
+;; --- samelengtho ---
+
+(mk-test
+  "samelengtho-equal"
+  (run*
+    q
+    (samelengtho (list 1 2 3) (list :a :b :c)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "samelengtho-different-fails"
+  (run* q (samelengtho (list 1 2) (list :a :b :c)))
+  (list))
+
+(mk-test
+  "samelengtho-empty-equal"
+  (run* q (samelengtho (list) (list)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "samelengtho-builds-vars"
+  (run 1 q (samelengtho (list 1 2 3) q))
+  (list (list (make-symbol "_.0") (make-symbol "_.1") (make-symbol "_.2"))))
+
+(mk-test
+  "samelengtho-enumerates-pairs"
+  (run
+    3
+    q
+    (fresh (l1 l2) (samelengtho l1 l2) (== q (list l1 l2))))
+  (list
+    (list (list) (list))
+    (list (list (make-symbol "_.0")) (list (make-symbol "_.1")))
+    (list
+      (list (make-symbol "_.0") (make-symbol "_.1"))
+      (list (make-symbol "_.2") (make-symbol "_.3")))))
+
+(mk-tests-run!)

lib/minikanren/tests/mapo.sx

@@ -0,0 +1,62 @@
+;; lib/minikanren/tests/mapo.sx — relational map.
+
+(mk-test
+  "mapo-identity"
+  (run*
+    q
+    (mapo (fn (a b) (== a b)) (list 1 2 3) q))
+  (list (list 1 2 3)))
+
+(mk-test
+  "mapo-tag-each"
+  (run*
+    q
+    (mapo
+      (fn (a b) (== b (list :tag a)))
+      (list 1 2 3)
+      q))
+  (list
+    (list
+      (list :tag 1)
+      (list :tag 2)
+      (list :tag 3))))
+
+(mk-test
+  "mapo-backward"
+  (run*
+    q
+    (mapo (fn (a b) (== a b)) q (list 1 2 3)))
+  (list (list 1 2 3)))
+
+(mk-test
+  "mapo-empty"
+  (run* q (mapo (fn (a b) (== a b)) (list) q))
+  (list (list)))
+
+(mk-test
+  "mapo-duplicate"
+  (run* q (mapo (fn (a b) (== b (list a a))) (list :x :y) q))
+  (list (list (list :x :x) (list :y :y))))
+
+(mk-test
+  "mapo-different-length-fails"
+  (run*
+    q
+    (mapo
+      (fn (a b) (== a b))
+      (list 1 2)
+      (list 1 2 3)))
+  (list))
+
+;; mapo + arithmetic via intarith
+(mk-test
+  "mapo-square-each"
+  (run*
+    q
+    (mapo
+      (fn (a b) (*o-i a a b))
+      (list 1 2 3 4)
+      q))
+  (list (list 1 4 9 16)))
+
+(mk-tests-run!)

lib/minikanren/tests/matche.sx

@@ -0,0 +1,138 @@
+;; lib/minikanren/tests/matche.sx — Phase 5 piece D tests for `matche`.
+
+;; --- literal patterns ---
+
+(mk-test
+  "matche-literal-number"
+  (run* q (matche q (1 (== q 1))))
+  (list 1))
+
+(mk-test
+  "matche-literal-string"
+  (run* q (matche q ("hello" (== q "hello"))))
+  (list "hello"))
+
+(mk-test
+  "matche-literal-no-clause-matches"
+  (run*
+    q
+    (matche 7 (1 (== q :a)) (2 (== q :b))))
+  (list))
+
+;; --- variable patterns ---
+
+(mk-test
+  "matche-symbol-pattern"
+  (run* q (fresh (x) (== x 99) (matche x (a (== q a)))))
+  (list 99))
+
+(mk-test
+  "matche-wildcard"
+  (run* q (fresh (x) (== x 7) (matche x (_ (== q :any)))))
+  (list :any))
+
+;; --- list patterns ---
+
+(mk-test
+  "matche-empty-list"
+  (run* q (matche (list) (() (== q :ok))))
+  (list :ok))
+
+(mk-test
+  "matche-pair-binds"
+  (run*
+    q
+    (fresh
+      (x)
+      (== x (list 1 2))
+      (matche x ((a b) (== q (list b a))))))
+  (list (list 2 1)))
+
+(mk-test
+  "matche-triple-binds"
+  (run*
+    q
+    (fresh
+      (x)
+      (== x (list 1 2 3))
+      (matche x ((a b c) (== q (list :sum a b c))))))
+  (list (list :sum 1 2 3)))
+
+(mk-test
+  "matche-mixed-literal-and-var"
+  (run*
+    q
+    (fresh
+      (x)
+      (== x (list 1 99 3))
+      (matche x ((1 m 3) (== q m)))))
+  (list 99))
+
+;; --- multi-clause dispatch ---
+
+(mk-test
+  "matche-multi-clause-shape"
+  (run*
+    q
+    (fresh
+      (x)
+      (== x (list 5 6))
+      (matche
+        x
+        (() (== q :empty))
+        ((a) (== q (list :one a)))
+        ((a b) (== q (list :two a b))))))
+  (list (list :two 5 6)))
+
+(mk-test
+  "matche-three-shapes-via-fresh"
+  (run*
+    q
+    (fresh
+      (x)
+      (matche
+        x
+        (() (== q :empty))
+        ((a) (== q (list :one a)))
+        ((a b) (== q (list :two a b))))))
+  (list
+    :empty (list :one (make-symbol "_.0"))
+    (list :two (make-symbol "_.0") (make-symbol "_.1"))))
+
+;; --- nested patterns ---
+
+(mk-test
+  "matche-nested"
+  (run*
+    q
+    (fresh
+      (x)
+      (==
+        x
+        (list (list 1 2) (list 3 4)))
+      (matche x (((a b) (c d)) (== q (list a b c d))))))
+  (list (list 1 2 3 4)))
+
+;; --- repeated var names create the same fresh var → must unify ---
+
+(mk-test
+  "matche-repeated-var-implies-equality"
+  (run*
+    q
+    (fresh
+      (x)
+      (== x (list 7 7))
+      (matche x ((a a) (== q a)))))
+  (list 7))
+
+(mk-test
+  "matche-repeated-var-mismatch-fails"
+  (run*
+    q
+    (fresh
+      (x)
+      (== x (list 7 8))
+      (matche x ((a a) (== q a)))))
+  (list))
+
+(mk-tests-run!)

lib/minikanren/tests/minmax.sx

@@ -0,0 +1,49 @@
+;; lib/minikanren/tests/minmax.sx — mino + maxo via intarith.
+
+(mk-test
+  "mino-singleton"
+  (run* q (mino (list 7) q))
+  (list 7))
+(mk-test
+  "mino-of-3"
+  (run* q (mino (list 5 1 3) q))
+  (list 1))
+(mk-test
+  "mino-of-5"
+  (run*
+    q
+    (mino (list 5 1 3 2 4) q))
+  (list 1))
+(mk-test
+  "mino-with-dups"
+  (run* q (mino (list 3 3 3) q))
+  (list 3))
+(mk-test "mino-empty-fails" (run* q (mino (list) q)) (list))
+
+(mk-test
+  "maxo-singleton"
+  (run* q (maxo (list 7) q))
+  (list 7))
+(mk-test
+  "maxo-of-5"
+  (run*
+    q
+    (maxo (list 5 1 3 2 4) q))
+  (list 5))
+(mk-test
+  "maxo-of-negs"
+  (run* q (maxo (list -5 -1 -3) q))
+  (list -1))
+
+(mk-test
+  "min-and-max-of-list"
+  (run*
+    q
+    (fresh
+      (mn mx)
+      (mino (list 5 1 3 2 4) mn)
+      (maxo (list 5 1 3 2 4) mx)
+      (== q (list mn mx))))
+  (list (list 1 5)))
+
+(mk-tests-run!)

lib/minikanren/tests/nafc.sx

@@ -0,0 +1,50 @@
+;; lib/minikanren/tests/nafc.sx — Phase 5 piece C tests for `nafc`.
+
+(mk-test
+  "nafc-failed-goal-succeeds"
+  (run* q (nafc (== 1 2)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "nafc-successful-goal-fails"
+  (run* q (nafc (== 1 1)))
+  (list))
+
+(mk-test
+  "nafc-double-negation"
+  (run* q (nafc (nafc (== 1 1))))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "nafc-with-conde-no-clauses-succeed"
+  (run*
+    q
+    (nafc
+      (conde ((== 1 2)) ((== 3 4)))))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "nafc-with-conde-some-clause-succeeds-fails"
+  (run*
+    q
+    (nafc
+      (conde ((== 1 1)) ((== 3 4)))))
+  (list))
+
+;; --- composing nafc with == as a guard ---
+
+(mk-test
+  "nafc-as-guard"
+  (run*
+    q
+    (fresh (x) (== x 5) (nafc (== x 99)) (== q x)))
+  (list 5))
+
+(mk-test
+  "nafc-guard-blocking"
+  (run*
+    q
+    (fresh (x) (== x 5) (nafc (== x 5)) (== q x)))
+  (list))
+
+(mk-tests-run!)

lib/minikanren/tests/not-membero.sx

@@ -0,0 +1,29 @@
+;; lib/minikanren/tests/not-membero.sx — relational "not in list".
+
+(mk-test
+  "not-membero-absent"
+  (run* q (not-membero 99 (list 1 2 3)))
+  (list (make-symbol "_.0")))
+(mk-test
+  "not-membero-present"
+  (run* q (not-membero 2 (list 1 2 3)))
+  (list))
+(mk-test
+  "not-membero-empty"
+  (run* q (not-membero 1 (list)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "not-membero-as-filter"
+  (run*
+    q
+    (fresh
+      (x)
+      (membero
+        x
+        (list 1 2 3 4 5))
+      (not-membero x (list 2 4))
+      (== q x)))
+  (list 1 3 5))
+
+(mk-tests-run!)

lib/minikanren/tests/nub-o.sx

@@ -0,0 +1,31 @@
+;; lib/minikanren/tests/nub-o.sx — relational dedupe (keep last occurrence).
+
+(mk-test "nub-o-empty" (run* q (nub-o (list) q)) (list (list)))
+
+(mk-test
+  "nub-o-no-duplicates"
+  (run* q (nub-o (list 1 2 3) q))
+  (list (list 1 2 3)))
+
+(mk-test
+  "nub-o-with-duplicates"
+  (run*
+    q
+    (nub-o
+      (list 1 2 1 3 2 4)
+      q))
+  (list (list 1 3 2 4)))
+
+(mk-test
+  "nub-o-all-same"
+  (let
+    ((res (run* q (nub-o (list 1 1 1) q))))
+    (every? (fn (r) (= r (list 1))) res))
+  true)
+
+(mk-test
+  "nub-o-keeps-last"
+  (run* q (nub-o (list 1 2 1) q))
+  (list (list 2 1)))
+
+(mk-tests-run!)

lib/minikanren/tests/pairlisto.sx

@@ -0,0 +1,41 @@
+;; lib/minikanren/tests/pairlisto.sx — zip two lists into pair list.
+
+(mk-test
+  "pairlisto-empty"
+  (run* q (pairlisto (list) (list) q))
+  (list (list)))
+
+(mk-test
+  "pairlisto-equal-lengths"
+  (run*
+    q
+    (pairlisto (list 1 2 3) (list :a :b :c) q))
+  (list
+    (list (list 1 :a) (list 2 :b) (list 3 :c))))
+
+(mk-test
+  "pairlisto-recover-l1"
+  (run*
+    q
+    (pairlisto
+      q
+      (list :a :b :c)
+      (list (list 10 :a) (list 20 :b) (list 30 :c))))
+  (list (list 10 20 30)))
+
+(mk-test
+  "pairlisto-recover-l2"
+  (run*
+    q
+    (pairlisto
+      (list 1 2 3)
+      q
+      (list (list 1 :x) (list 2 :y) (list 3 :z))))
+  (list (list :x :y :z)))
+
+(mk-test
+  "pairlisto-different-lengths-fails"
+  (run* q (pairlisto (list 1 2) (list :a :b :c) q))
+  (list))
+
+(mk-tests-run!)

lib/minikanren/tests/palindromeo.sx

@@ -0,0 +1,44 @@
+;; lib/minikanren/tests/palindromeo.sx — palindromic list relation.
+
+(mk-test
+  "palindromeo-empty"
+  (run* q (palindromeo (list)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "palindromeo-singleton"
+  (run* q (palindromeo (list :a)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "palindromeo-pair-equal"
+  (run* q (palindromeo (list 1 1)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "palindromeo-pair-unequal-fails"
+  (run* q (palindromeo (list 1 2)))
+  (list))
+
+(mk-test
+  "palindromeo-five-yes"
+  (run*
+    q
+    (palindromeo
+      (list 1 2 3 2 1)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "palindromeo-five-no"
+  (run*
+    q
+    (palindromeo
+      (list 1 2 3 4 5)))
+  (list))
+
+(mk-test
+  "palindromeo-strings"
+  (run* q (palindromeo (list "a" "b" "a")))
+  (list (make-symbol "_.0")))
+
+(mk-tests-run!)

lib/minikanren/tests/parity.sx

@@ -0,0 +1,58 @@
+;; lib/minikanren/tests/parity.sx — eveno + oddo Peano predicates.
+
+(define
+  mk-nat
+  (fn (n) (if (= n 0) :z (list :s (mk-nat (- n 1))))))
+
+(mk-test "eveno-zero" (run* q (eveno :z)) (list (make-symbol "_.0")))
+(mk-test
+  "eveno-2"
+  (run* q (eveno (mk-nat 2)))
+  (list (make-symbol "_.0")))
+(mk-test
+  "eveno-4"
+  (run* q (eveno (mk-nat 4)))
+  (list (make-symbol "_.0")))
+(mk-test "eveno-1-fails" (run* q (eveno (mk-nat 1))) (list))
+(mk-test "eveno-3-fails" (run* q (eveno (mk-nat 3))) (list))
+
+(mk-test
+  "oddo-1"
+  (run* q (oddo (mk-nat 1)))
+  (list (make-symbol "_.0")))
+(mk-test
+  "oddo-3"
+  (run* q (oddo (mk-nat 3)))
+  (list (make-symbol "_.0")))
+(mk-test "oddo-zero-fails" (run* q (oddo :z)) (list))
+(mk-test "oddo-2-fails" (run* q (oddo (mk-nat 2))) (list))
+
+;; Enumerate small evens.
+(mk-test
+  "eveno-enumerates"
+  (run 4 q (eveno q))
+  (list
+    (mk-nat 0)
+    (mk-nat 2)
+    (mk-nat 4)
+    (mk-nat 6)))
+
+;; Enumerate small odds.
+(mk-test
+  "oddo-enumerates"
+  (run 4 q (oddo q))
+  (list
+    (mk-nat 1)
+    (mk-nat 3)
+    (mk-nat 5)
+    (mk-nat 7)))
+
+;; A number is even XOR odd (no overlap).
+(mk-test
+  "even-odd-no-overlap"
+  (run*
+    q
+    (mk-conj (eveno (mk-nat 4)) (oddo (mk-nat 4))))
+  (list))
+
+(mk-tests-run!)

lib/minikanren/tests/partitiono.sx

@@ -0,0 +1,75 @@
+;; lib/minikanren/tests/partitiono.sx — partition list by predicate.
+
+(mk-test
+  "partitiono-empty"
+  (run*
+    q
+    (fresh
+      (yes no)
+      (partitiono (fn (x) (== x 1)) (list) yes no)
+      (== q (list yes no))))
+  (list (list (list) (list))))
+
+(mk-test
+  "partitiono-by-equality"
+  (run*
+    q
+    (fresh
+      (yes no)
+      (partitiono
+        (fn (x) (== x 2))
+        (list 1 2 3 2 4)
+        yes
+        no)
+      (== q (list yes no))))
+  (list
+    (list
+      (list 2 2)
+      (list 1 3 4))))
+
+(mk-test
+  "partitiono-by-numeric-pred"
+  (run*
+    q
+    (fresh
+      (yes no)
+      (partitiono
+        (fn (x) (lto-i x 5))
+        (list 1 7 2 8 3)
+        yes
+        no)
+      (== q (list yes no))))
+  (list
+    (list
+      (list 1 2 3)
+      (list 7 8))))
+
+(mk-test
+  "partitiono-all-yes"
+  (run*
+    q
+    (fresh
+      (yes no)
+      (partitiono
+        (fn (x) (lto-i x 100))
+        (list 1 2 3)
+        yes
+        no)
+      (== q (list yes no))))
+  (list (list (list 1 2 3) (list))))
+
+(mk-test
+  "partitiono-all-no"
+  (run*
+    q
+    (fresh
+      (yes no)
+      (partitiono
+        (fn (x) (lto-i 100 x))
+        (list 1 2 3)
+        yes
+        no)
+      (== q (list yes no))))
+  (list (list (list) (list 1 2 3))))
+
+(mk-tests-run!)

lib/minikanren/tests/path-cycle-free.sx

@@ -0,0 +1,40 @@
+;; lib/minikanren/tests/path-cycle-free.sx — cycle-free reachability search.
+;;
+;; Threads a "visited" accumulator through the recursion, using nafc +
+;; membero to prevent revisiting nodes. Demonstrates how to make the
+;; cyclic-graph divergence problem (see tests/cyclic-graph.sx) tractable
+;; for graphs with cycles, without invoking Phase-7 tabling.
+
+(define
+  cf-edges
+  (list (list :a :b) (list :b :a) (list :b :c) (list :c :d) (list :d :a)))      ; another cycle
+
+(define cf-edgeo (fn (from to) (membero (list from to) cf-edges)))
+
+(define
+  patho-no-cycles
+  (fn
+    (x y visited path)
+    (conde
+      ((cf-edgeo x y) (nafc (membero y visited)) (== path (list x y)))
+      ((fresh (z mid v-prime) (cf-edgeo x z) (nafc (membero z visited)) (conso z visited v-prime) (patho-no-cycles z y v-prime mid) (conso x mid path))))))
+
+(define cf-patho (fn (x y path) (patho-no-cycles x y (list x) path)))
+
+(mk-test
+  "cycle-free-finds-finitely"
+  (let
+    ((paths (run* q (cf-patho :a :d q))))
+    (and
+      (>= (len paths) 1)
+      (every? (fn (p) (and (= (first p) :a) (= (last p) :d))) paths)))
+  true)
+
+(mk-test
+  "cycle-free-direct-edge"
+  (run* q (cf-patho :a :b q))
+  (list (list :a :b)))
+
+(mk-test "cycle-free-no-self-loop" (run* q (cf-patho :a :a q)) (list))
+
+(mk-tests-run!)

lib/minikanren/tests/peano.sx

@@ -0,0 +1,119 @@
+;; lib/minikanren/tests/peano.sx — Peano arithmetic.
+;;
+;; Builds Peano numbers via a host-side helper so tests stay readable.
+;; (mk-nat 3) → (:s (:s (:s :z))).
+
+(define
+  mk-nat
+  (fn (n) (if (= n 0) :z (list :s (mk-nat (- n 1))))))
+
+;; --- zeroo ---
+
+(mk-test
+  "zeroo-zero-succeeds"
+  (run* q (zeroo :z))
+  (list (make-symbol "_.0")))
+(mk-test
+  "zeroo-non-zero-fails"
+  (run* q (zeroo (mk-nat 1)))
+  (list))
+
+;; --- pluso forward ---
+
+(mk-test
+  "pluso-forward-2-3"
+  (run* q (pluso (mk-nat 2) (mk-nat 3) q))
+  (list (mk-nat 5)))
+
+(mk-test "pluso-forward-zero-zero" (run* q (pluso :z :z q)) (list :z))
+
+(mk-test
+  "pluso-forward-zero-n"
+  (run* q (pluso :z (mk-nat 4) q))
+  (list (mk-nat 4)))
+
+(mk-test
+  "pluso-forward-n-zero"
+  (run* q (pluso (mk-nat 4) :z q))
+  (list (mk-nat 4)))
+
+;; --- pluso backward ---
+
+(mk-test
+  "pluso-recover-augend"
+  (run* q (pluso q (mk-nat 2) (mk-nat 5)))
+  (list (mk-nat 3)))
+
+(mk-test
+  "pluso-recover-addend"
+  (run* q (pluso (mk-nat 2) q (mk-nat 5)))
+  (list (mk-nat 3)))
+
+(mk-test
+  "pluso-enumerate-pairs-summing-to-3"
+  (run*
+    q
+    (fresh (a b) (pluso a b (mk-nat 3)) (== q (list a b))))
+  (list
+    (list :z (mk-nat 3))
+    (list (mk-nat 1) (mk-nat 2))
+    (list (mk-nat 2) (mk-nat 1))
+    (list (mk-nat 3) :z)))
+
+;; --- minuso ---
+
+(mk-test
+  "minuso-5-2-3"
+  (run* q (minuso (mk-nat 5) (mk-nat 2) q))
+  (list (mk-nat 3)))
+
+(mk-test
+  "minuso-n-n-zero"
+  (run* q (minuso (mk-nat 7) (mk-nat 7) q))
+  (list :z))
+
+;; --- *o ---
+
+(mk-test
+  "times-2-3"
+  (run* q (*o (mk-nat 2) (mk-nat 3) q))
+  (list (mk-nat 6)))
+
+(mk-test
+  "times-zero-anything-zero"
+  (run* q (*o :z (mk-nat 99) q))
+  (list :z))
+
+(mk-test
+  "times-3-4"
+  (run* q (*o (mk-nat 3) (mk-nat 4) q))
+  (list (mk-nat 12)))
+
+;; --- lteo / lto ---
+
+(mk-test
+  "lteo-success"
+  (run 1 q (lteo (mk-nat 2) (mk-nat 5)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "lteo-equal-success"
+  (run 1 q (lteo (mk-nat 3) (mk-nat 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "lteo-greater-fails"
+  (run* q (lteo (mk-nat 5) (mk-nat 2)))
+  (list))
+
+(mk-test
+  "lto-strict-success"
+  (run 1 q (lto (mk-nat 2) (mk-nat 5)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "lto-equal-fails"
+  (run* q (lto (mk-nat 3) (mk-nat 3)))
+  (list))
+
+(mk-tests-run!)

lib/minikanren/tests/predicates.sx

@@ -0,0 +1,87 @@
+;; lib/minikanren/tests/predicates.sx — everyo, someo.
+
+;; --- everyo ---
+
+(mk-test
+  "everyo-empty-trivially-true"
+  (run* q (everyo (fn (x) (== x 1)) (list)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "everyo-all-match"
+  (run*
+    q
+    (everyo
+      (fn (x) (== x 1))
+      (list 1 1 1)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "everyo-some-mismatch"
+  (run*
+    q
+    (everyo
+      (fn (x) (== x 1))
+      (list 1 2 1)))
+  (list))
+
+(mk-test
+  "everyo-with-intarith"
+  (run*
+    q
+    (everyo
+      (fn (x) (lto-i x 10))
+      (list 1 5 9)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "everyo-with-intarith-fail"
+  (run*
+    q
+    (everyo
+      (fn (x) (lto-i x 5))
+      (list 1 5 9)))
+  (list))
+
+;; --- someo ---
+
+(mk-test
+  "someo-finds-element"
+  (run*
+    q
+    (someo
+      (fn (x) (== x 2))
+      (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "someo-not-found"
+  (run*
+    q
+    (someo
+      (fn (x) (== x 99))
+      (list 1 2 3)))
+  (list))
+
+(mk-test
+  "someo-empty-fails"
+  (run* q (someo (fn (x) (== x 1)) (list)))
+  (list))
+
+(mk-test
+  "someo-multiple-matches-yields-multiple"
+  (let
+    ((res (run* q (fresh (x) (someo (fn (y) (== y x)) (list 1 2 1)) (== q x)))))
+    (len res))
+  3)
+
+(mk-test
+  "someo-with-intarith"
+  (run*
+    q
+    (someo
+      (fn (x) (lto-i 100 x))
+      (list 5 50 200)))
+  (list (make-symbol "_.0")))
+
+(mk-tests-run!)

lib/minikanren/tests/prefix-suffix.sx

@@ -0,0 +1,76 @@
+;; lib/minikanren/tests/prefix-suffix.sx — appendo-derived sublist relations.
+
+(mk-test
+  "prefixo-empty"
+  (run* q (prefixo (list) (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "prefixo-full"
+  (run*
+    q
+    (prefixo
+      (list 1 2 3)
+      (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "prefixo-partial"
+  (run*
+    q
+    (prefixo
+      (list 1 2)
+      (list 1 2 3 4)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "prefixo-mismatch-fails"
+  (run*
+    q
+    (prefixo
+      (list 1 3)
+      (list 1 2 3)))
+  (list))
+
+(mk-test
+  "prefixo-enumerates-all"
+  (run* q (prefixo q (list 1 2 3)))
+  (list
+    (list)
+    (list 1)
+    (list 1 2)
+    (list 1 2 3)))
+
+(mk-test
+  "suffixo-empty"
+  (run* q (suffixo (list) (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "suffixo-full"
+  (run*
+    q
+    (suffixo
+      (list 1 2 3)
+      (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "suffixo-partial"
+  (run*
+    q
+    (suffixo
+      (list 2 3)
+      (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "suffixo-enumerates-all"
+  (run* q (suffixo q (list 1 2 3)))
+  (list
+    (list 1 2 3)
+    (list 2 3)
+    (list 3)
+    (list)))
+
+(mk-tests-run!)

lib/minikanren/tests/project.sx

@@ -0,0 +1,60 @@
+;; lib/minikanren/tests/project.sx — Phase 5 piece B tests for `project`.
+
+;; --- project rebinds vars to ground values for SX use ---
+
+(mk-test
+  "project-square-via-host"
+  (run* q (fresh (n) (== n 5) (project (n) (== q (* n n)))))
+  (list 25))
+
+(mk-test
+  "project-multi-vars"
+  (run*
+    q
+    (fresh
+      (a b)
+      (== a 3)
+      (== b 4)
+      (project (a b) (== q (+ a b)))))
+  (list 7))
+
+(mk-test
+  "project-with-string-host-op"
+  (run* q (fresh (s) (== s "hello") (project (s) (== q (str s "!")))))
+  (list "hello!"))
+
+;; --- project nested inside conde ---
+
+(mk-test
+  "project-inside-conde"
+  (run*
+    q
+    (fresh
+      (n)
+      (conde ((== n 3)) ((== n 4)))
+      (project (n) (== q (* n 10)))))
+  (list 30 40))
+
+;; --- project body can be multiple goals (mk-conj'd) ---
+
+(mk-test
+  "project-multi-goal-body"
+  (run*
+    q
+    (fresh
+      (n)
+      (== n 7)
+      (project (n) (== q (+ n 1)) (== q (+ n 1)))))
+  (list 8))
+
+(mk-test
+  "project-multi-goal-body-conflict"
+  (run*
+    q
+    (fresh
+      (n)
+      (== n 7)
+      (project (n) (== q (+ n 1)) (== q (+ n 2)))))
+  (list))
+
+(mk-tests-run!)

lib/minikanren/tests/pythag.sx

@@ -0,0 +1,36 @@
+;; lib/minikanren/tests/pythag.sx — Pythagorean triple search.
+;;
+;; Uses ino + intarith goals to find triples (a, b, c) with
+;; a, b, c ∈ [1..N], a ≤ b, a² + b² = c². With intarith escapes
+;; the search runs at host-arithmetic speed.
+
+(define
+  digits-1-10
+  (list
+    1
+    2
+    3
+    4
+    5
+    6
+    7
+    8
+    9
+    10))
+
+(mk-test
+  "pythag-triples-1-to-10"
+  (let
+    ((triples (run* q (fresh (a b c a-sq b-sq sum c-sq) (ino a digits-1-10) (ino b digits-1-10) (ino c digits-1-10) (lteo-i a b) (*o-i a a a-sq) (*o-i b b b-sq) (*o-i c c c-sq) (pluso-i a-sq b-sq sum) (== sum c-sq) (== q (list a b c))))))
+    (and
+      (= (len triples) 2)
+      (and
+        (some
+          (fn (t) (= t (list 3 4 5)))
+          triples)
+        (some
+          (fn (t) (= t (list 6 8 10)))
+          triples))))
+  true)
+
+(mk-tests-run!)

lib/minikanren/tests/queens-fd.sx

@@ -0,0 +1,97 @@
+;; lib/minikanren/tests/queens-fd.sx — N-queens via CLP(FD).
+;;
+;; Native FD propagation makes N-queens tractable: 4-queens finds both
+;; solutions instantly; 5-queens finds all 10 in seconds. Compare with
+;; the naive enumerate-then-filter version in queens.sx, which struggles
+;; past N=4.
+
+(define
+  fd-no-diag
+  (fn
+    (ci cj k)
+    (fresh
+      (a b)
+      (fd-plus cj k a)
+      (fd-plus ci k b)
+      (fd-neq ci a)
+      (fd-neq cj b))))
+
+(define
+  n-queens-4-fd
+  (fn
+    (cs)
+    (let
+      ((c1 (nth cs 0))
+        (c2 (nth cs 1))
+        (c3 (nth cs 2))
+        (c4 (nth cs 3)))
+      (mk-conj
+        (fd-in c1 (list 1 2 3 4))
+        (fd-in c2 (list 1 2 3 4))
+        (fd-in c3 (list 1 2 3 4))
+        (fd-in c4 (list 1 2 3 4))
+        (fd-distinct cs)
+        (fd-no-diag c1 c2 1)
+        (fd-no-diag c1 c3 2)
+        (fd-no-diag c1 c4 3)
+        (fd-no-diag c2 c3 1)
+        (fd-no-diag c2 c4 2)
+        (fd-no-diag c3 c4 1)
+        (fd-label cs)))))
+
+(define
+  n-queens-5-fd
+  (fn
+    (cs)
+    (let
+      ((c1 (nth cs 0))
+        (c2 (nth cs 1))
+        (c3 (nth cs 2))
+        (c4 (nth cs 3))
+        (c5 (nth cs 4)))
+      (mk-conj
+        (fd-in
+          c1
+          (list 1 2 3 4 5))
+        (fd-in
+          c2
+          (list 1 2 3 4 5))
+        (fd-in
+          c3
+          (list 1 2 3 4 5))
+        (fd-in
+          c4
+          (list 1 2 3 4 5))
+        (fd-in
+          c5
+          (list 1 2 3 4 5))
+        (fd-distinct cs)
+        (fd-no-diag c1 c2 1)
+        (fd-no-diag c1 c3 2)
+        (fd-no-diag c1 c4 3)
+        (fd-no-diag c1 c5 4)
+        (fd-no-diag c2 c3 1)
+        (fd-no-diag c2 c4 2)
+        (fd-no-diag c2 c5 3)
+        (fd-no-diag c3 c4 1)
+        (fd-no-diag c3 c5 2)
+        (fd-no-diag c4 c5 1)
+        (fd-label cs)))))
+
+(mk-test
+  "n-queens-4-fd-two-solutions"
+  (run*
+    q
+    (fresh (a b c d) (== q (list a b c d)) (n-queens-4-fd (list a b c d))))
+  (list
+    (list 2 4 1 3)
+    (list 3 1 4 2)))
+
+(mk-test
+  "n-queens-5-fd-ten-solutions"
+  (let
+    ((sols (run* q (fresh (a b c d e) (== q (list a b c d e)) (n-queens-5-fd (list a b c d e))))))
+    (= (len sols) 10))
+  true)
+
+(mk-tests-run!)

lib/minikanren/tests/queens.sx

@@ -0,0 +1,45 @@
+;; lib/minikanren/tests/queens.sx — N-queens, the classic miniKanren benchmark.
+
+;; --- safe-diag (helper) ---
+
+(mk-test
+  "safe-diag-different-cols-different-distance"
+  (run* q (safe-diag 1 4 2))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "safe-diag-same-distance-fails"
+  (run* q (safe-diag 1 4 3))
+  (list))
+
+(mk-test
+  "safe-diag-same-distance-other-direction-fails"
+  (run* q (safe-diag 4 1 3))
+  (list))
+
+;; --- ino-each / range ---
+
+(mk-test
+  "range-1-to-4"
+  (range-1-to-n 4)
+  (list 1 2 3 4))
+(mk-test "range-empty" (range-1-to-n 0) (list))
+
+;; --- 4-queens: two solutions ---
+
+(mk-test
+  "queens-4"
+  (let
+    ((sols (run* q (fresh (a b c d) (== q (list a b c d)) (queens-cols (list a b c d) 4)))))
+    (and
+      (= (len sols) 2)
+      (and
+        (some
+          (fn (s) (= s (list 2 4 1 3)))
+          sols)
+        (some
+          (fn (s) (= s (list 3 1 4 2)))
+          sols))))
+  true)
+
+(mk-tests-run!)

lib/minikanren/tests/rdb.sx

@@ -0,0 +1,90 @@
+;; lib/minikanren/tests/rdb.sx — relational database queries.
+;;
+;; Demonstrates how miniKanren can serve as a Datalog-style query engine
+;; over fact tables. Tables are SX lists of tuples; the relation just
+;; wraps `membero` over the table.
+
+(define
+  rdb-employees
+  (list
+    (list "alice" "engineering" 100000)
+    (list "bob" "marketing" 80000)
+    (list "carol" "engineering" 90000)
+    (list "dave" "engineering" 85000)
+    (list "eve" "sales" 75000)))
+
+(define
+  rdb-projects
+  (list
+    (list "alice" "compiler")
+    (list "carol" "compiler")
+    (list "dave" "runtime")
+    (list "alice" "runtime")
+    (list "eve" "outreach")))
+
+;; Relation views over the tables.
+
+(define
+  employees
+  (fn (name dept salary) (membero (list name dept salary) rdb-employees)))
+
+(define
+  on-project
+  (fn (name project) (membero (list name project) rdb-projects)))
+
+;; --- queries ---
+
+(mk-test
+  "rdb-engineering-staff"
+  (let
+    ((res (run* q (fresh (n s) (employees n "engineering" s) (== q n)))))
+    (and
+      (= (len res) 3)
+      (and
+        (some (fn (n) (= n "alice")) res)
+        (and
+          (some (fn (n) (= n "carol")) res)
+          (some (fn (n) (= n "dave")) res)))))
+  true)
+
+(mk-test
+  "rdb-high-salary"
+  (let
+    ((res (run* q (fresh (n d s) (employees n d s) (lto-i 85000 s) (== q (list n s))))))
+    (and
+      (= (len res) 2)
+      (and
+        (some (fn (r) (= r (list "alice" 100000))) res)
+        (some (fn (r) (= r (list "carol" 90000))) res))))
+  true)
+
+(mk-test
+  "rdb-join-employee-project"
+  (let
+    ((res (run* q (fresh (n d s) (employees n d s) (on-project n "compiler") (== q n)))))
+    (and
+      (= (len res) 2)
+      (and
+        (some (fn (n) (= n "alice")) res)
+        (some (fn (n) (= n "carol")) res))))
+  true)
+
+(mk-test
+  "rdb-engineers-on-runtime"
+  (let
+    ((res (run* q (fresh (n s) (employees n "engineering" s) (on-project n "runtime") (== q n)))))
+    (and
+      (= (len res) 2)
+      (and
+        (some (fn (n) (= n "alice")) res)
+        (some (fn (n) (= n "dave")) res))))
+  true)
+
+(mk-test
+  "rdb-people-on-multiple-projects"
+  (let
+    ((res (run* q (fresh (n p1 p2) (on-project n p1) (on-project n p2) (nafc (== p1 p2)) (== q n)))))
+    (some (fn (n) (= n "alice")) res))
+  true)
+
+(mk-tests-run!)

lib/minikanren/tests/relations.sx

@@ -0,0 +1,291 @@
+;; lib/minikanren/tests/relations.sx — Phase 4 standard relations.
+;;
+;; Includes the classic miniKanren canaries: appendo forwards / backwards /
+;; bidirectionally, membero, listo enumeration.
+
+;; --- nullo / pairo ---
+
+(mk-test
+  "nullo-empty-succeeds"
+  (run* q (nullo (list)))
+  (list (make-symbol "_.0")))
+
+(mk-test "nullo-non-empty-fails" (run* q (nullo (list 1))) (list))
+
+(mk-test
+  "pairo-non-empty-succeeds"
+  (run* q (pairo (list 1 2)))
+  (list (make-symbol "_.0")))
+
+(mk-test "pairo-empty-fails" (run* q (pairo (list))) (list))
+
+;; --- caro / cdro / firsto / resto ---
+
+(mk-test
+  "caro-extracts-head"
+  (run* q (caro (list 1 2 3) q))
+  (list 1))
+
+(mk-test
+  "cdro-extracts-tail"
+  (run* q (cdro (list 1 2 3) q))
+  (list (list 2 3)))
+
+(mk-test
+  "firsto-alias-of-caro"
+  (run* q (firsto (list 10 20) q))
+  (list 10))
+
+(mk-test
+  "resto-alias-of-cdro"
+  (run* q (resto (list 10 20) q))
+  (list (list 20)))
+
+(mk-test
+  "caro-cdro-build"
+  (run*
+    q
+    (fresh
+      (h t)
+      (caro (list 1 2 3) h)
+      (cdro (list 1 2 3) t)
+      (== q (list h t))))
+  (list (list 1 (list 2 3))))
+
+;; --- conso ---
+
+(mk-test
+  "conso-forward"
+  (run* q (conso 0 (list 1 2 3) q))
+  (list (list 0 1 2 3)))
+
+(mk-test
+  "conso-extract-head"
+  (run*
+    q
+    (conso
+      q
+      (list 2 3)
+      (list 1 2 3)))
+  (list 1))
+
+(mk-test
+  "conso-extract-tail"
+  (run* q (conso 1 q (list 1 2 3)))
+  (list (list 2 3)))
+
+;; --- listo ---
+
+(mk-test
+  "listo-empty-succeeds"
+  (run* q (listo (list)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "listo-finite-list-succeeds"
+  (run* q (listo (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "listo-enumerates-shapes"
+  (run 3 q (listo q))
+  (list
+    (list)
+    (list (make-symbol "_.0"))
+    (list (make-symbol "_.0") (make-symbol "_.1"))))
+
+;; --- appendo: the canary ---
+
+(mk-test
+  "appendo-forward-simple"
+  (run*
+    q
+    (appendo (list 1 2) (list 3 4) q))
+  (list (list 1 2 3 4)))
+
+(mk-test
+  "appendo-forward-empty-l"
+  (run* q (appendo (list) (list 3 4) q))
+  (list (list 3 4)))
+
+(mk-test
+  "appendo-forward-empty-s"
+  (run* q (appendo (list 1 2) (list) q))
+  (list (list 1 2)))
+
+(mk-test
+  "appendo-recovers-tail"
+  (run*
+    q
+    (appendo
+      (list 1 2)
+      q
+      (list 1 2 3 4)))
+  (list (list 3 4)))
+
+(mk-test
+  "appendo-recovers-prefix"
+  (run*
+    q
+    (appendo
+      q
+      (list 3 4)
+      (list 1 2 3 4)))
+  (list (list 1 2)))
+
+(mk-test
+  "appendo-backward-all-splits"
+  (run*
+    q
+    (fresh
+      (l s)
+      (appendo l s (list 1 2 3))
+      (== q (list l s))))
+  (list
+    (list (list) (list 1 2 3))
+    (list (list 1) (list 2 3))
+    (list (list 1 2) (list 3))
+    (list (list 1 2 3) (list))))
+
+(mk-test
+  "appendo-empty-empty-empty"
+  (run* q (appendo (list) (list) q))
+  (list (list)))
+
+;; --- membero ---
+
+(mk-test
+  "membero-element-present"
+  (run
+    1
+    q
+    (membero 2 (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "membero-element-absent-empty"
+  (run* q (membero 99 (list 1 2 3)))
+  (list))
+
+(mk-test
+  "membero-enumerates"
+  (run* q (membero q (list "a" "b" "c")))
+  (list "a" "b" "c"))
+
+;; --- reverseo ---
+
+(mk-test
+  "reverseo-forward"
+  (run* q (reverseo (list 1 2 3) q))
+  (list (list 3 2 1)))
+
+(mk-test "reverseo-empty" (run* q (reverseo (list) q)) (list (list)))
+
+(mk-test
+  "reverseo-singleton"
+  (run* q (reverseo (list 42) q))
+  (list (list 42)))
+
+(mk-test
+  "reverseo-five"
+  (run*
+    q
+    (reverseo (list 1 2 3 4 5) q))
+  (list (list 5 4 3 2 1)))
+
+(mk-test
+  "reverseo-backward-one"
+  (run 1 q (reverseo q (list 1 2 3)))
+  (list (list 3 2 1)))
+
+(mk-test
+  "reverseo-round-trip"
+  (run*
+    q
+    (fresh (mid) (reverseo (list "a" "b" "c") mid) (reverseo mid q)))
+  (list (list "a" "b" "c")))
+
+;; --- lengtho (Peano-style) ---
+
+(mk-test "lengtho-empty-is-z" (run* q (lengtho (list) q)) (list :z))
+
+(mk-test
+  "lengtho-of-3"
+  (run* q (lengtho (list "a" "b" "c") q))
+  (list (list :s (list :s (list :s :z)))))
+
+(mk-test
+  "lengtho-empty-from-zero"
+  (run 1 q (lengtho q :z))
+  (list (list)))
+
+(mk-test
+  "lengtho-enumerates-of-length-2"
+  (run 1 q (lengtho q (list :s (list :s :z))))
+  (list (list (make-symbol "_.0") (make-symbol "_.1"))))
+
+;; --- inserto ---
+
+(mk-test
+  "inserto-front"
+  (run* q (inserto 0 (list 1 2 3) q))
+  (list
+    (list 0 1 2 3)
+    (list 1 0 2 3)
+    (list 1 2 0 3)
+    (list 1 2 3 0)))
+
+(mk-test
+  "inserto-empty"
+  (run* q (inserto 0 (list) q))
+  (list (list 0)))
+
+;; --- permuteo ---
+
+(mk-test "permuteo-empty" (run* q (permuteo (list) q)) (list (list)))
+
+(mk-test
+  "permuteo-singleton"
+  (run* q (permuteo (list 42) q))
+  (list (list 42)))
+
+(mk-test
+  "permuteo-two"
+  (run* q (permuteo (list 1 2) q))
+  (list (list 1 2) (list 2 1)))
+
+(mk-test
+  "permuteo-three-as-set"
+  (let
+    ((perms (run* q (permuteo (list 1 2 3) q))))
+    (and
+      (= (len perms) 6)
+      (and
+        (some (fn (p) (= p (list 1 2 3))) perms)
+        (and
+          (some
+            (fn (p) (= p (list 2 1 3)))
+            perms)
+          (and
+            (some
+              (fn (p) (= p (list 1 3 2)))
+              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-test
+  "permuteo-backward-finds-input"
+  (run 1 q (permuteo q (list "a" "b" "c")))
+  (list (list "a" "b" "c")))
+
+(mk-tests-run!)

lib/minikanren/tests/removeo-allo.sx

@@ -0,0 +1,39 @@
+;; lib/minikanren/tests/removeo-allo.sx — remove every occurrence of x.
+
+(mk-test
+  "removeo-allo-multi"
+  (run*
+    q
+    (removeo-allo
+      2
+      (list 1 2 3 2 4 2)
+      q))
+  (list (list 1 3 4)))
+
+(mk-test
+  "removeo-allo-single"
+  (run*
+    q
+    (removeo-allo 2 (list 1 2 3) q))
+  (list (list 1 3)))
+
+(mk-test
+  "removeo-allo-no-match"
+  (run*
+    q
+    (removeo-allo 99 (list 1 2 3) q))
+  (list (list 1 2 3)))
+
+(mk-test
+  "removeo-allo-everything"
+  (run*
+    q
+    (removeo-allo 1 (list 1 1 1) q))
+  (list (list)))
+
+(mk-test
+  "removeo-allo-empty"
+  (run* q (removeo-allo 1 (list) q))
+  (list (list)))
+
+(mk-tests-run!)

lib/minikanren/tests/repeato-concato.sx

@@ -0,0 +1,69 @@
+;; lib/minikanren/tests/repeato-concato.sx — repeat element n times +
+;; concatenate a list of lists.
+
+(define
+  mk-nat
+  (fn (n) (if (= n 0) :z (list :s (mk-nat (- n 1))))))
+
+;; --- repeato ---
+
+(mk-test
+  "repeato-zero"
+  (run* q (repeato :a (mk-nat 0) q))
+  (list (list)))
+(mk-test
+  "repeato-one"
+  (run* q (repeato :a (mk-nat 1) q))
+  (list (list :a)))
+(mk-test
+  "repeato-three"
+  (run* q (repeato :a (mk-nat 3) q))
+  (list (list :a :a :a)))
+
+(mk-test
+  "repeato-numeric"
+  (run* q (repeato 7 (mk-nat 4) q))
+  (list (list 7 7 7 7)))
+
+(mk-test
+  "repeato-recover-count"
+  (run* q (repeato :x q (list :x :x :x :x)))
+  (list (mk-nat 4)))
+
+;; --- concato ---
+
+(mk-test "concato-empty" (run* q (concato (list) q)) (list (list)))
+
+(mk-test
+  "concato-single"
+  (run* q (concato (list (list 1 2 3)) q))
+  (list (list 1 2 3)))
+
+(mk-test
+  "concato-multi"
+  (run*
+    q
+    (concato
+      (list
+        (list 1 2)
+        (list 3)
+        (list 4 5 6))
+      q))
+  (list
+    (list 1 2 3 4 5 6)))
+
+(mk-test
+  "concato-all-empty"
+  (run* q (concato (list (list) (list) (list)) q))
+  (list (list)))
+
+(mk-test
+  "concato-mixed-empty"
+  (run*
+    q
+    (concato
+      (list (list 1) (list) (list 2 3))
+      q))
+  (list (list 1 2 3)))
+
+(mk-tests-run!)

lib/minikanren/tests/rev-acco.sx

@@ -0,0 +1,46 @@
+;; lib/minikanren/tests/rev-acco.sx — accumulator-style reverse.
+;;
+;; Faster than reverseo for forward queries (no quadratic appendos).
+;; Trade-off: rev-acco is asymmetric (acc=initial-empty for the public
+;; interface), so it does not cleanly run backwards in run* the way
+;; reverseo does.
+
+(mk-test "rev-2o-empty" (run* q (rev-2o (list) q)) (list (list)))
+
+(mk-test
+  "rev-2o-singleton"
+  (run* q (rev-2o (list 7) q))
+  (list (list 7)))
+
+(mk-test
+  "rev-2o-three"
+  (run* q (rev-2o (list 1 2 3) q))
+  (list (list 3 2 1)))
+
+(mk-test
+  "rev-2o-five"
+  (run*
+    q
+    (rev-2o (list 1 2 3 4 5) q))
+  (list (list 5 4 3 2 1)))
+
+(mk-test
+  "rev-2o-strings"
+  (run* q (rev-2o (list "a" "b" "c") q))
+  (list (list "c" "b" "a")))
+
+(mk-test
+  "rev-2o-reverseo-agree"
+  (let
+    ((via-reverseo (first (run* q (reverseo (list 1 2 3 4 5) q))))
+      (via-rev-2o
+        (first
+          (run*
+            q
+            (rev-2o
+              (list 1 2 3 4 5)
+              q)))))
+    (= via-reverseo via-rev-2o))
+  true)
+
+(mk-tests-run!)

lib/minikanren/tests/run.sx

@@ -0,0 +1,114 @@
+;; lib/minikanren/tests/run.sx — Phase 3 tests for run* / run / reify.
+
+;; --- canonical TRS one-liners ---
+
+(mk-test "run*-eq-one" (run* q (== q 1)) (list 1))
+(mk-test "run*-eq-string" (run* q (== q "hello")) (list "hello"))
+(mk-test "run*-eq-symbol" (run* q (== q (quote sym))) (list (quote sym)))
+(mk-test "run*-fail-empty" (run* q (== 1 2)) (list))
+
+;; --- run with a count ---
+
+(mk-test
+  "run-3-of-many"
+  (run
+    3
+    q
+    (conde
+      ((== q 1))
+      ((== q 2))
+      ((== q 3))
+      ((== q 4))
+      ((== q 5))))
+  (list 1 2 3))
+
+(mk-test "run-zero-empty" (run 0 q (== q 1)) (list))
+
+(mk-test
+  "run-1-takes-one"
+  (run 1 q (conde ((== q "a")) ((== q "b"))))
+  (list "a"))
+
+;; --- reification: unbound vars get _.N left-to-right ---
+
+(mk-test
+  "reify-single-unbound"
+  (run* q (fresh (x) (== q x)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "reify-pair-unbound"
+  (run* q (fresh (x y) (== q (list x y))))
+  (list (list (make-symbol "_.0") (make-symbol "_.1"))))
+
+(mk-test
+  "reify-mixed-bound-unbound"
+  (run* q (fresh (x y) (== q (list 1 x 2 y))))
+  (list
+    (list 1 (make-symbol "_.0") 2 (make-symbol "_.1"))))
+
+(mk-test
+  "reify-shared-unbound-same-name"
+  (run* q (fresh (x) (== q (list x x))))
+  (list (list (make-symbol "_.0") (make-symbol "_.0"))))
+
+(mk-test
+  "reify-distinct-unbound-distinct-names"
+  (run* q (fresh (x y) (== q (list x y x y))))
+  (list
+    (list
+      (make-symbol "_.0")
+      (make-symbol "_.1")
+      (make-symbol "_.0")
+      (make-symbol "_.1"))))
+
+;; --- conde + run* ---
+
+(mk-test
+  "run*-conde-three"
+  (run*
+    q
+    (conde ((== q 1)) ((== q 2)) ((== q 3))))
+  (list 1 2 3))
+
+(mk-test
+  "run*-conde-fresh-mix"
+  (run*
+    q
+    (conde ((fresh (x) (== q (list 1 x)))) ((== q "ground"))))
+  (list (list 1 (make-symbol "_.0")) "ground"))
+
+;; --- run* + conjunction ---
+
+(mk-test
+  "run*-conj-binds-q"
+  (run* q (fresh (x) (== x 5) (== q (list x x))))
+  (list (list 5 5)))
+
+;; --- run* + condu ---
+
+(mk-test
+  "run*-condu-first-wins"
+  (run* q (condu ((== q 1)) ((== q 2))))
+  (list 1))
+
+(mk-test
+  "run*-onceo-trim"
+  (run* q (onceo (conde ((== q "a")) ((== q "b")))))
+  (list "a"))
+
+;; --- multi-goal run ---
+
+(mk-test
+  "run*-three-goals"
+  (run*
+    q
+    (fresh
+      (x y z)
+      (== x 1)
+      (== y 2)
+      (== z 3)
+      (== q (list x y z))))
+  (list (list 1 2 3)))
+
+(mk-tests-run!)

lib/minikanren/tests/selecto.sx

@@ -0,0 +1,46 @@
+;; lib/minikanren/tests/selecto.sx — choose an element + rest of list.
+
+(mk-test
+  "selecto-enumerate"
+  (run*
+    q
+    (fresh
+      (x r)
+      (selecto x r (list 1 2 3))
+      (== q (list x r))))
+  (list
+    (list 1 (list 2 3))
+    (list 2 (list 1 3))
+    (list 3 (list 1 2))))
+
+(mk-test
+  "selecto-find-rest"
+  (run* q (selecto 2 q (list 1 2 3)))
+  (list (list 1 3)))
+
+(mk-test
+  "selecto-find-element"
+  (run*
+    q
+    (selecto
+      q
+      (list 1 3)
+      (list 1 2 3)))
+  (list 2))
+
+(mk-test
+  "selecto-element-not-present-fails"
+  (run* q (selecto 99 q (list 1 2 3)))
+  (list))
+
+(mk-test
+  "selecto-empty-list-fails"
+  (run* q (selecto q (list) (list)))
+  (list))
+
+(mk-test
+  "selecto-singleton"
+  (run* q (fresh (x r) (selecto x r (list :only)) (== q (list x r))))
+  (list (list :only (list))))
+
+(mk-tests-run!)

lib/minikanren/tests/simplifyo.sx

@@ -0,0 +1,47 @@
+;; lib/minikanren/tests/simplifyo.sx — algebraic expression simplifier
+;; demo using conda for first-match-wins dispatch.
+
+(define
+  simplify-step-o
+  (fn
+    (expr result)
+    (conda
+      ((fresh (x) (== expr (list :+ 0 x)) (== result x)))
+      ((fresh (x) (== expr (list :+ x 0)) (== result x)))
+      ((fresh (y) (== expr (list :* 0 y)) (== result 0)))
+      ((fresh (x) (== expr (list :* x 0)) (== result 0)))
+      ((fresh (x) (== expr (list :* 1 x)) (== result x)))
+      ((fresh (x) (== expr (list :* x 1)) (== result x)))
+      ((== result expr)))))                                  ;; default: unchanged
+
+(mk-test
+  "simplify-zero-plus"
+  (run* q (simplify-step-o (list :+ 0 :y) q))
+  (list :y))
+
+(mk-test
+  "simplify-plus-zero"
+  (run* q (simplify-step-o (list :+ :x 0) q))
+  (list :x))
+
+(mk-test
+  "simplify-zero-times"
+  (run* q (simplify-step-o (list :* 0 :y) q))
+  (list 0))
+
+(mk-test
+  "simplify-one-times"
+  (run* q (simplify-step-o (list :* 1 :y) q))
+  (list :y))
+
+(mk-test
+  "simplify-no-rule-applies"
+  (run* q (simplify-step-o (list :+ :x :y) q))
+  (list (list :+ :x :y)))
+
+(mk-test
+  "simplify-non-identity-form"
+  (run* q (simplify-step-o (list :+ 5 7) q))
+  (list (list :+ 5 7)))
+
+(mk-tests-run!)

lib/minikanren/tests/sortedo.sx

@@ -0,0 +1,40 @@
+;; lib/minikanren/tests/sortedo.sx — checks list is non-decreasing.
+
+(mk-test
+  "sortedo-empty"
+  (run* q (sortedo (list)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "sortedo-singleton"
+  (run* q (sortedo (list 42)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "sortedo-ascending"
+  (run* q (sortedo (list 1 2 3 4)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "sortedo-with-equal-adjacent"
+  (run*
+    q
+    (sortedo (list 1 1 2 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "sortedo-out-of-order-fails"
+  (run* q (sortedo (list 1 3 2)))
+  (list))
+
+(mk-test
+  "sortedo-descending-fails"
+  (run* q (sortedo (list 3 2 1)))
+  (list))
+
+(mk-test
+  "sortedo-pair-equal"
+  (run* q (sortedo (list 5 5)))
+  (list (make-symbol "_.0")))
+
+(mk-tests-run!)

lib/minikanren/tests/subo.sx

@@ -0,0 +1,60 @@
+;; lib/minikanren/tests/subo.sx — contiguous-sublist relation.
+
+(mk-test
+  "subo-simple-found"
+  (run*
+    q
+    (subo
+      (list 2 3)
+      (list 1 2 3 4)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "subo-not-contiguous-fails"
+  (run*
+    q
+    (subo
+      (list 2 4)
+      (list 1 2 3 4)))
+  (list))
+
+(mk-test
+  "subo-full-list-found"
+  (run*
+    q
+    (subo
+      (list 1 2 3)
+      (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "subo-empty-list-found"
+  (let
+    ((res (run* q (subo (list) (list 1 2 3)))))
+    (= (len res) 4))
+  true)
+
+(mk-test
+  "subo-prefix"
+  (run*
+    q
+    (subo
+      (list 1 2)
+      (list 1 2 3 4)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "subo-suffix"
+  (run*
+    q
+    (subo
+      (list 3 4)
+      (list 1 2 3 4)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "subo-strings"
+  (run* q (subo (list "b" "c") (list "a" "b" "c" "d")))
+  (list (make-symbol "_.0")))
+
+(mk-tests-run!)

lib/minikanren/tests/subseto.sx

@@ -0,0 +1,62 @@
+;; lib/minikanren/tests/subseto.sx — every element of l1 is in l2.
+
+(mk-test
+  "subseto-empty"
+  (run* q (subseto (list) (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "subseto-singleton-yes"
+  (run*
+    q
+    (subseto (list 2) (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "subseto-singleton-no"
+  (run*
+    q
+    (subseto (list 99) (list 1 2 3)))
+  (list))
+
+(mk-test
+  "subseto-multi-yes"
+  (run
+    1
+    q
+    (subseto
+      (list 1 3)
+      (list 1 2 3 4)))
+  (list (make-symbol "_.0")))
+
+(mk-test
+  "subseto-multi-no"
+  (run*
+    q
+    (subseto
+      (list 1 99)
+      (list 1 2 3)))
+  (list))
+
+(mk-test
+  "subseto-equal-sets"
+  (run
+    1
+    q
+    (subseto
+      (list 1 2 3)
+      (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+;; allow duplicates in l1 — each just needs membership in l2.
+(mk-test
+  "subseto-duplicates-allowed"
+  (run
+    1
+    q
+    (subseto
+      (list 1 1 2)
+      (list 1 2 3)))
+  (list (make-symbol "_.0")))
+
+(mk-tests-run!)

lib/minikanren/tests/sum-product.sx

@@ -0,0 +1,44 @@
+;; lib/minikanren/tests/sum-product.sx — fold list to integer.
+
+(mk-test "sumo-empty" (run* q (sumo (list) q)) (list 0))
+(mk-test
+  "sumo-1-to-5"
+  (run*
+    q
+    (sumo (list 1 2 3 4 5) q))
+  (list 15))
+(mk-test
+  "sumo-zeros"
+  (run* q (sumo (list 0 0 0) q))
+  (list 0))
+(mk-test
+  "sumo-negs"
+  (run* q (sumo (list 5 -3 8) q))
+  (list 10))
+
+(mk-test "producto-empty" (run* q (producto (list) q)) (list 1))
+(mk-test
+  "producto-1-to-4"
+  (run* q (producto (list 1 2 3 4) q))
+  (list 24))
+(mk-test
+  "producto-with-0"
+  (run* q (producto (list 5 0 7) q))
+  (list 0))
+(mk-test
+  "producto-of-1s"
+  (run* q (producto (list 1 1 1) q))
+  (list 1))
+
+(mk-test
+  "sum-product-pythagorean-square"
+  (run*
+    q
+    (fresh
+      (s sq2)
+      (sumo (list 3 4 5) s)
+      (producto (list 3 3) sq2)
+      (== q (list s sq2))))
+  (list (list 12 9)))
+
+(mk-tests-run!)

lib/minikanren/tests/swap-firsto.sx

@@ -0,0 +1,32 @@
+;; lib/minikanren/tests/swap-firsto.sx — swap first two elements.
+
+(mk-test
+  "swap-firsto-pair"
+  (run* q (swap-firsto (list 1 2) q))
+  (list (list 2 1)))
+
+(mk-test
+  "swap-firsto-with-tail"
+  (run* q (swap-firsto (list 1 2 3 4) q))
+  (list (list 2 1 3 4)))
+
+(mk-test
+  "swap-firsto-singleton-fails"
+  (run* q (swap-firsto (list 1) q))
+  (list))
+
+(mk-test "swap-firsto-empty-fails" (run* q (swap-firsto (list) q)) (list))
+
+(mk-test
+  "swap-firsto-self-inverse"
+  (run*
+    q
+    (fresh (mid) (swap-firsto (list :a :b :c :d) mid) (swap-firsto mid q)))
+  (list (list :a :b :c :d)))
+
+(mk-test
+  "swap-firsto-backward"
+  (run* q (swap-firsto q (list :y :x :z)))
+  (list (list :x :y :z)))
+
+(mk-tests-run!)

lib/minikanren/tests/tabling-more.sx

@@ -0,0 +1,55 @@
+;; lib/minikanren/tests/tabling-more.sx — table-1 + table-3.
+
+;; --- table-1 (predicate caching) ---
+
+(define
+  tab-in-list
+  (table-1
+    "in-list"
+    (fn
+      (x)
+      (membero
+        x
+        (list 1 2 3 4 5)))))
+
+(mk-tab-clear!)
+(mk-test
+  "table-1-hit"
+  (run* q (tab-in-list 3))
+  (list (make-symbol "_.0")))
+(mk-test "table-1-miss-no" (run* q (tab-in-list 99)) (list))
+(mk-test
+  "table-1-replay"
+  (run* q (tab-in-list 3))
+  (list (make-symbol "_.0")))
+
+;; --- table-3 (Ackermann) ---
+
+(define
+  ack-o
+  (table-3
+    "ack"
+    (fn
+      (m n result)
+      (conde
+        ((== m 0) (pluso-i n 1 result))
+        ((fresh (m-1) (lto-i 0 m) (== n 0) (minuso-i m 1 m-1) (ack-o m-1 1 result)))
+        ((fresh (m-1 n-1 inner) (lto-i 0 m) (lto-i 0 n) (minuso-i m 1 m-1) (minuso-i n 1 n-1) (ack-o m n-1 inner) (ack-o m-1 inner result)))))))
+
+(mk-tab-clear!)
+(mk-test
+  "ack-0-0"
+  (run* q (ack-o 0 0 q))
+  (list 1))
+(mk-tab-clear!)
+(mk-test
+  "ack-2-3"
+  (run* q (ack-o 2 3 q))
+  (list 9))
+(mk-tab-clear!)
+(mk-test
+  "ack-3-3"
+  (run* q (ack-o 3 3 q))
+  (list 61))
+
+(mk-tests-run!)

lib/minikanren/tests/tabling.sx

@@ -0,0 +1,60 @@
+;; lib/minikanren/tests/tabling.sx — Phase 7 piece A: naive memoization.
+
+;; --- Fibonacci canary: tabled vs naive --
+
+(define
+  tab-fib-o
+  (table-2
+    "fib"
+    (fn
+      (n result)
+      (conde
+        ((== n 0) (== result 0))
+        ((== n 1) (== result 1))
+        ((fresh (n-1 n-2 r-1 r-2) (lto-i 1 n) (minuso-i n 1 n-1) (minuso-i n 2 n-2) (tab-fib-o n-1 r-1) (tab-fib-o n-2 r-2) (pluso-i r-1 r-2 result)))))))
+
+(mk-tab-clear!)
+
+(mk-test "tab-fib-zero" (run* q (tab-fib-o 0 q)) (list 0))
+(mk-tab-clear!)
+(mk-test "tab-fib-one" (run* q (tab-fib-o 1 q)) (list 1))
+(mk-tab-clear!)
+(mk-test "tab-fib-two" (run* q (tab-fib-o 2 q)) (list 1))
+(mk-tab-clear!)
+(mk-test "tab-fib-five" (run* q (tab-fib-o 5 q)) (list 5))
+(mk-tab-clear!)
+(mk-test "tab-fib-ten" (run* q (tab-fib-o 10 q)) (list 55))
+(mk-tab-clear!)
+(mk-test
+  "tab-fib-twenty"
+  (run* q (tab-fib-o 20 q))
+  (list 6765))
+
+;; --- ground-term predicate ---
+
+(mk-test "tab-ground-term-num" (mk-tab-ground-term? 5) true)
+(mk-test "tab-ground-term-str" (mk-tab-ground-term? "hi") true)
+(mk-test
+  "tab-ground-term-list"
+  (mk-tab-ground-term? (list 1 2 3))
+  true)
+(mk-test "tab-ground-term-var" (mk-tab-ground-term? (mk-var "x")) false)
+(mk-test
+  "tab-ground-term-nested"
+  (mk-tab-ground-term?
+    (list 1 (list 2 (mk-var "y")) 3))
+  false)
+
+;; --- caching reduces work — count cache hits via repeated query ---
+
+(mk-test
+  "tab-cache-replay"
+  (begin
+    (mk-tab-clear!)
+    (let
+      ((first (run* q (tab-fib-o 10 q)))
+        (second (run* q (tab-fib-o 10 q))))
+      (and (= first (list 55)) (= second (list 55)))))
+  true)
+
+(mk-tests-run!)

lib/minikanren/tests/take-drop.sx

@@ -0,0 +1,92 @@
+;; lib/minikanren/tests/take-drop.sx — Peano-indexed prefix/suffix.
+
+(define
+  mk-nat
+  (fn (n) (if (= n 0) :z (list :s (mk-nat (- n 1))))))
+
+;; --- tako ---
+
+(mk-test
+  "tako-zero"
+  (run*
+    q
+    (tako (mk-nat 0) (list 1 2 3) q))
+  (list (list)))
+
+(mk-test
+  "tako-two"
+  (run*
+    q
+    (tako
+      (mk-nat 2)
+      (list 1 2 3 4 5)
+      q))
+  (list (list 1 2)))
+
+(mk-test
+  "tako-all"
+  (run*
+    q
+    (tako (mk-nat 3) (list 1 2 3) q))
+  (list (list 1 2 3)))
+
+(mk-test
+  "tako-too-many"
+  (run*
+    q
+    (tako (mk-nat 5) (list 1 2 3) q))
+  (list))
+
+;; --- dropo ---
+
+(mk-test
+  "dropo-zero"
+  (run*
+    q
+    (dropo (mk-nat 0) (list 1 2 3) q))
+  (list (list 1 2 3)))
+
+(mk-test
+  "dropo-two"
+  (run*
+    q
+    (dropo
+      (mk-nat 2)
+      (list 1 2 3 4 5)
+      q))
+  (list (list 3 4 5)))
+
+(mk-test
+  "dropo-all"
+  (run*
+    q
+    (dropo (mk-nat 3) (list 1 2 3) q))
+  (list (list)))
+
+(mk-test
+  "dropo-too-many"
+  (run*
+    q
+    (dropo (mk-nat 5) (list 1 2 3) q))
+  (list))
+
+;; --- take + drop round-trip ---
+
+(mk-test
+  "tako-dropo-roundtrip"
+  (run*
+    q
+    (fresh
+      (p s)
+      (tako
+        (mk-nat 2)
+        (list 1 2 3 4 5)
+        p)
+      (dropo
+        (mk-nat 2)
+        (list 1 2 3 4 5)
+        s)
+      (appendo p s q)))
+  (list (list 1 2 3 4 5)))
+
+(mk-tests-run!)

lib/minikanren/tests/take-while-drop-while.sx

@@ -0,0 +1,80 @@
+;; lib/minikanren/tests/take-while-drop-while.sx — prefix/suffix by predicate.
+
+(mk-test
+  "take-while-o-empty"
+  (run* q (take-while-o (fn (x) (== x 1)) (list) q))
+  (list (list)))
+
+(mk-test
+  "take-while-o-while-lt-5"
+  (run*
+    q
+    (take-while-o
+      (fn (x) (lto-i x 5))
+      (list 1 3 7 2 9)
+      q))
+  (list (list 1 3)))
+
+(mk-test
+  "take-while-o-all-match"
+  (run*
+    q
+    (take-while-o
+      (fn (x) (lto-i x 100))
+      (list 1 2 3)
+      q))
+  (list (list 1 2 3)))
+
+(mk-test
+  "take-while-o-none-match"
+  (run*
+    q
+    (take-while-o
+      (fn (x) (lto-i 100 x))
+      (list 1 2 3)
+      q))
+  (list (list)))
+
+(mk-test
+  "drop-while-o-empty"
+  (run* q (drop-while-o (fn (x) (== x 1)) (list) q))
+  (list (list)))
+
+(mk-test
+  "drop-while-o-while-lt-5"
+  (run*
+    q
+    (drop-while-o
+      (fn (x) (lto-i x 5))
+      (list 1 3 7 2 9)
+      q))
+  (list (list 7 2 9)))
+
+(mk-test
+  "drop-while-o-all-match"
+  (run*
+    q
+    (drop-while-o
+      (fn (x) (lto-i x 100))
+      (list 1 2 3)
+      q))
+  (list (list)))
+
+(mk-test
+  "take-drop-roundtrip"
+  (run*
+    q
+    (fresh
+      (p s)
+      (take-while-o
+        (fn (x) (lto-i x 5))
+        (list 1 3 7 2 9)
+        p)
+      (drop-while-o
+        (fn (x) (lto-i x 5))
+        (list 1 3 7 2 9)
+        s)
+      (appendo p s q)))
+  (list (list 1 3 7 2 9)))
+
+(mk-tests-run!)

lib/minikanren/tests/types.sx

@@ -0,0 +1,52 @@
+;; lib/minikanren/tests/types.sx — type-predicate goals.
+
+(mk-test
+  "numbero-on-int"
+  (run* q (numbero 5))
+  (list (make-symbol "_.0")))
+(mk-test "numbero-on-string" (run* q (numbero "5")) (list))
+(mk-test "numbero-on-symbol" (run* q (numbero (quote x))) (list))
+(mk-test "numbero-on-list" (run* q (numbero (list 1))) (list))
+
+(mk-test
+  "stringo-on-string"
+  (run* q (stringo "hi"))
+  (list (make-symbol "_.0")))
+(mk-test "stringo-on-int" (run* q (stringo 5)) (list))
+(mk-test
+  "stringo-on-keyword"
+  (run* q (stringo :k))
+  (list (make-symbol "_.0")))  ;; SX keywords ARE strings
+
+(mk-test
+  "symbolo-on-symbol"
+  (run* q (symbolo (quote x)))
+  (list (make-symbol "_.0")))
+(mk-test "symbolo-on-string" (run* q (symbolo "x")) (list))
+(mk-test "symbolo-on-int" (run* q (symbolo 5)) (list))
+
+;; --- combine with membero for type-filtered enumeration ---
+
+(mk-test
+  "membero-numbero-filter"
+  (run*
+    q
+    (fresh
+      (x)
+      (membero x (list 1 "a" 2 "b" 3))
+      (numbero x)
+      (== q x)))
+  (list 1 2 3))
+
+(mk-test
+  "membero-stringo-filter"
+  (run*
+    q
+    (fresh
+      (x)
+      (membero x (list 1 "a" 2 "b" 3))
+      (stringo x)
+      (== q x)))
+  (list "a" "b"))
+
+(mk-tests-run!)

lib/minikanren/tests/unify.sx

@@ -0,0 +1,293 @@
+;; lib/minikanren/tests/unify.sx — Phase 1 tests for unify.sx.
+;;
+;; Loads into a session that already has lib/guest/match.sx and
+;; lib/minikanren/unify.sx defined. Tests are top-level forms.
+;; Call (mk-tests-run!) afterwards to get the totals.
+;;
+;; Note: SX dict equality is reference-based, so tests check the *effect*
+;; of a unification (success/failure flag, or walked bindings) rather than
+;; the raw substitution dict.
+
+(define mk-test-pass 0)
+(define mk-test-fail 0)
+(define mk-test-fails (list))
+
+(define
+  mk-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! mk-test-pass (+ mk-test-pass 1))
+      (begin
+        (set! mk-test-fail (+ mk-test-fail 1))
+        (append! mk-test-fails {:name name :expected expected :actual actual})))))
+
+(define mk-tests-run! (fn () {:total (+ mk-test-pass mk-test-fail) :passed mk-test-pass :failed mk-test-fail :fails mk-test-fails}))
+
+(define mk-unified? (fn (s) (if (= s nil) false true)))
+
+;; --- fresh variable construction ---
+
+(mk-test
+  "make-var-distinct"
+  (let ((a (make-var)) (b (make-var))) (= (var-name a) (var-name b)))
+  false)
+
+(mk-test "make-var-is-var" (mk-var? (make-var)) true)
+(mk-test "var?-num" (mk-var? 5) false)
+(mk-test "var?-list" (mk-var? (list 1 2)) false)
+(mk-test "var?-string" (mk-var? "hi") false)
+(mk-test "var?-empty" (mk-var? (list)) false)
+(mk-test "var?-bool" (mk-var? true) false)
+
+;; --- empty substitution ---
+
+(mk-test "empty-s-walk-num" (mk-walk 5 empty-s) 5)
+(mk-test "empty-s-walk-str" (mk-walk "x" empty-s) "x")
+(mk-test
+  "empty-s-walk-list"
+  (mk-walk (list 1 2) empty-s)
+  (list 1 2))
+(mk-test
+  "empty-s-walk-unbound-var"
+  (let ((x (make-var))) (= (mk-walk x empty-s) x))
+  true)
+
+;; --- walk: top-level chain resolution ---
+
+(mk-test
+  "walk-direct-binding"
+  (mk-walk (mk-var "x") (extend "x" 7 empty-s))
+  7)
+
+(mk-test
+  "walk-two-step-chain"
+  (mk-walk
+    (mk-var "x")
+    (extend "x" (mk-var "y") (extend "y" 9 empty-s)))
+  9)
+
+(mk-test
+  "walk-three-step-chain"
+  (mk-walk
+    (mk-var "a")
+    (extend
+      "a"
+      (mk-var "b")
+      (extend "b" (mk-var "c") (extend "c" 42 empty-s))))
+  42)
+
+(mk-test
+  "walk-stops-at-list"
+  (mk-walk (list 1 (mk-var "x")) (extend "x" 5 empty-s))
+  (list 1 (mk-var "x")))
+
+;; --- walk*: deep walk into lists ---
+
+(mk-test
+  "walk*-flat-list-with-vars"
+  (mk-walk*
+    (list (mk-var "x") 2 (mk-var "y"))
+    (extend "x" 1 (extend "y" 3 empty-s)))
+  (list 1 2 3))
+
+(mk-test
+  "walk*-nested-list"
+  (mk-walk*
+    (list 1 (mk-var "x") (list 2 (mk-var "y")))
+    (extend "x" 5 (extend "y" 6 empty-s)))
+  (list 1 5 (list 2 6)))
+
+(mk-test
+  "walk*-unbound-stays-var"
+  (let
+    ((x (mk-var "x")))
+    (= (mk-walk* (list 1 x) empty-s) (list 1 x)))
+  true)
+
+(mk-test "walk*-atom" (mk-walk* 5 empty-s) 5)
+
+;; --- unify atoms (success / failure semantics, not dict shape) ---
+
+(mk-test
+  "unify-num-eq-succeeds"
+  (mk-unified? (mk-unify 5 5 empty-s))
+  true)
+(mk-test "unify-num-neq-fails" (mk-unify 5 6 empty-s) nil)
+(mk-test
+  "unify-str-eq-succeeds"
+  (mk-unified? (mk-unify "a" "a" empty-s))
+  true)
+(mk-test "unify-str-neq-fails" (mk-unify "a" "b" empty-s) nil)
+(mk-test
+  "unify-bool-eq-succeeds"
+  (mk-unified? (mk-unify true true empty-s))
+  true)
+(mk-test "unify-bool-neq-fails" (mk-unify true false empty-s) nil)
+(mk-test
+  "unify-nil-eq-succeeds"
+  (mk-unified? (mk-unify nil nil empty-s))
+  true)
+(mk-test
+  "unify-empty-list-succeeds"
+  (mk-unified? (mk-unify (list) (list) empty-s))
+  true)
+
+;; --- unify var with anything (walk to verify binding) ---
+
+(mk-test
+  "unify-var-num-binds"
+  (mk-walk (mk-var "x") (mk-unify (mk-var "x") 5 empty-s))
+  5)
+
+(mk-test
+  "unify-num-var-binds"
+  (mk-walk (mk-var "x") (mk-unify 5 (mk-var "x") empty-s))
+  5)
+
+(mk-test
+  "unify-var-list-binds"
+  (mk-walk
+    (mk-var "x")
+    (mk-unify (mk-var "x") (list 1 2) empty-s))
+  (list 1 2))
+
+(mk-test
+  "unify-var-var-same-no-extend"
+  (mk-unified? (mk-unify (mk-var "x") (mk-var "x") empty-s))
+  true)
+
+(mk-test
+  "unify-var-var-different-walks-equal"
+  (let
+    ((s (mk-unify (mk-var "x") (mk-var "y") empty-s)))
+    (= (mk-walk (mk-var "x") s) (mk-walk (mk-var "y") s)))
+  true)
+
+;; --- unify lists positionally ---
+
+(mk-test
+  "unify-list-equal-succeeds"
+  (mk-unified?
+    (mk-unify
+      (list 1 2 3)
+      (list 1 2 3)
+      empty-s))
+  true)
+
+(mk-test
+  "unify-list-different-length-fails-1"
+  (mk-unify
+    (list 1 2)
+    (list 1 2 3)
+    empty-s)
+  nil)
+
+(mk-test
+  "unify-list-different-length-fails-2"
+  (mk-unify
+    (list 1 2 3)
+    (list 1 2)
+    empty-s)
+  nil)
+
+(mk-test
+  "unify-list-mismatch-fails"
+  (mk-unify
+    (list 1 2)
+    (list 1 3)
+    empty-s)
+  nil)
+
+(mk-test
+  "unify-list-vs-atom-fails"
+  (mk-unify (list 1 2) 5 empty-s)
+  nil)
+
+(mk-test
+  "unify-empty-vs-non-empty-fails"
+  (mk-unify (list) (list 1) empty-s)
+  nil)
+
+(mk-test
+  "unify-list-with-vars-walks"
+  (mk-walk*
+    (list (mk-var "x") (mk-var "y"))
+    (mk-unify
+      (list (mk-var "x") (mk-var "y"))
+      (list 1 2)
+      empty-s))
+  (list 1 2))
+
+(mk-test
+  "unify-nested-lists-with-vars-walks"
+  (mk-walk*
+    (list (mk-var "x") (list (mk-var "y") 3))
+    (mk-unify
+      (list (mk-var "x") (list (mk-var "y") 3))
+      (list 1 (list 2 3))
+      empty-s))
+  (list 1 (list 2 3)))
+
+;; --- unify chained substitutions ---
+
+(mk-test
+  "unify-chain-var-var-then-atom"
+  (let
+    ((x (mk-var "x")) (y (mk-var "y")))
+    (let
+      ((s1 (mk-unify x y empty-s)))
+      (mk-walk x (mk-unify y 7 s1))))
+  7)
+
+(mk-test
+  "unify-already-bound-consistent"
+  (let
+    ((s (extend "x" 5 empty-s)))
+    (mk-unified? (mk-unify (mk-var "x") 5 s)))
+  true)
+
+(mk-test
+  "unify-already-bound-conflict-fails"
+  (let
+    ((s (extend "x" 5 empty-s)))
+    (mk-unify (mk-var "x") 6 s))
+  nil)
+
+;; --- occurs check (opt-in) ---
+
+(mk-test
+  "unify-no-occurs-default-succeeds"
+  (let
+    ((x (mk-var "x")))
+    (mk-unified? (mk-unify x (list 1 x) empty-s)))
+  true)
+
+(mk-test
+  "unify-occurs-direct-fails"
+  (let ((x (mk-var "x"))) (mk-unify-check x (list 1 x) empty-s))
+  nil)
+
+(mk-test
+  "unify-occurs-nested-fails"
+  (let
+    ((x (mk-var "x")))
+    (mk-unify-check x (list 1 (list 2 x)) empty-s))
+  nil)
+
+(mk-test
+  "unify-occurs-non-occurring-succeeds"
+  (let
+    ((x (mk-var "x")))
+    (mk-unified? (mk-unify-check x 5 empty-s)))
+  true)
+
+(mk-test
+  "unify-occurs-via-chain-fails"
+  (let
+    ((x (mk-var "x")) (y (mk-var "y")))
+    (let ((s (extend "y" (list x) empty-s))) (mk-unify-check x y s)))
+  nil)
+
+(mk-tests-run!)

lib/minikanren/tests/zip-with-o.sx

@@ -0,0 +1,52 @@
+;; lib/minikanren/tests/zip-with-o.sx — element-wise combine of two lists.
+
+(mk-test
+  "zip-with-o-empty"
+  (run* q (zip-with-o pluso-i (list) (list) q))
+  (list (list)))
+
+(mk-test
+  "zip-with-o-pluso-i"
+  (run*
+    q
+    (zip-with-o
+      pluso-i
+      (list 1 2 3)
+      (list 10 20 30)
+      q))
+  (list (list 11 22 33)))
+
+(mk-test
+  "zip-with-o-times-i"
+  (run*
+    q
+    (zip-with-o
+      *o-i
+      (list 2 3 4)
+      (list 5 6 7)
+      q))
+  (list (list 10 18 28)))
+
+(mk-test
+  "zip-with-o-different-length-fails"
+  (run*
+    q
+    (zip-with-o
+      pluso-i
+      (list 1 2)
+      (list 1 2 3)
+      q))
+  (list))
+
+(mk-test
+  "zip-with-o-non-arith-rel"
+  (run*
+    q
+    (zip-with-o
+      (fn (a b r) (== r (list a b)))
+      (list :x :y)
+      (list 1 2)
+      q))
+  (list (list (list :x 1) (list :y 2))))
+
+(mk-tests-run!)