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

hk-collect-module-body previously ran a fixed import-loop at the start and then a separate decl-loop; merged into a single hk-body-step dispatcher that routes `import` to the imports list and everything else to hk-parse-decl. Both call sites (initial step + post-semicolon loop) use the dispatcher. The eval side reads imports as a list (not by AST position) so mid-stream imports feed into hk-bind-decls! unchanged. tests/parse-extras.sx 12 → 17: very-top, mid-stream, post-main, two-imports-different-positions, unqualified-mid-file. Regression sweep clean: eval 66/0, exceptions 14/0, typecheck 15/0, records 14/0, ioref 13/0, map 26/0, set 17/0. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
haskell: Phase 17 — expression type annotations (x :: Int) (parse + desugar pass-through)
2026-05-10 19:11:36 +00:00 · 2026-05-08 23:12:35 +00:00 · 2026-05-08 22:41:22 +00:00
203 changed files with 4541 additions and 24758 deletions
--- a/hosts/ocaml/bin/run_tests.ml
+++ b/hosts/ocaml/bin/run_tests.ml
@@ -1279,7 +1279,7 @@ let run_foundation_tests () =
  assert_true "sx_truthy \"\"" (Bool (sx_truthy (String "")));
  assert_eq "not truthy nil" (Bool false) (Bool (sx_truthy Nil));
  assert_eq "not truthy false" (Bool false) (Bool (sx_truthy (Bool false)));
-  let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = Sx_types.make_env (); l_name = None; l_compiled = None; l_call_count = 0 } in
+  let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = Sx_types.make_env (); l_name = None; l_compiled = None } in
  assert_true "is_lambda" (Bool (Sx_types.is_lambda (Lambda l)));
  ignore (Sx_types.set_lambda_name (Lambda l) "my-fn");
  assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l))
--- a/hosts/ocaml/lib/sx_primitives.ml
+++ b/hosts/ocaml/lib/sx_primitives.ml
@@ -528,183 +528,6 @@ let () =
    | [Rational (_, d)] -> Integer d
    | [Integer _]       -> Integer 1
    | _ -> raise (Eval_error "denominator: expected rational or integer"));
  (* printf-spec: apply one Tcl/printf format spec to one arg.
     spec is like "%5.2f", "%-10s", "%x", "%c", "%d". Always starts with %
     and ends with the conversion char.  Supports d i u x X o c s f e g.
     Coerces arg to the right type per conversion. *)
  register "printf-spec" (fun args ->
    let spec_str, arg = match args with
      | [String s; v] -> (s, v)
      | _ -> raise (Eval_error "printf-spec: (spec arg)")
    in
    let n = String.length spec_str in
    if n < 2 || spec_str.[0] <> '%' then
      raise (Eval_error ("printf-spec: invalid spec " ^ spec_str));
    let type_char = spec_str.[n - 1] in
    let to_int v = match v with
      | Integer i -> i
      | Number f -> int_of_float f
      | String s ->
        let s = String.trim s in
        (try int_of_string s
         with _ ->
           try int_of_float (float_of_string s)
           with _ -> 0)
      | Bool true -> 1 | Bool false -> 0
      | _ -> 0
    in
    let to_float v = match v with
      | Number f -> f
      | Integer i -> float_of_int i
      | String s ->
        let s = String.trim s in
        (try float_of_string s with _ -> 0.0)
      | _ -> 0.0
    in
    let to_string v = match v with
      | String s -> s
      | Integer i -> string_of_int i
      | Number f -> Sx_types.format_number f
      | Bool true -> "1" | Bool false -> "0"
      | Nil -> ""
      | _ -> Sx_types.inspect v
    in
    try
      match type_char with
      | 'd' | 'i' ->
        let fmt = Scanf.format_from_string spec_str "%d" in
        String (Printf.sprintf fmt (to_int arg))
      | 'u' ->
        let fmt = Scanf.format_from_string spec_str "%u" in
        String (Printf.sprintf fmt (to_int arg))
      | 'x' ->
        let fmt = Scanf.format_from_string spec_str "%x" in
        String (Printf.sprintf fmt (to_int arg))
      | 'X' ->
        let fmt = Scanf.format_from_string spec_str "%X" in
        String (Printf.sprintf fmt (to_int arg))
      | 'o' ->
        let fmt = Scanf.format_from_string spec_str "%o" in
        String (Printf.sprintf fmt (to_int arg))
      | 'c' ->
        let n_val = to_int arg in
        let body = String.sub spec_str 0 (n - 1) in
        let fmt = Scanf.format_from_string (body ^ "s") "%s" in
        String (Printf.sprintf fmt (String.make 1 (Char.chr (n_val land 0xff))))
      | 's' ->
        let fmt = Scanf.format_from_string spec_str "%s" in
        String (Printf.sprintf fmt (to_string arg))
      | 'f' ->
        let fmt = Scanf.format_from_string spec_str "%f" in
        String (Printf.sprintf fmt (to_float arg))
      | 'e' ->
        let fmt = Scanf.format_from_string spec_str "%e" in
        String (Printf.sprintf fmt (to_float arg))
      | 'E' ->
        let fmt = Scanf.format_from_string spec_str "%E" in
        String (Printf.sprintf fmt (to_float arg))
      | 'g' ->
        let fmt = Scanf.format_from_string spec_str "%g" in
        String (Printf.sprintf fmt (to_float arg))
      | 'G' ->
        let fmt = Scanf.format_from_string spec_str "%G" in
        String (Printf.sprintf fmt (to_float arg))
      | _ -> raise (Eval_error ("printf-spec: unsupported conversion " ^ String.make 1 type_char))
    with
    | Eval_error _ as e -> raise e
    | _ -> raise (Eval_error ("printf-spec: invalid format " ^ spec_str)));
  (* scan-spec: apply one Tcl/scanf format spec to a string.
     Returns (consumed-count . parsed-value), or nil on failure. *)
  register "scan-spec" (fun args ->
    let spec_str, str = match args with
      | [String s; String input] -> (s, input)
      | _ -> raise (Eval_error "scan-spec: (spec input)")
    in
    let n = String.length spec_str in
    if n < 2 || spec_str.[0] <> '%' then
      raise (Eval_error ("scan-spec: invalid spec " ^ spec_str));
    let type_char = spec_str.[n - 1] in
    let len = String.length str in
    (* skip leading whitespace for non-%c/%s conversions *)
    let i = ref 0 in
    if type_char <> 'c' then
      while !i < len && (str.[!i] = ' ' || str.[!i] = '\t' || str.[!i] = '\n') do incr i done;
    let start = !i in
    try
      match type_char with
      | 'd' | 'i' ->
        let j = ref !i in
        if !j < len && (str.[!j] = '-' || str.[!j] = '+') then incr j;
        while !j < len && str.[!j] >= '0' && str.[!j] <= '9' do incr j done;
        if !j > start && (str.[start] >= '0' && str.[start] <= '9'
                         || (!j > start + 1 && (str.[start] = '-' || str.[start] = '+'))) then
          let n_val = int_of_string (String.sub str start (!j - start)) in
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (Integer n_val);
          Hashtbl.replace d "consumed" (Integer !j);
          Dict d
        else Nil
      | 'x' | 'X' ->
        let j = ref !i in
        while !j < len &&
              ((str.[!j] >= '0' && str.[!j] <= '9') ||
               (str.[!j] >= 'a' && str.[!j] <= 'f') ||
               (str.[!j] >= 'A' && str.[!j] <= 'F')) do incr j done;
        if !j > start then
          let n_val = int_of_string ("0x" ^ String.sub str start (!j - start)) in
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (Integer n_val);
          Hashtbl.replace d "consumed" (Integer !j);
          Dict d
        else Nil
      | 'o' ->
        let j = ref !i in
        while !j < len && str.[!j] >= '0' && str.[!j] <= '7' do incr j done;
        if !j > start then
          let n_val = int_of_string ("0o" ^ String.sub str start (!j - start)) in
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (Integer n_val);
          Hashtbl.replace d "consumed" (Integer !j);
          Dict d
        else Nil
      | 'f' | 'e' | 'g' ->
        let j = ref !i in
        if !j < len && (str.[!j] = '-' || str.[!j] = '+') then incr j;
        while !j < len && ((str.[!j] >= '0' && str.[!j] <= '9') || str.[!j] = '.') do incr j done;
        if !j < len && (str.[!j] = 'e' || str.[!j] = 'E') then begin
          incr j;
          if !j < len && (str.[!j] = '-' || str.[!j] = '+') then incr j;
          while !j < len && str.[!j] >= '0' && str.[!j] <= '9' do incr j done
        end;
        if !j > start then
          let f_val = float_of_string (String.sub str start (!j - start)) in
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (Number f_val);
          Hashtbl.replace d "consumed" (Integer !j);
          Dict d
        else Nil
      | 's' ->
        let j = ref !i in
        while !j < len && str.[!j] <> ' ' && str.[!j] <> '\t' && str.[!j] <> '\n' do incr j done;
        if !j > start then
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (String (String.sub str start (!j - start)));
          Hashtbl.replace d "consumed" (Integer !j);
          Dict d
        else Nil
      | 'c' ->
        if !i < len then
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (Integer (Char.code str.[!i]));
          Hashtbl.replace d "consumed" (Integer (!i + 1));
          Dict d
        else Nil
      | _ -> raise (Eval_error ("scan-spec: unsupported conversion " ^ String.make 1 type_char))
    with
    | Eval_error _ as e -> raise e
    | _ -> Nil);
  register "parse-int" (fun args ->
    let parse_leading_int s =
      let len = String.length s in
@@ -3576,204 +3399,6 @@ let () =
      Nil
    | _ -> raise (Eval_error "channel-set-blocking!: (channel bool)"));
  (* === Exec === run an external process; capture stdout *)
  register "exec-process" (fun args ->
    let items = match args with
      | [List xs] | [ListRef { contents = xs }] -> xs
      | _ -> raise (Eval_error "exec-process: (cmd-list)")
    in
    let argv = Array.of_list (List.map (function
      | String s -> s
      | v -> Sx_types.inspect v
    ) items) in
    if Array.length argv = 0 then raise (Eval_error "exec: empty command");
    let (out_r, out_w) = Unix.pipe () in
    let (err_r, err_w) = Unix.pipe () in
    let pid =
      try Unix.create_process argv.(0) argv Unix.stdin out_w err_w
      with Unix.Unix_error (e, _, _) ->
        Unix.close out_r; Unix.close out_w;
        Unix.close err_r; Unix.close err_w;
        raise (Eval_error ("exec: " ^ Unix.error_message e))
    in
    Unix.close out_w;
    Unix.close err_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 n = Unix.read fd chunk 0 (Bytes.length chunk) in
          if n = 0 then stop := true
          else Buffer.add_subbytes target chunk 0 n
        done
      with _ -> ()
    in
    read_all out_r buf;
    read_all err_r errbuf;
    Unix.close out_r;
    Unix.close err_r;
    let (_, status) = Unix.waitpid [] pid in
    let exit_code = match status with
      | Unix.WEXITED n -> n
      | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> 1
    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 exit_code <> 0 then
      raise (Eval_error ("exec: child exited " ^ string_of_int exit_code
                         ^ (if Buffer.length errbuf > 0
                            then ": " ^ Buffer.contents errbuf
                            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
@@ -4109,25 +3734,4 @@ let () =
        | k :: v :: rest -> ignore (env_bind child (value_to_string k) v); add_bindings rest
        | [_] -> raise (Eval_error "env-extend: odd number of key-val pairs") in
      add_bindings pairs;
-      Env child);
+      Env child)
  (* JIT cache control & observability — backed by refs in sx_types.ml to
     avoid creating a sx_primitives → sx_vm dependency cycle. sx_vm reads
     these refs to decide when to JIT. *)
  register "jit-stats" (fun _args ->
    let d = Hashtbl.create 8 in
    Hashtbl.replace d "threshold"        (Number (float_of_int !Sx_types.jit_threshold));
    Hashtbl.replace d "compiled"         (Number (float_of_int !Sx_types.jit_compiled_count));
    Hashtbl.replace d "compile-failed"   (Number (float_of_int !Sx_types.jit_skipped_count));
    Hashtbl.replace d "below-threshold"  (Number (float_of_int !Sx_types.jit_threshold_skipped_count));
    Dict d);
  register "jit-set-threshold!" (fun args ->
    match args with
    | [Number n] -> Sx_types.jit_threshold := int_of_float n; Nil
    | [Integer n] -> Sx_types.jit_threshold := n; Nil
    | _ -> raise (Eval_error "jit-set-threshold!: (n) where n is integer"));
  register "jit-reset-counters!" (fun _args ->
    Sx_types.jit_compiled_count := 0;
    Sx_types.jit_skipped_count := 0;
    Sx_types.jit_threshold_skipped_count := 0;
    Nil)
--- a/hosts/ocaml/lib/sx_types.ml
+++ b/hosts/ocaml/lib/sx_types.ml
@@ -138,7 +138,6 @@ and lambda = {
  l_closure : env;
  mutable l_name : string option;
  mutable l_compiled : vm_closure option;  (** Lazy JIT cache *)
  mutable l_call_count : int;              (** Tiered-compilation counter — JIT after threshold calls *)
 }
 and component = {
@@ -450,20 +449,7 @@ let make_lambda params body closure =
    | List items -> List.map value_to_string items
    | _ -> value_to_string_list params
  in
-  Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None; l_compiled = None; l_call_count = 0 }
+  Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None; l_compiled = None }
 (** {1 JIT cache control}
    Tiered compilation: only JIT a lambda after it's been called [jit_threshold]
    times. This filters out one-shot lambdas (test harness, dynamic eval, REPLs)
    so they never enter the JIT cache. Counters are exposed to SX as [(jit-stats)].
    These live here (in sx_types) rather than sx_vm so [sx_primitives] can read
    them without creating a sx_primitives → sx_vm dependency cycle. *)
 let jit_threshold = ref 4
 let jit_compiled_count = ref 0
 let jit_skipped_count = ref 0
 let jit_threshold_skipped_count = ref 0
 let make_component name params has_children body closure affinity =
  let n = value_to_string name in
--- a/hosts/ocaml/lib/sx_vm.ml
+++ b/hosts/ocaml/lib/sx_vm.ml
@@ -57,9 +57,6 @@ let () = Sx_types._convert_vm_suspension := (fun exn ->
 let jit_compile_ref : (lambda -> (string, value) Hashtbl.t -> vm_closure option) ref =
  ref (fun _ _ -> None)
 (* JIT threshold and counters live in Sx_types so primitives can read them
   without creating a sx_primitives → sx_vm dependency cycle. *)
 (** Sentinel closure indicating JIT compilation was attempted and failed.
    Prevents retrying compilation on every call. *)
 let jit_failed_sentinel = {
@@ -367,21 +364,13 @@ and vm_call vm f args =
     | None ->
       if l.l_name <> None
       then begin
         l.l_call_count <- l.l_call_count + 1;
         if l.l_call_count >= !Sx_types.jit_threshold then begin
         l.l_compiled <- Some jit_failed_sentinel;
         match !jit_compile_ref l vm.globals with
         | Some cl ->
             incr Sx_types.jit_compiled_count;
           l.l_compiled <- Some cl;
           push_closure_frame vm cl args
         | None ->
             incr Sx_types.jit_skipped_count;
           push vm (cek_call_or_suspend vm f (List args))
         end else begin
           incr Sx_types.jit_threshold_skipped_count;
           push vm (cek_call_or_suspend vm f (List args))
         end
       end
       else
         push vm (cek_call_or_suspend vm f (List args)))
--- a/lib/apl/parser.sx
+++ b/lib/apl/parser.sx
@@ -270,15 +270,6 @@
              (collect-segments-loop tokens (+ i 1) (append acc {:kind "val" :node (list :str tv)})))
            ((= tt :name)
              (cond
                ((and (< (+ i 1) (len tokens)) (= (tok-type (nth tokens (+ i 1))) :assign))
                  (let
                    ((rhs-tokens (slice tokens (+ i 2) (len tokens))))
                    (let
                      ((rhs-expr (parse-apl-expr rhs-tokens)))
                      (collect-segments-loop
                        tokens
                        (len tokens)
                        (append acc {:kind "val" :node (list :assign-expr tv rhs-expr)})))))
                ((some (fn (q) (= q tv)) apl-quad-fn-names)
                  (let
                    ((op-result (collect-ops tokens (+ i 1))))
@@ -344,22 +335,10 @@
            ((= tt :glyph)
              (cond
                ((or (= tv "⍺") (= tv "⍵"))
                  (if
                    (and
                      (< (+ i 1) (len tokens))
                      (= (tok-type (nth tokens (+ i 1))) :assign))
                    (let
                      ((rhs-tokens (slice tokens (+ i 2) (len tokens))))
                      (let
                        ((rhs-expr (parse-apl-expr rhs-tokens)))
                        (collect-segments-loop
                          tokens
                          (len tokens)
                          (append acc {:kind "val" :node (list :assign-expr tv rhs-expr)}))))
                  (collect-segments-loop
                    tokens
                    (+ i 1)
-                      (append acc {:kind "val" :node (list :name tv)}))))
+                    (append acc {:kind "val" :node (list :name tv)})))
                ((= tv "∇")
                  (collect-segments-loop
                    tokens
@@ -414,13 +393,7 @@
                            ni
                            (append acc {:kind "fn" :node fn-node})))))))
                ((apl-parse-op-glyph? tv)
-                  (if
+                  (collect-segments-loop tokens (+ i 1) acc))
                    (or (= tv "/") (= tv "⌿") (= tv "\\") (= tv "⍀"))
                    (collect-segments-loop
                      tokens
                      (+ i 1)
                      (append acc {:kind "fn" :node (list :fn-glyph tv)}))
                    (collect-segments-loop tokens (+ i 1) acc)))
                (true (collect-segments-loop tokens (+ i 1) acc))))
            (true (collect-segments-loop tokens (+ i 1) acc))))))))
--- a/lib/apl/runtime.sx
+++ b/lib/apl/runtime.sx
@@ -808,25 +808,6 @@
          ((picked (map (fn (i) (nth arr-ravel i)) kept)))
          (make-array (list (len picked)) picked))))))
 (define
  apl-compress-first
  (fn
    (mask arr)
    (let
      ((mask-ravel (get mask :ravel))
        (shape (get arr :shape))
        (ravel (get arr :ravel)))
      (if
        (< (len shape) 2)
        (apl-compress mask arr)
        (let
          ((rows (first shape)) (cols (last shape)))
          (let
            ((kept-rows (filter (fn (i) (not (= 0 (nth mask-ravel i)))) (range 0 rows))))
            (let
              ((new-ravel (reduce (fn (acc r) (append acc (map (fn (j) (nth ravel (+ (* r cols) j))) (range 0 cols)))) (list) kept-rows)))
              (make-array (cons (len kept-rows) (rest shape)) new-ravel))))))))
 (define
  apl-primes
  (fn
@@ -1004,28 +985,6 @@
        (some (fn (c) (= c 0)) codes)
        (some (fn (c) (= c (nth e 1))) codes)))))
 (define apl-rng-state 12345)
 (define apl-rng-seed! (fn (s) (set! apl-rng-state s)))
 (define
  apl-rng-next!
  (fn
    ()
    (begin
      (set!
        apl-rng-state
        (mod (+ (* apl-rng-state 1103515245) 12345) 2147483648))
      apl-rng-state)))
 (define
  apl-roll
  (fn
    (arr)
    (let
      ((n (if (scalar? arr) (first (get arr :ravel)) (first (get arr :ravel)))))
      (apl-scalar (+ apl-io (mod (apl-rng-next!) n))))))
 (define
  apl-cartesian
  (fn
--- a/lib/apl/tests/pipeline.sx
+++ b/lib/apl/tests/pipeline.sx
@@ -312,146 +312,3 @@
  "train: mean of ⍳10 has shape ()"
  (mksh (apl-run "(+/÷≢) ⍳10"))
  (list))
 (apl-test
  "compress: 1 0 1 0 1 / 10 20 30 40 50"
  (mkrv (apl-run "1 0 1 0 1 / 10 20 30 40 50"))
  (list 10 30 50))
 (apl-test
  "compress: empty mask → empty"
  (mkrv (apl-run "0 0 0 / 1 2 3"))
  (list))
 (apl-test
  "primes via classic idiom (multi-stmt)"
  (mkrv (apl-run "P ← ⍳ 30 ⋄ (2 = +⌿ 0 = P ∘.| P) / P"))
  (list 2 3 5 7 11 13 17 19 23 29))
 (apl-test
  "primes via classic idiom (n=20)"
  (mkrv (apl-run "P ← ⍳ 20 ⋄ (2 = +⌿ 0 = P ∘.| P) / P"))
  (list 2 3 5 7 11 13 17 19))
 (apl-test
  "compress: filter even values"
  (mkrv (apl-run "(0 = 2 | 1 2 3 4 5 6) / 1 2 3 4 5 6"))
  (list 2 4 6))
 (apl-test "inline-assign: x ← 5" (mkrv (apl-run "x ← 5")) (list 5))
 (apl-test
  "inline-assign: (2×x) + x←10 → 30"
  (mkrv (apl-run "(2 × x) + x ← 10"))
  (list 30))
 (apl-test
  "inline-assign primes one-liner: (2=+⌿0=a∘.|a)/a←⍳30"
  (mkrv (apl-run "(2 = +⌿ 0 = a ∘.| a) / a ← ⍳ 30"))
  (list 2 3 5 7 11 13 17 19 23 29))
 (apl-test
  "inline-assign: x is reusable — x + x ← 7 → 14"
  (mkrv (apl-run "x + x ← 7"))
  (list 14))
 (apl-test
  "inline-assign in dfn: f ← {x + x ← ⍵} ⋄ f 8 → 16"
  (mkrv (apl-run "f ← {x + x ← ⍵} ⋄ f 8"))
  (list 16))
 (begin (apl-rng-seed! 42) nil)
 (apl-test
  "?10 with seed 42 → 8 (deterministic)"
  (mkrv (apl-run "?10"))
  (list 8))
 (apl-test "?10 next call → 5" (mkrv (apl-run "?10")) (list 5))
 (apl-test
  "?100 stays in range"
  (let ((v (first (mkrv (apl-run "?100"))))) (and (>= v 1) (<= v 100)))
  true)
 (begin (apl-rng-seed! 42) nil)
 (apl-test
  "?10 with re-seed 42 → 8 (reproducible)"
  (mkrv (apl-run "?10"))
  (list 8))
 (apl-test
  "apl-run-file: load primes.apl returns dfn AST"
  (first (apl-run-file "lib/apl/tests/programs/primes.apl"))
  :dfn)
 (apl-test
  "apl-run-file: life.apl parses without error"
  (first (apl-run-file "lib/apl/tests/programs/life.apl"))
  :dfn)
 (apl-test
  "apl-run-file: quicksort.apl parses without error"
  (first (apl-run-file "lib/apl/tests/programs/quicksort.apl"))
  :dfn)
 (apl-test
  "apl-run-file: source-then-call returns primes count"
  (mksh
    (apl-run
      (str (file-read "lib/apl/tests/programs/primes.apl") " ⋄ primes 30")))
  (list 10))
 (apl-test
  "primes one-liner with ⍵-rebind: primes 30"
  (mkrv
    (apl-run "primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵} ⋄ primes 30"))
  (list 2 3 5 7 11 13 17 19 23 29))
 (apl-test
  "primes one-liner: primes 50"
  (mkrv
    (apl-run "primes ← {(2=+⌿0=⍵∘.|⍵)/⍵←⍳⍵} ⋄ primes 50"))
  (list 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47))
 (apl-test
  "primes.apl loaded + called via apl-run-file"
  (mkrv
    (apl-run
      (str (file-read "lib/apl/tests/programs/primes.apl") " ⋄ primes 20")))
  (list 2 3 5 7 11 13 17 19))
 (apl-test
  "primes.apl loaded — count of primes ≤ 100"
  (first
    (mksh
      (apl-run
        (str
          (file-read "lib/apl/tests/programs/primes.apl")
          " ⋄ primes 100"))))
  25)
 (apl-test
  "⍉ monadic transpose 2x3 → 3x2"
  (mkrv (apl-run "⍉ (2 3) ⍴ ⍳6"))
  (list 1 4 2 5 3 6))
 (apl-test
  "⍉ transpose shape (3 2)"
  (mksh (apl-run "⍉ (2 3) ⍴ ⍳6"))
  (list 3 2))
 (apl-test "⊢ monadic identity" (mkrv (apl-run "⊢ 1 2 3")) (list 1 2 3))
 (apl-test
  "5 ⊣ 1 2 3 → 5 (left)"
  (mkrv (apl-run "5 ⊣ 1 2 3"))
  (list 5))
 (apl-test
  "5 ⊢ 1 2 3 → 1 2 3 (right)"
  (mkrv (apl-run "5 ⊢ 1 2 3"))
  (list 1 2 3))
 (apl-test "⍕ 42 → \"42\" (alias for ⎕FMT)" (apl-run "⍕ 42") "42")
--- a/lib/apl/tests/programs.sx
+++ b/lib/apl/tests/programs.sx
@@ -252,6 +252,8 @@
 (apl-test "queens 7 → 40 solutions" (mkrv (apl-queens 7)) (list 40))
 (apl-test "queens 8 → 92 solutions" (mkrv (apl-queens 8)) (list 92))
 (apl-test "permutations of 3 has 6" (len (apl-permutations 3)) 6)
 (apl-test "permutations of 4 has 24" (len (apl-permutations 4)) 24)
--- a/lib/apl/transpile.sx
+++ b/lib/apl/transpile.sx
@@ -39,11 +39,6 @@
      ((= g "⊖") apl-reverse-first)
      ((= g "⍋") apl-grade-up)
      ((= g "⍒") apl-grade-down)
      ((= g "?") apl-roll)
      ((= g "⍉") apl-transpose)
      ((= g "⊢") (fn (a) a))
      ((= g "⊣") (fn (a) a))
      ((= g "⍕") apl-quad-fmt)
      ((= g "⎕FMT") apl-quad-fmt)
      ((= g "⎕←") apl-quad-print)
      (else (error "no monadic fn for glyph")))))
@@ -85,11 +80,6 @@
      ((= g "∊") apl-member)
      ((= g "⍳") apl-index-of)
      ((= g "~") apl-without)
      ((= g "/") apl-compress)
      ((= g "⌿") apl-compress-first)
      ((= g "⍉") apl-transpose-dyadic)
      ((= g "⊢") (fn (a b) b))
      ((= g "⊣") (fn (a b) a))
      (else (error "no dyadic fn for glyph")))))
 (define
@@ -129,14 +119,8 @@
          (let
            ((nm (nth node 1)))
            (cond
-              ((= nm "⍺")
+              ((= nm "⍺") (get env "alpha"))
-                (let
+              ((= nm "⍵") (get env "omega"))
                  ((v (get env "⍺")))
                  (if (= v nil) (get env "alpha") v)))
              ((= nm "⍵")
                (let
                  ((v (get env "⍵")))
                  (if (= v nil) (get env "omega") v)))
              ((= nm "⎕IO") (apl-quad-io))
              ((= nm "⎕ML") (apl-quad-ml))
              ((= nm "⎕FR") (apl-quad-fr))
@@ -148,11 +132,7 @@
            (if
              (and (= (first fn-node) :fn-glyph) (= (nth fn-node 1) "∇"))
              (apl-call-dfn-m (get env "nabla") (apl-eval-ast arg env))
-              (let
+              ((apl-resolve-monadic fn-node env) (apl-eval-ast arg env)))))
                ((arg-val (apl-eval-ast arg env)))
                (let
                  ((new-env (if (and (list? arg) (> (len arg) 0) (= (first arg) :assign-expr)) (assoc env (nth arg 1) arg-val) env)))
                  ((apl-resolve-monadic fn-node new-env) arg-val))))))
        ((= tag :dyad)
          (let
            ((fn-node (nth node 1))
@@ -164,13 +144,9 @@
                (get env "nabla")
                (apl-eval-ast lhs env)
                (apl-eval-ast rhs env))
-              (let
+              ((apl-resolve-dyadic fn-node env)
-                ((rhs-val (apl-eval-ast rhs env)))
+                (apl-eval-ast lhs env)
-                (let
+                (apl-eval-ast rhs env)))))
                  ((new-env (if (and (list? rhs) (> (len rhs) 0) (= (first rhs) :assign-expr)) (assoc env (nth rhs 1) rhs-val) env)))
                  ((apl-resolve-dyadic fn-node new-env)
                    (apl-eval-ast lhs new-env)
                    rhs-val))))))
        ((= tag :program) (apl-eval-stmts (rest node) env))
        ((= tag :dfn) node)
        ((= tag :bracket)
@@ -183,8 +159,6 @@
                    (fn (a) (if (= a :all) nil (apl-eval-ast a env)))
                    axis-exprs)))
              (apl-bracket-multi axes arr))))
        ((= tag :assign-expr) (apl-eval-ast (nth node 2) env))
        ((= tag :assign) (apl-eval-ast (nth node 2) env))
        (else (error (list "apl-eval-ast: unknown node tag" tag node)))))))
 (define
@@ -564,5 +538,3 @@
        (else (error "apl-resolve-dyadic: unknown fn-node tag"))))))
 (define apl-run (fn (src) (apl-eval-ast (parse-apl src) {})))
 (define apl-run-file (fn (path) (apl-run (file-read path))))
--- a/lib/erlang/conformance.sh
+++ b/lib/erlang/conformance.sh
@@ -76,7 +76,7 @@ cat > "$TMPFILE" << 'EPOCHS'
 (eval "(list er-fib-test-pass er-fib-test-count)")
 EPOCHS
-timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
+timeout 120 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
 # Parse "(N M)" from the line after each "(ok-len <epoch> ...)" marker.
 parse_pair() {
--- a/lib/erlang/scoreboard.json
+++ b/lib/erlang/scoreboard.json
@@ -1,16 +1,16 @@
 {
  "language": "erlang",
-  "total_pass": 530,
+  "total_pass": 0,
-  "total": 530,
+  "total": 0,
  "suites": [
-    {"name":"tokenize","pass":62,"total":62,"status":"ok"},
+    {"name":"tokenize","pass":0,"total":0,"status":"ok"},
-    {"name":"parse","pass":52,"total":52,"status":"ok"},
+    {"name":"parse","pass":0,"total":0,"status":"ok"},
-    {"name":"eval","pass":346,"total":346,"status":"ok"},
+    {"name":"eval","pass":0,"total":0,"status":"ok"},
-    {"name":"runtime","pass":39,"total":39,"status":"ok"},
+    {"name":"runtime","pass":0,"total":0,"status":"ok"},
-    {"name":"ring","pass":4,"total":4,"status":"ok"},
+    {"name":"ring","pass":0,"total":0,"status":"ok"},
-    {"name":"ping-pong","pass":4,"total":4,"status":"ok"},
+    {"name":"ping-pong","pass":0,"total":0,"status":"ok"},
-    {"name":"bank","pass":8,"total":8,"status":"ok"},
+    {"name":"bank","pass":0,"total":0,"status":"ok"},
-    {"name":"echo","pass":7,"total":7,"status":"ok"},
+    {"name":"echo","pass":0,"total":0,"status":"ok"},
-    {"name":"fib","pass":8,"total":8,"status":"ok"}
+    {"name":"fib","pass":0,"total":0,"status":"ok"}
  ]
 }
--- a/lib/erlang/scoreboard.md
+++ b/lib/erlang/scoreboard.md
@@ -1,18 +1,18 @@
 # Erlang-on-SX Scoreboard
-**Total: 530 / 530 tests passing**
+**Total: 0 / 0 tests passing**
 |  | Suite | Pass | Total |
 |---|---|---|---|
-| ✅ | tokenize | 62 | 62 |
+| ✅ | tokenize | 0 | 0 |
-| ✅ | parse | 52 | 52 |
+| ✅ | parse | 0 | 0 |
-| ✅ | eval | 346 | 346 |
+| ✅ | eval | 0 | 0 |
-| ✅ | runtime | 39 | 39 |
+| ✅ | runtime | 0 | 0 |
-| ✅ | ring | 4 | 4 |
+| ✅ | ring | 0 | 0 |
-| ✅ | ping-pong | 4 | 4 |
+| ✅ | ping-pong | 0 | 0 |
-| ✅ | bank | 8 | 8 |
+| ✅ | bank | 0 | 0 |
-| ✅ | echo | 7 | 7 |
+| ✅ | echo | 0 | 0 |
-| ✅ | fib | 8 | 8 |
+| ✅ | fib | 0 | 0 |
 Generated by `lib/erlang/conformance.sh`.
--- a/lib/guest/reflective/env.sx
+++ b/lib/guest/reflective/env.sx
@@ -1,159 +0,0 @@
 ;; lib/guest/reflective/env.sx — first-class environment kit.
 ;;
 ;; Extracted from Kernel-on-SX (lib/kernel/eval.sx) when Tcl's
 ;; uplevel/upvar machinery (lib/tcl/runtime.sx) materialised as a
 ;; second consumer needing the same scope-chain semantics.
 ;;
 ;; Canonical wire shape
 ;; --------------------
 ;;   {:refl-tag :env :bindings DICT :parent ENV-OR-NIL}
 ;;
 ;;   - :bindings is a mutable SX dict keyed by symbol name.
 ;;   - :parent is either another env or nil (root).
 ;;   - Lookup walks the parent chain until a hit or nil.
 ;;   - Default cfg uses dict-set! to mutate bindings in place.
 ;;
 ;; Consumers with their own shape (e.g., Tcl's {:level :locals :parent})
 ;; pass an adapter cfg dict — same trick as lib/guest/match.sx's cfg
 ;; for unification over guest-specific term shapes.
 ;;
 ;; Adapter cfg keys
 ;; ----------------
 ;;   :bindings-of  — fn (scope) → DICT
 ;;   :parent-of    — fn (scope) → SCOPE-OR-NIL
 ;;   :extend       — fn (scope) → SCOPE         (push a fresh child)
 ;;   :bind!        — fn (scope name val) → scope (functional or mutable)
 ;;   :env?         — fn (v) → bool              (predicate; cheap shape check)
 ;;
 ;; Public API — canonical shape, mutable, raises on miss
 ;;
 ;;   (refl-make-env)
 ;;   (refl-extend-env PARENT)
 ;;   (refl-env? V)
 ;;   (refl-env-bind! ENV NAME VAL)
 ;;   (refl-env-has? ENV NAME)
 ;;   (refl-env-lookup ENV NAME)
 ;;   (refl-env-lookup-or-nil ENV NAME)
 ;;
 ;; Public API — adapter-cfg, any shape
 ;;
 ;;   (refl-env-extend-with CFG SCOPE)
 ;;   (refl-env-bind!-with  CFG SCOPE NAME VAL)
 ;;   (refl-env-has?-with   CFG SCOPE NAME)
 ;;   (refl-env-lookup-with CFG SCOPE NAME)
 ;;   (refl-env-lookup-or-nil-with CFG SCOPE NAME)
 ;;   (refl-env-find-frame-with CFG SCOPE NAME)
 ;;     — returns the scope in the chain that contains NAME (or nil).
 ;;       Consumers needing source-frame mutation use this.
 ;;
 ;;   (refl-canonical-cfg) — the default cfg, exposed so consumers
 ;;                          can compare or extend it.
 ;; ── Canonical-shape predicates and constructors ─────────────────
 (define refl-env? (fn (v) (and (dict? v) (= (get v :refl-tag) :env))))
 (define refl-make-env (fn () {:parent nil :refl-tag :env :bindings {}}))
 (define refl-extend-env (fn (parent) {:parent parent :refl-tag :env :bindings {}}))
 (define
  refl-env-bind!
  (fn (env name val) (dict-set! (get env :bindings) name val) env))
 (define
  refl-env-has?
  (fn
    (env name)
    (cond
      ((nil? env) false)
      ((not (refl-env? env)) false)
      ((dict-has? (get env :bindings) name) true)
      (:else (refl-env-has? (get env :parent) name)))))
 (define
  refl-env-lookup
  (fn
    (env name)
    (cond
      ((nil? env) (error (str "refl-env-lookup: unbound symbol: " name)))
      ((not (refl-env? env))
        (error (str "refl-env-lookup: corrupt env: " env)))
      ((dict-has? (get env :bindings) name) (get (get env :bindings) name))
      (:else (refl-env-lookup (get env :parent) name)))))
 (define
  refl-env-lookup-or-nil
  (fn
    (env name)
    (cond
      ((nil? env) nil)
      ((not (refl-env? env)) nil)
      ((dict-has? (get env :bindings) name) (get (get env :bindings) name))
      (:else (refl-env-lookup-or-nil (get env :parent) name)))))
 ;; ── Adapter-cfg variants — any wire shape ───────────────────────
 (define refl-env-extend-with (fn (cfg scope) ((get cfg :extend) scope)))
 (define
  refl-env-bind!-with
  (fn (cfg scope name val) ((get cfg :bind!) scope name val)))
 (define
  refl-env-has?-with
  (fn
    (cfg scope name)
    (cond
      ((nil? scope) false)
      ((not ((get cfg :env?) scope)) false)
      ((dict-has? ((get cfg :bindings-of) scope) name) true)
      (:else (refl-env-has?-with cfg ((get cfg :parent-of) scope) name)))))
 (define
  refl-env-lookup-with
  (fn
    (cfg scope name)
    (cond
      ((nil? scope) (error (str "refl-env-lookup: unbound symbol: " name)))
      ((not ((get cfg :env?) scope))
        (error (str "refl-env-lookup: corrupt scope: " scope)))
      ((dict-has? ((get cfg :bindings-of) scope) name)
        (get ((get cfg :bindings-of) scope) name))
      (:else (refl-env-lookup-with cfg ((get cfg :parent-of) scope) name)))))
 (define
  refl-env-lookup-or-nil-with
  (fn
    (cfg scope name)
    (cond
      ((nil? scope) nil)
      ((not ((get cfg :env?) scope)) nil)
      ((dict-has? ((get cfg :bindings-of) scope) name)
        (get ((get cfg :bindings-of) scope) name))
      (:else
        (refl-env-lookup-or-nil-with cfg ((get cfg :parent-of) scope) name)))))
 ;; Returns the SCOPE in the chain that contains NAME, or nil if no
 ;; scope binds it. Consumers (e.g. Smalltalk) use this to mutate the
 ;; binding at its source frame rather than introducing a new shadow
 ;; binding at the current frame. Pairs with `refl-env-lookup-with`
 ;; for callers that need both the value and the defining scope.
 (define refl-env-find-frame-with
  (fn (cfg scope name)
    (cond
      ((nil? scope) nil)
      ((not ((get cfg :env?) scope)) nil)
      ((dict-has? ((get cfg :bindings-of) scope) name) scope)
      (:else
        (refl-env-find-frame-with cfg ((get cfg :parent-of) scope) name)))))
 (define refl-env-find-frame
  (fn (env name) (refl-env-find-frame-with refl-canonical-cfg env name)))
 ;; ── Default canonical cfg ───────────────────────────────────────
 ;; Exposed so consumers can use it explicitly, compose with it, or
 ;; check adapter-correctness against the canonical implementation.
 (define refl-canonical-cfg {:bind! (fn (e n v) (refl-env-bind! e n v)) :parent-of (fn (e) (get e :parent)) :env? (fn (v) (refl-env? v)) :bindings-of (fn (e) (get e :bindings)) :extend (fn (e) (refl-extend-env e))})
--- a/lib/guest/test-runner.sx
+++ b/lib/guest/test-runner.sx
@@ -1,50 +0,0 @@
 ;; lib/guest/test-runner.sx — per-suite test harness for guest test files.
 ;;
 ;; Across the codebase 142+ test files implement the identical four-form
 ;; boilerplate: `<X>-test-pass`, `<X>-test-fail`, `<X>-test-fails`, and
 ;; an `<X>-test` recording function. Only the prefix differs. This kit
 ;; collapses the boilerplate to a per-suite mutable dict + a recording
 ;; helper, so each test file goes from ~12 lines of harness to ~3:
 ;;
 ;;   (define ke-suite (refl-make-test-suite))
 ;;   (define ke-test  (fn (n a e) (refl-test ke-suite n a e)))
 ;;   (define ke-tests-run! (fn () (refl-test-report ke-suite)))
 ;;
 ;; The suite is a mutable dict `{:pass N :fail N :fails LIST}`. Each
 ;; failed assertion appends `{:name NAME :expected EXPECTED :actual ACT}`
 ;; to :fails — same shape every existing harness already produces.
 ;;
 ;; The `:fails` list is mutated in place via `append!`, so callers who
 ;; have a reference to it see the same updates. (Same semantic the
 ;; existing per-suite globals had — just held in the suite dict now.)
 ;;
 ;; Public API
 ;;   (refl-make-test-suite)              — fresh suite
 ;;   (refl-test SUITE NAME ACT EXP)      — record one assertion
 ;;   (refl-test-report SUITE)            — return {:total :passed :failed :fails}
 ;;   (refl-test-pass? SUITE)             — convenience: all green?
 ;;   (refl-test-suite? V)                — predicate
 (define refl-make-test-suite (fn () {:fail 0 :pass 0 :fails (list)}))
 (define
  refl-test-suite?
  (fn
    (v)
    (and (dict? v) (number? (get v :pass)) (number? (get v :fail)))))
 (define
  refl-test
  (fn
    (suite name actual expected)
    (cond
      ((= actual expected)
        (dict-set! suite :pass (+ (get suite :pass) 1)))
      (:else
        (begin
          (dict-set! suite :fail (+ (get suite :fail) 1))
          (append! (get suite :fails) {:name name :actual actual :expected expected}))))))
 (define refl-test-report (fn (suite) {:total (+ (get suite :pass) (get suite :fail)) :passed (get suite :pass) :failed (get suite :fail) :fails (get suite :fails)}))
 (define refl-test-pass? (fn (suite) (= (get suite :fail) 0)))
--- a/lib/haskell/desugar.sx
+++ b/lib/haskell/desugar.sx
@@ -210,6 +210,7 @@
                :op (nth node 1)
                (hk-desugar (nth node 2))
                (hk-desugar (nth node 3))))
            ((= tag "type-ann") (hk-desugar (nth node 1)))
            ((= tag "neg") (list :neg (hk-desugar (nth node 1))))
            ((= tag "if")
              (list
--- a/lib/haskell/parser.sx
+++ b/lib/haskell/parser.sx
@@ -275,9 +275,18 @@
                            (list :sect-right op-name expr-e))))))
                  (:else
                    (let
-                      ((first-e (hk-parse-expr-inner))
+                      ((first-e (hk-parse-expr-inner)))
-                        (items (list))
+                      (cond
-                        (is-tuple false))
+                        ((hk-match? "reservedop" "::")
                          (do
                            (hk-advance!)
                            (let
                              ((ann-type (hk-parse-type)))
                              (hk-expect! "rparen" nil)
                              (list :type-ann first-e ann-type))))
                        (:else
                          (let
                            ((items (list)) (is-tuple false))
                            (append! items first-e)
                            (define
                              hk-tup-loop
@@ -306,7 +315,7 @@
                                        (hk-consume-op!)
                                        (hk-advance!)
                                        (list :sect-left op-name first-e)))
-                              (:else (hk-err "expected ')' after expression"))))))))))))))
+                                    (:else (hk-err "expected ')' after expression")))))))))))))))))
      (define
        hk-comp-qual-is-gen?
        (fn
@@ -1724,10 +1733,18 @@
                  (= (hk-peek-type) "eof")
                  (hk-match? "vrbrace" nil)
                  (hk-match? "rbrace" nil))))
            (define
              hk-body-step
              (fn
                ()
                (cond
                  ((hk-match? "reserved" "import")
                    (append! imports (hk-parse-import)))
                  (:else (append! decls (hk-parse-decl))))))
            (when
              (not (hk-body-at-end?))
              (do
-                (append! decls (hk-parse-decl))
+                (hk-body-step)
                (define
                  hk-body-loop
                  (fn
@@ -1738,7 +1755,7 @@
                        (hk-advance!)
                        (when
                          (not (hk-body-at-end?))
-                          (append! decls (hk-parse-decl)))
+                          (hk-body-step))
                        (hk-body-loop)))))
                (hk-body-loop)))
            (list imports decls))))
--- a/lib/haskell/tests/parse-extras.sx
+++ b/lib/haskell/tests/parse-extras.sx
@@ -0,0 +1,102 @@
 ;; Phase 17 — parser polish unit tests.
 (hk-test
  "type-ann: literal int annotated"
  (hk-deep-force (hk-run "main = (42 :: Int)"))
  42)
 (hk-test
  "type-ann: arithmetic annotated"
  (hk-deep-force (hk-run "main = (1 + 2 :: Int)"))
  3)
 (hk-test
  "type-ann: function arg annotated"
  (hk-deep-force
    (hk-run "f x = x + 1\nmain = f (1 :: Int)"))
  2)
 (hk-test
  "type-ann: string annotated"
  (hk-deep-force (hk-run "main = (\"hi\" :: String)"))
  "hi")
 (hk-test
  "type-ann: bool annotated"
  (hk-deep-force (hk-run "main = (True :: Bool)"))
  (list "True"))
 (hk-test
  "type-ann: tuple annotated"
  (hk-deep-force (hk-run "main = ((1, 2) :: (Int, Int))"))
  (list "Tuple" 1 2))
 (hk-test
  "type-ann: nested annotation in arithmetic"
  (hk-deep-force (hk-run "main = (1 :: Int) + (2 :: Int)"))
  3)
 (hk-test
  "type-ann: function-typed annotation passes through eval"
  (hk-deep-force
    (hk-run "main = let f = ((\\x -> x + 1) :: Int -> Int) in f 5"))
  6)
 (hk-test
  "no regression: plain parens still work"
  (hk-deep-force (hk-run "main = (5)"))
  5)
 (hk-test
  "no regression: 3-tuple still works"
  (hk-deep-force (hk-run "main = (1, 2, 3)"))
  (list "Tuple" 1 2 3))
 (hk-test
  "no regression: section-left still works"
  (hk-deep-force (hk-run "main = (3 +) 4"))
  7)
 (hk-test
  "no regression: section-right still works"
  (hk-deep-force (hk-run "main = (+ 3) 4"))
  7)
 (hk-test
  "import: still works as the very first decl"
  (hk-deep-force
    (hk-run "import qualified Data.IORef as I
 main = do { r <- I.newIORef 7; I.readIORef r }"))
  (list "IO" 7))
 (hk-test
  "import: between decls — after main"
  (hk-deep-force
    (hk-run "main = do { r <- I.newIORef 11; I.readIORef r }
 import qualified Data.IORef as I"))
  (list "IO" 11))
 (hk-test
  "import: between two decls — uses helper after import"
  (hk-deep-force
    (hk-run "f x = x + 100
 import qualified Data.IORef as I
 main = do { r <- I.newIORef 5; I.modifyIORef r f; I.readIORef r }"))
  (list "IO" 105))
 (hk-test
  "import: two imports in different positions"
  (hk-deep-force
    (hk-run "import qualified Data.IORef as I
 helper x = x * 2
 import qualified Data.Map as M
 main = do { r <- I.newIORef (helper 21); I.readIORef r }"))
  (list "IO" 42))
 (hk-test
  "import: unqualified, mid-file"
  (hk-deep-force
    (hk-run "go x = x
 import Data.IORef
 main = go 9"))
  9)
--- a/lib/haskell/tests/typecheck.sx
+++ b/lib/haskell/tests/typecheck.sx
@@ -16,15 +16,18 @@
      true)))
 ;; ─── Valid programs pass through ─────────────────────────────────────────────
-(hk-test "typed ok: simple arithmetic" (hk-run-typed "main = 1 + 2") 3)
+(hk-test "typed ok: simple arithmetic"
  (hk-deep-force (hk-run-typed "main = 1 + 2")) 3)
-(hk-test "typed ok: boolean" (hk-run-typed "main = True") (list "True"))
+(hk-test "typed ok: boolean"
  (hk-deep-force (hk-run-typed "main = True")) (list "True"))
-(hk-test "typed ok: let binding" (hk-run-typed "main = let x = 1 in x + 2") 3)
+(hk-test "typed ok: let binding"
  (hk-deep-force (hk-run-typed "main = let x = 1 in x + 2")) 3)
 (hk-test
  "typed ok: two independent fns"
-  (hk-run-typed "f x = x + 1\nmain = f 5")
+  (hk-deep-force (hk-run-typed "f x = x + 1\nmain = f 5"))
  6)
 ;; ─── Untypeable programs are rejected ────────────────────────────────────────
@@ -76,7 +79,7 @@
 (hk-test
  "run-typed sig ok: Int declared matches"
-  (hk-run-typed "main :: Int\nmain = 1 + 2")
+  (hk-deep-force (hk-run-typed "main :: Int\nmain = 1 + 2"))
  3)
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/hyperscript/compiler.sx
+++ b/lib/hyperscript/compiler.sx
@@ -226,28 +226,6 @@
                            value)
                          (list (quote set!) (hs-to-sx target) value)))))))
              (true (list (quote set!) (hs-to-sx target) value)))))))
    ;; Throttle/debounce extraction state — module-level so they don't get
    ;; redefined on every emit-on call (which was causing JIT churn). Set
    ;; via _strip-throttle-debounce at the start of each emit-on, used in
    ;; the handler-build step inside scan-on.
    (define _throttle-ms nil)
    (define _debounce-ms nil)
    (define
      _strip-throttle-debounce
      (fn
        (lst)
        (cond
          ((<= (len lst) 1) lst)
          ((= (first lst) :throttle)
            (do
              (set! _throttle-ms (nth lst 1))
              (_strip-throttle-debounce (rest (rest lst)))))
          ((= (first lst) :debounce)
            (do
              (set! _debounce-ms (nth lst 1))
              (_strip-throttle-debounce (rest (rest lst)))))
          (true
            (cons (first lst) (_strip-throttle-debounce (rest lst)))))))
    (define
      emit-on
      (fn
@@ -256,8 +234,6 @@
          ((parts (rest ast)))
          (let
            ((event-name (first parts)))
            (set! _throttle-ms nil)
            (set! _debounce-ms nil)
            (define
              scan-on
              (fn
@@ -290,13 +266,6 @@
                                  ((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (hs-to-sx finally-info) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))) (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body))))
                                  (let
                                    ((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (let ((base-handler (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body)))) (if count-filter-info (let ((mn (get count-filter-info "min")) (mx (get count-filter-info "max"))) (list (quote let) (list (list (quote __hs-count) 0)) (list (quote fn) (list (quote event)) (list (quote begin) (list (quote set!) (quote __hs-count) (list (quote +) (quote __hs-count) 1)) (list (quote when) (if (= mx -1) (list (quote >=) (quote __hs-count) mn) (list (quote and) (list (quote >=) (quote __hs-count) mn) (list (quote <=) (quote __hs-count) mx))) (nth base-handler 2)))))) base-handler)))))
                                    (let
                                      ((handler (cond
                                                  (_throttle-ms
                                                    (list (quote hs-throttle!) handler (hs-to-sx _throttle-ms)))
                                                  (_debounce-ms
                                                    (list (quote hs-debounce!) handler (hs-to-sx _debounce-ms)))
                                                  (true handler))))
                                    (let
                                      ((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler))))
                                      (cond
@@ -356,7 +325,7 @@
                                                      (first pair)
                                                      handler))
                                                  or-sources)))
-                                            on-call))))))))))))))
+                                            on-call)))))))))))))
                  ((= (first items) :from)
                    (scan-on
                      (rest (rest items))
@@ -500,7 +469,7 @@
                      count-filter-info
                      elsewhere?
                      or-sources)))))
-            (scan-on (_strip-throttle-debounce (rest parts)) nil nil false nil nil nil nil nil false nil)))))
+            (scan-on (rest parts) nil nil false nil nil nil nil nil false nil)))))
    (define
      emit-send
      (fn
@@ -2521,15 +2490,6 @@
                            (quote fn)
                            (list (quote it))
                            (hs-to-sx body))))
                      ((and (list? expr) (= (first expr) (quote attr)))
                        (list
                          (quote hs-attr-watch!)
                          (hs-to-sx (nth expr 2))
                          (nth expr 1)
                          (list
                            (quote fn)
                            (list (quote it))
                            (hs-to-sx body))))
                      (true nil))))
                ((= head (quote init))
                  (list
--- a/lib/hyperscript/parser.sx
+++ b/lib/hyperscript/parser.sx
@@ -1358,17 +1358,7 @@
                          cls
                          (first extra-classes)
                          tgt))
-                      ((and
+                      ((match-kw "for")
                          (= (tp-type) "keyword") (= (tp-val) "for")
                          ;; Only consume 'for' as a duration clause if the next
                          ;; token is NOT '<ident> in ...' — that pattern is a
                          ;; for-in loop, not a toggle duration.
                          (not
                            (and
                              (> (len tokens) (+ p 2))
                              (= (get (nth tokens (+ p 1)) "type") "ident")
                              (= (get (nth tokens (+ p 2)) "value") "in")))
                          (do (adv!) true))
                        (let
                          ((dur (parse-expr)))
                          (list (quote toggle-class-for) cls tgt dur)))
@@ -3100,17 +3090,7 @@
                              (= (tp-val) "queue"))
                            (do (adv!) (adv!)))
                          (let
-                            ((every? (match-kw "every"))
+                            ((every? (match-kw "every")))
                             (throttle-ms nil)
                             (debounce-ms nil))
                            ;; 'throttled at <duration>' / 'debounced at <duration>'
                            ;; — parsed as handler modifiers, captured as :throttle / :debounce parts.
                            (when (and (= (tp-type) "ident") (= (tp-val) "throttled"))
                              (adv!)
                              (when (match-kw "at") (set! throttle-ms (parse-expr))))
                            (when (and (= (tp-type) "ident") (= (tp-val) "debounced"))
                              (adv!)
                              (when (match-kw "at") (set! debounce-ms (parse-expr))))
                            (let
                              ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
                              (let
@@ -3125,10 +3105,6 @@
                                  (match-kw "end")
                                  (let
                                    ((parts (list (quote on) event-name)))
                                    (let
                                      ((parts (if throttle-ms (append parts (list :throttle throttle-ms)) parts)))
                                    (let
                                      ((parts (if debounce-ms (append parts (list :debounce debounce-ms)) parts)))
                                    (let
                                      ((parts (if every? (append parts (list :every true)) parts)))
                                      (let
@@ -3151,7 +3127,7 @@
                                                        ((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
                                                        (let
                                                          ((parts (append parts (list (if (> (len event-vars) 0) (cons (quote do) (append (map (fn (nm) (list (quote ref) nm)) event-vars) (if (and (list? body) (= (first body) (quote do))) (rest body) (list body)))) body)))))
-                                                          parts))))))))))))))))))))))))))))
+                                                          parts))))))))))))))))))))))))))
      (define
        parse-init-feat
        (fn
@@ -3201,7 +3177,6 @@
            (or
              (= (tp-type) "hat")
              (= (tp-type) "local")
              (= (tp-type) "attr")
              (and (= (tp-type) "keyword") (= (tp-val) "dom")))
            (let
              ((expr (parse-expr)))
--- a/lib/hyperscript/runtime.sx
+++ b/lib/hyperscript/runtime.sx
@@ -12,29 +12,6 @@
 ;; Register an event listener. Returns unlisten function.
 ;; (hs-on target event-name handler) → unlisten-fn
 (begin
  (define _hs-config-log-all false)
  (define _hs-log-captured (list))
  (define
    hs-set-log-all!
    (fn (flag) (set! _hs-config-log-all (if flag true false))))
  (define hs-get-log-captured (fn () _hs-log-captured))
  (define
    hs-clear-log-captured!
    (fn () (begin (set! _hs-log-captured (list)) nil)))
  (define
    hs-log-event!
    (fn
      (msg)
      (when
        _hs-config-log-all
        (begin
          (set! _hs-log-captured (append _hs-log-captured (list msg)))
          (host-call (host-global "console") "log" msg)
          nil)))))
 ;; Run an initializer function immediately.
 ;; (hs-init thunk) — called at element boot time
 (define
  hs-each
  (fn
@@ -45,52 +22,17 @@
 ;; (hs-init thunk) — called at element boot time
 (define meta (host-new "Object"))
 ;; Run an initializer function immediately.
 ;; (hs-init thunk) — called at element boot time
 (define
  hs-on-every
  (fn (target event-name handler) (dom-listen target event-name handler)))
 ;; ── Async / timing ──────────────────────────────────────────────
 ;; Wait for a duration in milliseconds.
 ;; In hyperscript, wait is async-transparent — execution pauses.
 ;; Here we use perform/IO suspension for true pause semantics.
 (define
  hs-on-every
  (fn (target event-name handler) (dom-listen target event-name handler)))
 ;; Throttle: drops events that arrive within the window. First event fires
 ;; immediately; subsequent events within `ms` of the previous fire are dropped.
 ;; Returns a wrapped handler suitable for hs-on / hs-on-every.
 (define
  hs-throttle!
  (fn
    (handler ms)
    (let
      ((__hs-last-fire 0))
      (fn
        (event)
        (let
          ((__hs-now (host-call (host-global "Date") "now")))
          (when
            (>= (- __hs-now __hs-last-fire) ms)
            (set! __hs-last-fire __hs-now)
            (handler event)))))))
 ;; Debounce: waits until `ms` has elapsed since the last event before firing.
 ;; In our synchronous test mock no time passes, so the timer fires immediately
 ;; via setTimeout(_, 0); the wrapped handler still gets called once per burst.
 (define
  hs-debounce!
  (fn
    (handler ms)
    (let
      ((__hs-timer nil))
      (fn
        (event)
        (when __hs-timer (host-call (host-global "window") "clearTimeout" __hs-timer))
        (set! __hs-timer
          (host-call (host-global "window") "setTimeout"
            (host-new-function (list "ev") "return arguments[0](arguments[1]);")
            ms handler event))))))
 ;; Wait for a DOM event on a target.
 ;; (hs-wait-for target event-name) — suspends until event fires
 (define
  _hs-on-caller
  (let
@@ -103,7 +45,8 @@
      (host-set! _ctx "meta" _m)
      _ctx)))
-;; Wait for CSS transitions/animations to settle on an element.
+;; Wait for a DOM event on a target.
 ;; (hs-wait-for target event-name) — suspends until event fires
 (define
  hs-on
  (fn
@@ -123,14 +66,14 @@
              (append prev (list unlisten)))
            unlisten))))))
-;; ── Class manipulation ──────────────────────────────────────────
+;; Wait for CSS transitions/animations to settle on an element.
 ;; Toggle a single class on an element.
 (define
  hs-on-every
  (fn (target event-name handler) (dom-listen target event-name handler)))
-;; Toggle between two classes — exactly one is active at a time.
+;; ── Class manipulation ──────────────────────────────────────────
 ;; Toggle a single class on an element.
 (define
  hs-on-intersection-attach!
  (fn
@@ -146,8 +89,7 @@
          (host-call observer "observe" target)
          observer)))))
-;; Take a class from siblings — add to target, remove from others.
+;; Toggle between two classes — exactly one is active at a time.
 ;; (hs-take! target cls) — like radio button class behavior
 (define
  hs-on-mutation-attach!
  (fn
@@ -168,18 +110,19 @@
            (host-call observer "observe" target opts)
            observer))))))
 ;; Take a class from siblings — add to target, remove from others.
 ;; (hs-take! target cls) — like radio button class behavior
 (define hs-init (fn (thunk) (thunk)))
 ;; ── DOM insertion ───────────────────────────────────────────────
 ;; Put content at a position relative to a target.
 ;; pos: "into" | "before" | "after"
-(define hs-init (fn (thunk) (thunk)))
+(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
 ;; ── Navigation / traversal ──────────────────────────────────────
 ;; Navigate to a URL.
 (define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
 ;; Find next sibling matching a selector (or any sibling).
 (begin
  (define
    hs-wait-for
@@ -192,7 +135,7 @@
      (target event-name timeout-ms)
      (perform (list (quote io-wait-event) target event-name timeout-ms)))))
-;; Find previous sibling matching a selector.
+;; Find next sibling matching a selector (or any sibling).
 (define
  hs-settle
  (fn
@@ -200,7 +143,7 @@
    (hs-null-raise! target)
    (when (not (nil? target)) (perform (list (quote io-settle) target)))))
-;; First element matching selector within a scope.
+;; Find previous sibling matching a selector.
 (define
  hs-toggle-class!
  (fn
@@ -210,7 +153,7 @@
      (not (nil? target))
      (host-call (host-get target "classList") "toggle" cls))))
-;; Last element matching selector.
+;; First element matching selector within a scope.
 (define
  hs-toggle-var-cycle!
  (fn
@@ -232,7 +175,7 @@
          var-name
          (if (= idx -1) (first values) (nth values (mod (+ idx 1) n))))))))
-;; First/last within a specific scope.
+;; Last element matching selector.
 (define
  hs-toggle-between!
  (fn
@@ -245,6 +188,7 @@
        (do (dom-remove-class target cls1) (dom-add-class target cls2))
        (do (dom-remove-class target cls2) (dom-add-class target cls1))))))
 ;; First/last within a specific scope.
 (define
  hs-toggle-style!
  (fn
@@ -268,9 +212,6 @@
            (dom-set-style target prop "hidden")
            (dom-set-style target prop "")))))))
 ;; ── Iteration ───────────────────────────────────────────────────
 ;; Repeat a thunk N times.
 (define
  hs-toggle-style-between!
  (fn
@@ -282,7 +223,9 @@
        (dom-set-style target prop val2)
        (dom-set-style target prop val1)))))
-;; Repeat forever (until break — relies on exception/continuation).
+;; ── Iteration ───────────────────────────────────────────────────
 ;; Repeat a thunk N times.
 (define
  hs-toggle-style-cycle!
  (fn
@@ -303,10 +246,7 @@
            (true (find-next (rest remaining))))))
      (dom-set-style target prop (find-next vals)))))
-;; ── Fetch ───────────────────────────────────────────────────────
+;; Repeat forever (until break — relies on exception/continuation).
 ;; Fetch a URL, parse response according to format.
 ;; (hs-fetch url format) — format is "json" | "text" | "html"
 (define
  hs-take!
  (fn
@@ -329,7 +269,8 @@
            (when with-cls (dom-remove-class target with-cls))))
        (let
          ((attr-val (if (> (len extra) 0) (first extra) nil))
-            (with-val (if (> (len extra) 1) (nth extra 1) nil)))
+            (with-val
              (if (> (len extra) 1) (nth extra 1) nil)))
          (do
            (for-each
              (fn
@@ -346,10 +287,10 @@
              (dom-set-attr target name attr-val)
              (dom-set-attr target name ""))))))))
-;; ── Type coercion ───────────────────────────────────────────────
+;; ── Fetch ───────────────────────────────────────────────────────
-;; Coerce a value to a type by name.
+;; Fetch a URL, parse response according to format.
-;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
+;; (hs-fetch url format) — format is "json" | "text" | "html"
 (begin
  (define
    hs-element?
@@ -506,10 +447,10 @@
                    (dom-insert-adjacent-html target "beforeend" value)
                    (hs-boot-subtree! target)))))))))))
-;; ── Object creation ─────────────────────────────────────────────
+;; ── Type coercion ───────────────────────────────────────────────
-;; Make a new object of a given type.
+;; Coerce a value to a type by name.
-;; (hs-make type-name) — creates empty object/collection
+;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
 (define
  hs-add-to!
  (fn
@@ -523,11 +464,10 @@
      ((hs-is-set? target) (do (host-call target "add" value) target))
      (true (do (host-call target "push" value) target)))))
-;; ── Behavior installation ───────────────────────────────────────
+;; ── Object creation ─────────────────────────────────────────────
-;; Install a behavior on an element.
+;; Make a new object of a given type.
-;; A behavior is a function that takes (me ...params) and sets up features.
+;; (hs-make type-name) — creates empty object/collection
 ;; (hs-install behavior-fn me ...args)
 (define
  hs-remove-from!
  (fn
@@ -537,10 +477,11 @@
      ((hs-is-set? target) (do (host-call target "delete" value) target))
      (true (host-call target "splice" (host-call target "indexOf" value) 1)))))
-;; ── Measurement ─────────────────────────────────────────────────
+;; ── Behavior installation ───────────────────────────────────────
-;; Measure an element's bounding rect, store as local variables.
+;; Install a behavior on an element.
-;; Returns a dict with x, y, width, height, top, left, right, bottom.
+;; A behavior is a function that takes (me ...params) and sets up features.
 ;; (hs-install behavior-fn me ...args)
 (define
  hs-splice-at!
  (fn
@@ -553,7 +494,10 @@
          ((i (if (< idx 0) (+ n idx) idx)))
          (cond
            ((or (< i 0) (>= i n)) target)
-            (true (concat (slice target 0 i) (slice target (+ i 1) n))))))
+            (true
              (concat
                (slice target 0 i)
                (slice target (+ i 1) n))))))
      (do
        (when
          target
@@ -564,10 +508,10 @@
              (host-call target "splice" i 1))))
        target))))
-;; Return the current text selection as a string.  In the browser this is
+;; ── Measurement ─────────────────────────────────────────────────
-;; `window.getSelection().toString()`.  In the mock test runner, a test
+
-;; setup stashes the desired selection text at `window.__test_selection`
+;; Measure an element's bounding rect, store as local variables.
-;; and the fallback path returns that so tests can assert on the result.
+;; Returns a dict with x, y, width, height, top, left, right, bottom.
 (define
  hs-index
  (fn
@@ -579,11 +523,10 @@
      ((string? obj) (nth obj key))
      (true (host-get obj key)))))
-
+;; Return the current text selection as a string.  In the browser this is
-;; ── Transition ──────────────────────────────────────────────────
+;; `window.getSelection().toString()`.  In the mock test runner, a test
-
+;; setup stashes the desired selection text at `window.__test_selection`
-;; Transition a CSS property to a value, optionally with duration.
+;; and the fallback path returns that so tests can assert on the result.
 ;; (hs-transition target prop value duration)
 (define
  hs-put-at!
  (fn
@@ -605,6 +548,11 @@
                ((= pos "start") (host-call target "unshift" value)))
              target)))))))
 ;; ── Transition ──────────────────────────────────────────────────
 ;; Transition a CSS property to a value, optionally with duration.
 ;; (hs-transition target prop value duration)
 (define
  hs-dict-without
  (fn
@@ -641,11 +589,6 @@
      ((w (host-global "window")))
      (if w (host-call w "prompt" msg) nil))))
 ;; ── Transition ──────────────────────────────────────────────────
 ;; Transition a CSS property to a value, optionally with duration.
 ;; (hs-transition target prop value duration)
 (define
  hs-answer
  (fn
@@ -654,6 +597,11 @@
      ((w (host-global "window")))
      (if w (if (host-call w "confirm" msg) yes-val no-val) no-val))))
 ;; ── Transition ──────────────────────────────────────────────────
 ;; Transition a CSS property to a value, optionally with duration.
 ;; (hs-transition target prop value duration)
 (define
  hs-answer-alert
  (fn
@@ -714,10 +662,6 @@
            (if (nil? sel) "" (host-call sel "toString" (list))))
          stash)))))
 (define
  hs-reset!
  (fn
@@ -764,6 +708,10 @@
                  (when default-val (dom-set-prop target "value" default-val)))))
            (true nil)))))))
 (define
  hs-next
  (fn
@@ -782,8 +730,7 @@
              ((dom-matches? el sel) el)
              (true (find-next (dom-next-sibling el))))))
        (find-next sibling)))))
-;; ── Sandbox/test runtime additions ──────────────────────────────
+
 ;; Property access — dot notation and .length
 (define
  hs-previous
  (fn
@@ -802,9 +749,10 @@
              ((dom-matches? el sel) el)
              (true (find-prev (dom-get-prop el "previousElementSibling"))))))
        (find-prev sibling)))))
-;; DOM query stub — sandbox returns empty list
+;; ── Sandbox/test runtime additions ──────────────────────────────
 ;; Property access — dot notation and .length
 (define _hs-last-query-sel nil)
-;; Method dispatch — obj.method(args)
+;; DOM query stub — sandbox returns empty list
 (define
  hs-null-raise!
  (fn
@@ -815,9 +763,7 @@
        ((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null")))
        (host-set! (host-global "window") "_hs_null_error" msg)
        (guard (_null-e (true nil)) (raise msg))))))
-
+;; Method dispatch — obj.method(args)
 ;; ── 0.9.90 features ─────────────────────────────────────────────
 ;; beep! — debug logging, returns value unchanged
 (define
  hs-empty-raise!
  (fn
@@ -831,7 +777,9 @@
        ((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null")))
        (host-set! (host-global "window") "_hs_null_error" msg)
        (guard (_null-e (true nil)) (raise msg))))))
-;; Property-based is — check obj.key truthiness
+
 ;; ── 0.9.90 features ─────────────────────────────────────────────
 ;; beep! — debug logging, returns value unchanged
 (define
  hs-query-all-checked
  (fn
@@ -839,14 +787,14 @@
    (let
      ((result (hs-query-all sel)))
      (do (hs-empty-raise! result) result))))
-;; Array slicing (inclusive both ends)
+;; Property-based is — check obj.key truthiness
 (define
  hs-dispatch!
  (fn
    (target event detail)
    (hs-null-raise! target)
    (when (not (nil? target)) (dom-dispatch target event detail))))
-;; Collection: sorted by
+;; Array slicing (inclusive both ends)
 (define
  hs-query-all
  (fn
@@ -854,7 +802,7 @@
    (do
      (host-set! (host-global "window") "_hs_last_query_sel" sel)
      (dom-query-all (dom-document) sel))))
-;; Collection: sorted by descending
+;; Collection: sorted by
 (define
  hs-query-all-in
  (fn
@@ -863,17 +811,17 @@
      (nil? target)
      (hs-query-all sel)
      (host-call target "querySelectorAll" sel))))
-;; Collection: split by
+;; Collection: sorted by descending
 (define
  hs-list-set
  (fn
    (lst idx val)
    (append (take lst idx) (cons val (drop lst (+ idx 1))))))
-;; Collection: joined by
+;; Collection: split by
 (define
  hs-to-number
  (fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
-
+;; Collection: joined by
 (define
  hs-query-first
  (fn
@@ -1003,7 +951,7 @@
                  ((= (str ex) "hs-continue") (do-loop (rest remaining)))
                  (true (raise ex))))))))
      (do-loop items))))
-;; Collection: joined by
+
 (begin
  (define
    hs-append
@@ -1044,7 +992,7 @@
              (host-get value "outerHTML")
              (str value))))
        (true nil)))))
-
+;; Collection: joined by
 (define
  hs-sender
  (fn
@@ -1136,7 +1084,6 @@
              (hs-host-to-sx (perform (list "io-parse-json" raw))))
            ((= fmt "number")
              (hs-to-number (perform (list "io-parse-text" raw))))
            ((= fmt "html") (perform (list "io-parse-html" raw)))
            (true (perform (list "io-parse-text" raw)))))))))
 (define hs-fetch (fn (url format) (hs-fetch-impl url format false)))
@@ -1676,10 +1623,14 @@
                ((ch (substring sel i (+ i 1))))
                (cond
                  ((= ch ".")
-                    (do (flush!) (set! mode "class") (walk (+ i 1))))
+                    (do
                      (flush!)
                      (set! mode "class")
                      (walk (+ i 1))))
                  ((= ch "#")
                    (do (flush!) (set! mode "id") (walk (+ i 1))))
-                  (true (do (set! cur (str cur ch)) (walk (+ i 1)))))))))
+                  (true
                    (do (set! cur (str cur ch)) (walk (+ i 1)))))))))
        (walk 0)
        (flush!)
        {:tag tag :classes classes :id id}))))
@@ -1773,11 +1724,11 @@
    (value type-name)
    (if (nil? value) false (hs-type-check value type-name))))
 (define
  hs-strict-eq
  (fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
 (define
  hs-id=
  (fn
@@ -1809,20 +1760,6 @@
      ((nil? suffix) false)
      (true (ends-with? (str s) (str suffix))))))
 (define
  hs-attr-watch!
  (fn
    (target attr-name handler)
    (let
      ((mo-class (host-get (host-global "window") "MutationObserver")))
      (when
        mo-class
        (let
          ((cb (fn (records observer) (for-each (fn (rec) (when (= (host-get rec "attributeName") attr-name) (handler (host-call target "getAttribute" attr-name)))) records))))
          (let
            ((mo (host-new "MutationObserver" cb)))
            (host-call mo "observe" target {:attributeFilter (list attr-name) :attributes true})))))))
 (define
  hs-scoped-set!
  (fn
@@ -1868,7 +1805,10 @@
      ((and (dict? a) (dict? b))
        (let
          ((pos (host-call a "compareDocumentPosition" b)))
-          (if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
+          (if
            (number? pos)
            (not (= 0 (mod (/ pos 4) 2)))
            false)))
      (true (< (str a) (str b))))))
 (define
@@ -1989,7 +1929,10 @@
      ((and (dict? a) (dict? b))
        (let
          ((pos (host-call a "compareDocumentPosition" b)))
-          (if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
+          (if
            (number? pos)
            (not (= 0 (mod (/ pos 4) 2)))
            false)))
      (true (< (str a) (str b))))))
 (define
@@ -2042,7 +1985,9 @@
 (define
  hs-morph-char
-  (fn (s p) (if (or (< p 0) (>= p (string-length s))) nil (nth s p))))
+  (fn
    (s p)
    (if (or (< p 0) (>= p (string-length s))) nil (nth s p))))
 (define
  hs-morph-index-from
@@ -2070,7 +2015,10 @@
        (q)
        (let
          ((c (hs-morph-char s q)))
-          (if (and c (< (index-of stop c) 0)) (loop (+ q 1)) q))))
+          (if
            (and c (< (index-of stop c) 0))
            (loop (+ q 1))
            q))))
    (let ((e (loop p))) (list (substring s p e) e))))
 (define
@@ -2112,7 +2060,9 @@
                                (append
                                  acc
                                  (list
-                                    (list name (substring s (+ p4 1) close)))))))
+                                    (list
                                      name
                                      (substring s (+ p4 1) close)))))))
                          ((= c2 "'")
                            (let
                              ((close (hs-morph-index-from s "'" (+ p4 1))))
@@ -2122,7 +2072,9 @@
                                (append
                                  acc
                                  (list
-                                    (list name (substring s (+ p4 1) close)))))))
+                                    (list
                                      name
                                      (substring s (+ p4 1) close)))))))
                          (true
                            (let
                              ((r2 (hs-morph-read-until s p4 " \t\n/>")))
@@ -2206,7 +2158,9 @@
              (for-each
                (fn
                  (c)
-                  (when (> (string-length c) 0) (dom-add-class el c)))
+                  (when
                    (> (string-length c) 0)
                    (dom-add-class el c)))
                (split v " ")))
            ((and keep-id (= n "id")) nil)
            (true (dom-set-attr el n v)))))
@@ -2307,7 +2261,8 @@
          ((parts (split resolved ":")))
          (let
            ((prop (first parts))
-              (val (if (> (len parts) 1) (nth parts 1) nil)))
+              (val
                (if (> (len parts) 1) (nth parts 1) nil)))
            (cond
              ((and (not (= prop "display")) (not (= prop "opacity")) (not (= prop "visibility")) (not (= prop "hidden")) (not (= prop "class-hidden")) (not (= prop "class-invisible")) (not (= prop "class-opacity")) (not (= prop "details")) (not (= prop "dialog")) (dict-has? _hs-hide-strategies prop))
                (let
@@ -2347,7 +2302,8 @@
          ((parts (split resolved ":")))
          (let
            ((prop (first parts))
-              (val (if (> (len parts) 1) (nth parts 1) nil)))
+              (val
                (if (> (len parts) 1) (nth parts 1) nil)))
            (cond
              ((and (not (= prop "display")) (not (= prop "opacity")) (not (= prop "visibility")) (not (= prop "hidden")) (not (= prop "class-hidden")) (not (= prop "class-invisible")) (not (= prop "class-opacity")) (not (= prop "details")) (not (= prop "dialog")) (dict-has? _hs-hide-strategies prop))
                (let
@@ -2452,10 +2408,14 @@
                            (if
                              (= depth 1)
                              j
-                              (find-close (+ j 1) (- depth 1)))
+                              (find-close
                                (+ j 1)
                                (- depth 1)))
                            (if
                              (= (nth raw j) "{")
-                              (find-close (+ j 1) (+ depth 1))
+                              (find-close
                                (+ j 1)
                                (+ depth 1))
                              (find-close (+ j 1) depth))))))
                    (let
                      ((close (find-close start 1)))
@@ -2566,7 +2526,10 @@
              (if
                (= (len lst) 0)
                -1
-                (if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
+                (if
                  (= (first lst) item)
                  i
                  (idx-loop (rest lst) (+ i 1))))))
          (idx-loop obj 0)))
      (true
        (let
@@ -2658,7 +2621,8 @@
                (cond
                  ((= end "hs-pick-end") n)
                  ((= end "hs-pick-start") 0)
-                  ((and (number? end) (< end 0)) (max 0 (+ n end)))
+                  ((and (number? end) (< end 0))
                    (max 0 (+ n end)))
                  (true end))))
            (cond
              ((string? col) (slice col s e))
@@ -2838,8 +2802,6 @@
  hs-sorted-by-desc
  (fn (col key-fn) (reverse (hs-sorted-by col key-fn))))
 ;; ── SourceInfo API ────────────────────────────────────────────────
 (define
  hs-dom-has-var?
  (fn
@@ -2859,6 +2821,8 @@
      ((store (host-get el "__hs_vars")))
      (if (nil? store) nil (host-get store name)))))
 ;; ── SourceInfo API ────────────────────────────────────────────────
 (define
  hs-dom-set-var-raw!
  (fn
@@ -2949,12 +2913,7 @@
 (define
  hs-null-error!
-  (fn
+  (fn (selector) (raise (str "'" selector "' is null"))))
    (selector)
    (let
      ((msg (str "'" selector "' is null")))
      (host-set! (host-global "window") "_hs_null_error" msg)
      (guard (_null-e (true nil)) (raise msg)))))
 (define
  hs-named-target
@@ -2974,7 +2933,9 @@
      ((results (hs-query-all selector)))
      (if
        (and
-          (or (nil? results) (and (list? results) (= (len results) 0)))
+          (or
            (nil? results)
            (and (list? results) (= (len results) 0)))
          (string? selector)
          (> (len selector) 0)
          (= (substring selector 0 1) "#"))
--- a/lib/hyperscript/tokenizer.sx
+++ b/lib/hyperscript/tokenizer.sx
@@ -856,229 +856,3 @@
      (scan-template!)
      (t-emit! "eof" nil)
      tokens)))
 ;; ── Stream wrapper for upstream-style stateful tokenizer API ───────────────
 ;;
 ;; Upstream _hyperscript exposes a Tokens object with cursor + follow-set
 ;; semantics on _hyperscript.internals.tokenizer. Our hs-tokenize returns a
 ;; flat list; the stream wrapper adds the stateful operations.
 ;;
 ;; Type names map ours → upstream's (e.g. "ident" → "IDENTIFIER").
 (define
  hs-stream-type-map
  (fn
    (t)
    (cond
      ((= t "ident") "IDENTIFIER")
      ((= t "number") "NUMBER")
      ((= t "string") "STRING")
      ((= t "class") "CLASS_REF")
      ((= t "id") "ID_REF")
      ((= t "attr") "ATTRIBUTE_REF")
      ((= t "style") "STYLE_REF")
      ((= t "whitespace") "WHITESPACE")
      ((= t "op") "OPERATOR")
      ((= t "eof") "EOF")
      (true (upcase t)))))
 ;; Create a stream from a source string.
 ;; Returns a dict — mutable via dict-set!.
 (define
  hs-stream
  (fn
    (src)
    {:tokens (hs-tokenize src) :pos 0 :follows (list) :last-match nil :last-ws nil}))
 ;; Skip whitespace tokens, advancing pos to the next non-WS token.
 ;; Captures the last skipped whitespace value into :last-ws.
 (define
  hs-stream-skip-ws!
  (fn
    (s)
    (let
      ((tokens (get s :tokens)))
      (define
        loop
        (fn
          ()
          (let
            ((p (get s :pos)))
            (when
              (and (< p (len tokens))
                   (= (get (nth tokens p) :type) "whitespace"))
              (do
                (dict-set! s :last-ws (get (nth tokens p) :value))
                (dict-set! s :pos (+ p 1))
                (loop))))))
      (loop))))
 ;; Current token (after skipping whitespace).
 (define
  hs-stream-current
  (fn
    (s)
    (do
      (hs-stream-skip-ws! s)
      (let
        ((tokens (get s :tokens)) (p (get s :pos)))
        (if (< p (len tokens)) (nth tokens p) nil)))))
 ;; Returns the current token if its value matches; advances and updates
 ;; :last-match. Returns nil otherwise (no advance).
 ;; Honors the follow set: tokens whose value is in :follows do NOT match.
 (define
  hs-stream-match
  (fn
    (s value)
    (let
      ((cur (hs-stream-current s)))
      (cond
        ((nil? cur) nil)
        ((some (fn (f) (= f value)) (get s :follows)) nil)
        ((= (get cur :value) value)
          (do
            (dict-set! s :pos (+ (get s :pos) 1))
            (dict-set! s :last-match cur)
            cur))
        (true nil)))))
 ;; Match by upstream-style type name. Accepts any number of allowed types.
 (define
  hs-stream-match-type
  (fn
    (s &rest types)
    (let
      ((cur (hs-stream-current s)))
      (cond
        ((nil? cur) nil)
        ((some (fn (t) (= (hs-stream-type-map (get cur :type)) t)) types)
          (do
            (dict-set! s :pos (+ (get s :pos) 1))
            (dict-set! s :last-match cur)
            cur))
        (true nil)))))
 ;; Match if value is one of the given names.
 (define
  hs-stream-match-any
  (fn
    (s &rest names)
    (let
      ((cur (hs-stream-current s)))
      (cond
        ((nil? cur) nil)
        ((some (fn (n) (= (get cur :value) n)) names)
          (do
            (dict-set! s :pos (+ (get s :pos) 1))
            (dict-set! s :last-match cur)
            cur))
        (true nil)))))
 ;; Match an op token whose value is in the list.
 (define
  hs-stream-match-any-op
  (fn
    (s &rest ops)
    (let
      ((cur (hs-stream-current s)))
      (cond
        ((nil? cur) nil)
        ((and (= (get cur :type) "op")
              (some (fn (o) (= (get cur :value) o)) ops))
          (do
            (dict-set! s :pos (+ (get s :pos) 1))
            (dict-set! s :last-match cur)
            cur))
        (true nil)))))
 ;; Peek N non-WS tokens ahead. Returns the token if its value matches; nil otherwise.
 (define
  hs-stream-peek
  (fn
    (s value offset)
    (let
      ((tokens (get s :tokens)))
      (define
        skip-n-non-ws
        (fn
          (p remaining)
          (cond
            ((>= p (len tokens)) -1)
            ((= (get (nth tokens p) :type) "whitespace")
              (skip-n-non-ws (+ p 1) remaining))
            ((= remaining 0) p)
            (true (skip-n-non-ws (+ p 1) (- remaining 1))))))
      (let
        ((p (skip-n-non-ws (get s :pos) offset)))
        (if (and (>= p 0) (< p (len tokens))
                 (= (get (nth tokens p) :value) value))
          (nth tokens p)
          nil)))))
 ;; Consume tokens until one whose value matches the marker. Returns
 ;; the consumed list (excluding the marker). Marker becomes current.
 (define
  hs-stream-consume-until
  (fn
    (s marker)
    (let
      ((tokens (get s :tokens)) (out (list)))
      (define
        loop
        (fn
          (acc)
          (let
            ((p (get s :pos)))
            (cond
              ((>= p (len tokens)) acc)
              ((= (get (nth tokens p) :value) marker) acc)
              (true
                (do
                  (dict-set! s :pos (+ p 1))
                  (loop (append acc (list (nth tokens p))))))))))
      (loop out))))
 ;; Consume until the next whitespace token; returns the consumed list.
 (define
  hs-stream-consume-until-ws
  (fn
    (s)
    (let
      ((tokens (get s :tokens)))
      (define
        loop
        (fn
          (acc)
          (let
            ((p (get s :pos)))
            (cond
              ((>= p (len tokens)) acc)
              ((= (get (nth tokens p) :type) "whitespace") acc)
              (true
                (do
                  (dict-set! s :pos (+ p 1))
                  (loop (append acc (list (nth tokens p))))))))))
      (loop (list)))))
 ;; Follow-set management.
 (define hs-stream-push-follow! (fn (s v) (dict-set! s :follows (cons v (get s :follows)))))
 (define
  hs-stream-pop-follow!
  (fn (s) (let ((f (get s :follows))) (when (> (len f) 0) (dict-set! s :follows (rest f))))))
 (define
  hs-stream-push-follows!
  (fn (s vs) (for-each (fn (v) (hs-stream-push-follow! s v)) vs)))
 (define
  hs-stream-pop-follows!
  (fn (s n) (when (> n 0) (do (hs-stream-pop-follow! s) (hs-stream-pop-follows! s (- n 1))))))
 (define
  hs-stream-clear-follows!
  (fn (s) (let ((saved (get s :follows))) (do (dict-set! s :follows (list)) saved))))
 (define
  hs-stream-restore-follows!
  (fn (s saved) (dict-set! s :follows saved)))
 ;; Last-consumed token / whitespace.
 (define hs-stream-last-match (fn (s) (get s :last-match)))
 (define hs-stream-last-ws (fn (s) (get s :last-ws)))
--- a/lib/kernel/eval.sx
+++ b/lib/kernel/eval.sx
@@ -1,214 +0,0 @@
 ;; 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
 ;; -------------
 ;;   {:refl-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. Shape
 ;;     and operations are inherited from lib/guest/reflective/env.sx
 ;;     (canonical wire shape) — Kernel-side names are thin wrappers.
 ;;
 ;;   {: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 — delegated to lib/guest/reflective/env.sx ──────
 ;; The env values themselves now carry `:refl-tag :env` (shared with the
 ;; reflective kit). Kernel's API names stay; bodies are thin wrappers.
 (define kernel-env?        refl-env?)
 (define kernel-make-env    refl-make-env)
 (define kernel-extend-env  refl-extend-env)
 (define kernel-env-bind!   refl-env-bind!)
 (define kernel-env-has?    refl-env-has?)
 (define kernel-env-lookup  refl-env-lookup)
 ;; ── 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))))))
--- a/lib/kernel/parser.sx
+++ b/lib/kernel/parser.sx
@@ -1,253 +0,0 @@
 ;; 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")))))))))
--- a/lib/kernel/runtime.sx
+++ b/lib/kernel/runtime.sx
@@ -1,911 +0,0 @@
 ;; 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)))
--- a/lib/kernel/tests/encap.sx
+++ b/lib/kernel/tests/encap.sx
@@ -1,171 +0,0 @@
 ;; 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-suite (refl-make-test-suite))
 (define ken-test  (fn (n a e) (refl-test ken-suite n a e)))
 (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 () (refl-test-report ken-suite)))
--- a/lib/kernel/tests/eval.sx
+++ b/lib/kernel/tests/eval.sx
@@ -1,258 +0,0 @@
 ;; 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-suite (refl-make-test-suite))
 (define ke-test  (fn (n a e) (refl-test ke-suite n a e)))
 ;; ── 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 () (refl-test-report ke-suite)))
--- a/lib/kernel/tests/hygiene.sx
+++ b/lib/kernel/tests/hygiene.sx
@@ -1,208 +0,0 @@
 ;; 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-suite (refl-make-test-suite))
 (define kh-test  (fn (n a e) (refl-test kh-suite n a e)))
 (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 () (refl-test-report kh-suite)))
--- a/lib/kernel/tests/metacircular.sx
+++ b/lib/kernel/tests/metacircular.sx
@@ -1,150 +0,0 @@
 ;; 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-suite (refl-make-test-suite))
 (define kmc-test  (fn (n a e) (refl-test kmc-suite n a e)))
 ;; 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 () (refl-test-report kmc-suite)))
--- a/lib/kernel/tests/parse.sx
+++ b/lib/kernel/tests/parse.sx
@@ -1,146 +0,0 @@
 ;; lib/kernel/tests/parse.sx — exercises lib/kernel/parser.sx.
 (define knl-suite (refl-make-test-suite))
 (define knl-test  (fn (n a e) (refl-test knl-suite n a e)))
 ;; ── 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 () (refl-test-report knl-suite)))
--- a/lib/kernel/tests/standard.sx
+++ b/lib/kernel/tests/standard.sx
@@ -1,433 +0,0 @@
 ;; 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-suite (refl-make-test-suite))
 (define ks-test  (fn (n a e) (refl-test ks-suite n a e)))
 (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 () (refl-test-report ks-suite)))
--- a/lib/kernel/tests/vau.sx
+++ b/lib/kernel/tests/vau.sx
@@ -1,297 +0,0 @@
 ;; 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-suite (refl-make-test-suite))
 (define kv-test  (fn (n a e) (refl-test kv-suite n a e)))
 (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 () (refl-test-report kv-suite)))
--- a/lib/minikanren/clpfd.sx
+++ b/lib/minikanren/clpfd.sx
@@ -1,590 +0,0 @@
 ;; lib/minikanren/clpfd.sx — Phase 6: native CLP(FD) on miniKanren.
 ;;
 ;; The substitution dict carries an extra reserved key "_fd" that holds a
 ;; constraint-store record:
 ;;
 ;;   {:domains    {var-name -> sorted-int-list}
 ;;    :constraints (... pending constraint closures ...)}
 ;;
 ;; Domains are sorted SX lists of ints (no duplicates).
 ;; Constraints are functions s -> s-or-nil that propagate / re-check.
 ;; They are re-fired after every label binding via fd-fire-store.
 (define fd-key "_fd")
 ;; --- domain primitives ---
 (define
  fd-dom-rev
  (fn
    (xs acc)
    (cond
      ((empty? xs) acc)
      (:else (fd-dom-rev (rest xs) (cons (first xs) acc))))))
 (define
  fd-dom-insert
  (fn
    (x desc)
    (cond
      ((empty? desc) (list x))
      ((= x (first desc)) desc)
      ((> x (first desc)) (cons x desc))
      (:else (cons (first desc) (fd-dom-insert x (rest desc)))))))
 (define
  fd-dom-sort-dedupe
  (fn
    (xs acc)
    (cond
      ((empty? xs) (fd-dom-rev acc (list)))
      (:else (fd-dom-sort-dedupe (rest xs) (fd-dom-insert (first xs) acc))))))
 (define fd-dom-from-list (fn (xs) (fd-dom-sort-dedupe xs (list))))
 (define fd-dom-empty? (fn (d) (empty? d)))
 (define
  fd-dom-singleton?
  (fn (d) (and (not (empty? d)) (empty? (rest d)))))
 (define fd-dom-min (fn (d) (first d)))
 (define
  fd-dom-last
  (fn
    (d)
    (cond ((empty? (rest d)) (first d)) (:else (fd-dom-last (rest d))))))
 (define fd-dom-max (fn (d) (fd-dom-last d)))
 (define fd-dom-member? (fn (x d) (some (fn (y) (= x y)) d)))
 (define
  fd-dom-intersect
  (fn
    (a b)
    (cond
      ((empty? a) (list))
      ((empty? b) (list))
      ((= (first a) (first b))
        (cons (first a) (fd-dom-intersect (rest a) (rest b))))
      ((< (first a) (first b)) (fd-dom-intersect (rest a) b))
      (:else (fd-dom-intersect a (rest b))))))
 (define
  fd-dom-without
  (fn
    (x d)
    (cond
      ((empty? d) (list))
      ((= (first d) x) (rest d))
      ((> (first d) x) d)
      (:else (cons (first d) (fd-dom-without x (rest d)))))))
 (define
  fd-dom-range
  (fn
    (lo hi)
    (cond
      ((> lo hi) (list))
      (:else (cons lo (fd-dom-range (+ lo 1) hi))))))
 ;; --- constraint store accessors ---
 (define fd-store-empty (fn () {:domains {} :constraints (list)}))
 (define
  fd-store-of
  (fn
    (s)
    (cond ((has-key? s fd-key) (get s fd-key)) (:else (fd-store-empty)))))
 (define fd-domains-of (fn (s) (get (fd-store-of s) :domains)))
 (define fd-with-store (fn (s store) (assoc s fd-key store)))
 (define
  fd-domain-of
  (fn
    (s var-name)
    (let
      ((doms (fd-domains-of s)))
      (cond ((has-key? doms var-name) (get doms var-name)) (:else nil)))))
 (define
  fd-set-domain
  (fn
    (s var-name d)
    (cond
      ((fd-dom-empty? d) nil)
      (:else
        (let
          ((store (fd-store-of s)))
          (let
            ((doms-prime (assoc (get store :domains) var-name d)))
            (let
              ((store-prime (assoc store :domains doms-prime)))
              (fd-with-store s store-prime))))))))
 (define
  fd-add-constraint
  (fn
    (s c)
    (let
      ((store (fd-store-of s)))
      (let
        ((cs-prime (cons c (get store :constraints))))
        (let
          ((store-prime (assoc store :constraints cs-prime)))
          (fd-with-store s store-prime))))))
 (define
  fd-fire-list
  (fn
    (cs s)
    (cond
      ((empty? cs) s)
      (:else
        (let
          ((s2 ((first cs) s)))
          (cond ((= s2 nil) nil) (:else (fd-fire-list (rest cs) s2))))))))
 (define
  fd-store-signature
  (fn
    (s)
    (let
      ((doms (fd-domains-of s)))
      (let
        ((dom-sizes (reduce (fn (acc k) (+ acc (len (get doms k)))) 0 (keys doms))))
        (+ dom-sizes (len (keys s)))))))
 (define
  fd-fire-store
  (fn
    (s)
    (let
      ((s2 (fd-fire-list (get (fd-store-of s) :constraints) s)))
      (cond
        ((= s2 nil) nil)
        ((= (fd-store-signature s) (fd-store-signature s2)) s2)
        (:else (fd-fire-store s2))))))
 ;; --- user-facing goals ---
 (define
  fd-in
  (fn
    (x dom-list)
    (fn
      (s)
      (let
        ((new-dom (fd-dom-from-list dom-list)))
        (let
          ((wx (mk-walk x s)))
          (cond
            ((number? wx)
              (cond ((fd-dom-member? wx new-dom) (unit s)) (:else mzero)))
            ((is-var? wx)
              (let
                ((existing (fd-domain-of s (var-name wx))))
                (let
                  ((narrowed (cond ((= existing nil) new-dom) (:else (fd-dom-intersect existing new-dom)))))
                  (let
                    ((s2 (fd-set-domain s (var-name wx) narrowed)))
                    (cond ((= s2 nil) mzero) (:else (unit s2)))))))
            (:else mzero)))))))
 ;; --- fd-neq ---
 (define
  fd-neq-prop
  (fn
    (x y s)
    (let
      ((wx (mk-walk x s)) (wy (mk-walk y s)))
      (cond
        ((and (number? wx) (number? wy))
          (cond ((= wx wy) nil) (:else s)))
        ((and (number? wx) (is-var? wy))
          (let
            ((y-dom (fd-domain-of s (var-name wy))))
            (cond
              ((= y-dom nil) s)
              (:else
                (fd-set-domain s (var-name wy) (fd-dom-without wx y-dom))))))
        ((and (number? wy) (is-var? wx))
          (let
            ((x-dom (fd-domain-of s (var-name wx))))
            (cond
              ((= x-dom nil) s)
              (:else
                (fd-set-domain s (var-name wx) (fd-dom-without wy x-dom))))))
        (:else s)))))
 (define
  fd-neq
  (fn
    (x y)
    (fn
      (s)
      (let
        ((c (fn (s-prime) (fd-neq-prop x y s-prime))))
        (let
          ((s2 (fd-add-constraint s c)))
          (let
            ((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)))))))))
--- a/lib/minikanren/conda.sx
+++ b/lib/minikanren/conda.sx
@@ -1,42 +0,0 @@
 ;; lib/minikanren/conda.sx — Phase 5 piece A: `conda`, the soft-cut.
 ;;
 ;;   (conda (g0 g ...) (h0 h ...) ...)
 ;;     — first clause whose head g0 produces ANY answer wins; ALL of g0's
 ;;       answers are then conj'd with the rest of that clause; later
 ;;       clauses are NOT tried.
 ;;     — differs from condu only in not wrapping g0 in onceo: condu
 ;;       commits to the SINGLE first answer, conda lets the head's full
 ;;       answer-set flow into the rest of the clause.
 ;;       (Reasoned Schemer chapter 10; Byrd 5.3.)
 (define
  conda-try
  (fn
    (clauses s)
    (cond
      ((empty? clauses) mzero)
      (:else
        (let
          ((cl (first clauses)))
          (let
            ((head-goal (first cl)) (rest-goals (rest cl)))
            (let
              ((peek (stream-take 1 (head-goal s))))
              (if
                (empty? peek)
                (conda-try (rest clauses) s)
                (mk-bind (head-goal s) (mk-conj-list rest-goals))))))))))
 (defmacro
  conda
  (&rest clauses)
  (quasiquote
    (fn
      (s)
      (conda-try
        (list
          (splice-unquote
            (map
              (fn (cl) (quasiquote (list (splice-unquote cl))))
              clauses)))
        s))))
--- a/lib/minikanren/conde.sx
+++ b/lib/minikanren/conde.sx
@@ -1,39 +0,0 @@
 ;; lib/minikanren/conde.sx — Phase 2 piece C: `conde`, the canonical
 ;; miniKanren and-or form, with implicit Zzz inverse-eta delay so recursive
 ;; relations like appendo terminate.
 ;;
 ;;   (conde (g1a g1b ...) (g2a g2b ...) ...)
 ;;     ≡ (mk-disj (Zzz (mk-conj g1a g1b ...))
 ;;                (Zzz (mk-conj g2a g2b ...)) ...)
 ;;
 ;; `Zzz g` wraps a goal expression in (fn (S) (fn () (g S))) so that
 ;; `g`'s body isn't constructed until the surrounding fn is applied to a
 ;; substitution AND the returned thunk is forced. This is what gives
 ;; miniKanren its laziness — recursive goal definitions can be `(conde
 ;; ... (... (recur ...)))` without infinite descent at construction time.
 ;;
 ;; Hygiene: the substitution parameter is gensym'd so that user goal
 ;; expressions which themselves bind `s` (e.g. `(appendo l s ls)`) keep
 ;; their lexical `s` and don't accidentally reference the wrapper's
 ;; substitution. Without gensym, miniKanren relations that follow the
 ;; common (l s ls) parameter convention are silently miscompiled.
 (defmacro
  Zzz
  (g)
  (let
    ((s-sym (gensym "zzz-s-")))
    (quasiquote
      (fn ((unquote s-sym)) (fn () ((unquote g) (unquote s-sym)))))))
 (defmacro
  conde
  (&rest clauses)
  (quasiquote
    (mk-disj
      (splice-unquote
        (map
          (fn
            (clause)
            (quasiquote (Zzz (mk-conj (splice-unquote clause)))))
          clauses)))))
--- a/lib/minikanren/condu.sx
+++ b/lib/minikanren/condu.sx
@@ -1,58 +0,0 @@
 ;; lib/minikanren/condu.sx — Phase 2 piece D: `condu` and `onceo`.
 ;;
 ;; Both are commitment forms (no backtracking into discarded options):
 ;;
 ;;   (onceo g)        — succeeds at most once: takes the first answer
 ;;                      stream-take produces from (g s).
 ;;
 ;;   (condu (g0 g ...) (h0 h ...) ...)
 ;;                    — first clause whose head goal succeeds wins; only
 ;;                      the first answer of the head is propagated to the
 ;;                      rest of that clause; later clauses are not tried.
 ;;                      (Reasoned Schemer chapter 10; Byrd 5.4.)
 (define
  onceo
  (fn
    (g)
    (fn
      (s)
      (let
        ((peek (stream-take 1 (g s))))
        (if (empty? peek) mzero (unit (first peek)))))))
 ;; condu-try — runtime walker over a list of clauses (each clause a list of
 ;; goals). Forces the head with stream-take 1; if head fails, recurse to
 ;; the next clause; if head succeeds, commits its single answer through
 ;; the rest of the clause.
 (define
  condu-try
  (fn
    (clauses s)
    (cond
      ((empty? clauses) mzero)
      (:else
        (let
          ((cl (first clauses)))
          (let
            ((head-goal (first cl)) (rest-goals (rest cl)))
            (let
              ((peek (stream-take 1 (head-goal s))))
              (if
                (empty? peek)
                (condu-try (rest clauses) s)
                ((mk-conj-list rest-goals) (first peek))))))))))
 (defmacro
  condu
  (&rest clauses)
  (quasiquote
    (fn
      (s)
      (condu-try
        (list
          (splice-unquote
            (map
              (fn (cl) (quasiquote (list (splice-unquote cl))))
              clauses)))
        s))))
--- a/lib/minikanren/defrel.sx
+++ b/lib/minikanren/defrel.sx
@@ -1,25 +0,0 @@
 ;; lib/minikanren/defrel.sx — Prolog-style defrel macro.
 ;;
 ;;   (defrel (NAME ARG1 ARG2 ...)
 ;;     (CLAUSE1 ...)
 ;;     (CLAUSE2 ...)
 ;;     ...)
 ;;
 ;; expands to
 ;;
 ;;   (define NAME (fn (ARG1 ARG2 ...) (conde (CLAUSE1 ...) (CLAUSE2 ...))))
 ;;
 ;; This puts each clause's goals immediately after the head, mirroring
 ;; Prolog's `name(Args) :- goals.` shape. Clauses are conde-conjoined
 ;; goals — `Zzz`-wrapping is automatic via `conde`, so recursive
 ;; relations terminate on partial answers.
 (defmacro
  defrel
  (head &rest clauses)
  (let
    ((name (first head)) (args (rest head)))
    (list
      (quote define)
      name
      (list (quote fn) args (cons (quote conde) clauses)))))
--- a/lib/minikanren/fd.sx
+++ b/lib/minikanren/fd.sx
@@ -1,25 +0,0 @@
 ;; lib/minikanren/fd.sx — Phase 6 piece A: minimal finite-domain helpers.
 ;;
 ;; A full CLP(FD) engine (arc consistency, native integer domains, fd-plus
 ;; etc.) is Phase 6 proper. For now we expose two small relations layered
 ;; on the existing list machinery — they're sufficient for permutation
 ;; puzzles, the N-queens-style core of constraint solving:
 ;;
 ;;   (ino x dom)         — x is a member of dom (alias for membero with the
 ;;                         constraint-store-friendly argument order).
 ;;   (all-distincto l)   — all elements of l are pairwise distinct.
 ;;
 ;; all-distincto uses nafc + membero on the tail — it requires the head
 ;; element of each recursive step to be ground enough for membero to be
 ;; finitary, so order matters: prefer (in x dom) goals BEFORE
 ;; (all-distincto (list x ...)) so values get committed first.
 (define ino (fn (x dom) (membero x dom)))
 (define
  all-distincto
  (fn
    (l)
    (conde
      ((nullo l))
      ((fresh (a d) (conso a d l) (nafc (membero a d)) (all-distincto d))))))
--- a/lib/minikanren/fresh.sx
+++ b/lib/minikanren/fresh.sx
@@ -1,23 +0,0 @@
 ;; lib/minikanren/fresh.sx — Phase 2 piece B: `fresh` for introducing
 ;; logic variables inside a goal body.
 ;;
 ;;   (fresh (x y z) goal1 goal2 ...)
 ;;     ≡ (let ((x (make-var)) (y (make-var)) (z (make-var)))
 ;;         (mk-conj goal1 goal2 ...))
 ;;
 ;; A macro rather than a function so user-named vars are real lexical
 ;; bindings — which is also what miniKanren convention expects.
 ;; The empty-vars form (fresh () goal ...) is just a goal grouping.
 (defmacro
  fresh
  (vars &rest goals)
  (quasiquote
    (let
      (unquote (map (fn (v) (list v (list (quote make-var)))) vars))
      (mk-conj (splice-unquote goals)))))
 ;; call-fresh — functional alternative for code that builds goals
 ;; programmatically:
 ;;   ((call-fresh (fn (x) (== x 7))) empty-s) → ({:_.N 7})
 (define call-fresh (fn (f) (fn (s) ((f (make-var)) s))))
--- a/lib/minikanren/goals.sx
+++ b/lib/minikanren/goals.sx
@@ -1,58 +0,0 @@
 ;; lib/minikanren/goals.sx — Phase 2 piece B: core goals.
 ;;
 ;; A goal is a function (fn (s) → stream-of-substitutions).
 ;; Goals built here:
 ;;   succeed         — always returns (unit s)
 ;;   fail            — always returns mzero
 ;;   ==              — unifies two terms; succeeds with a singleton, else fails
 ;;   ==-check        — opt-in occurs-checked equality
 ;;   conj2 / mk-conj — sequential conjunction of goals
 ;;   disj2 / mk-disj — interleaved disjunction of goals (raw — `conde` adds
 ;;                     the implicit-conj-per-clause sugar in a later commit)
 (define succeed (fn (s) (unit s)))
 (define fail (fn (s) mzero))
 (define
  ==
  (fn
    (u v)
    (fn
      (s)
      (let ((s2 (mk-unify u v s))) (if (= s2 nil) mzero (unit s2))))))
 (define
  ==-check
  (fn
    (u v)
    (fn
      (s)
      (let ((s2 (mk-unify-check u v s))) (if (= s2 nil) mzero (unit s2))))))
 (define conj2 (fn (g1 g2) (fn (s) (mk-bind (g1 s) g2))))
 (define disj2 (fn (g1 g2) (fn (s) (mk-mplus (g1 s) (g2 s)))))
 ;; Fold goals in a list. (mk-conj-list ()) ≡ succeed; (mk-disj-list ()) ≡ fail.
 (define
  mk-conj-list
  (fn
    (gs)
    (cond
      ((empty? gs) succeed)
      ((empty? (rest gs)) (first gs))
      (:else (conj2 (first gs) (mk-conj-list (rest gs)))))))
 (define
  mk-disj-list
  (fn
    (gs)
    (cond
      ((empty? gs) fail)
      ((empty? (rest gs)) (first gs))
      (:else (disj2 (first gs) (mk-disj-list (rest gs)))))))
 (define mk-conj (fn (&rest gs) (mk-conj-list gs)))
 (define mk-disj (fn (&rest gs) (mk-disj-list gs)))
--- a/lib/minikanren/intarith.sx
+++ b/lib/minikanren/intarith.sx
@@ -1,151 +0,0 @@
 ;; lib/minikanren/intarith.sx — fast integer arithmetic via project.
 ;;
 ;; These are ground-only escapes into host arithmetic. They run at native
 ;; speed (host ints) but require their arguments to walk to actual numbers
 ;; — they are not relational the way `pluso` (Peano) is. Use them when
 ;; the puzzle size makes Peano impractical.
 ;;
 ;; Naming: `-i` suffix marks "integer-only" goals.
 (define
  pluso-i
  (fn
    (a b c)
    (project
      (a b)
      (if (and (number? a) (number? b)) (== c (+ a b)) fail))))
 (define
  minuso-i
  (fn
    (a b c)
    (project
      (a b)
      (if (and (number? a) (number? b)) (== c (- a b)) fail))))
 (define
  *o-i
  (fn
    (a b c)
    (project
      (a b)
      (if (and (number? a) (number? b)) (== c (* a b)) fail))))
 (define
  lto-i
  (fn
    (a b)
    (project
      (a b)
      (if (and (number? a) (and (number? b) (< a b))) succeed fail))))
 (define
  lteo-i
  (fn
    (a b)
    (project
      (a b)
      (if (and (number? a) (and (number? b) (<= a b))) succeed fail))))
 (define
  neqo-i
  (fn
    (a b)
    (project
      (a b)
      (if (and (number? a) (and (number? b) (not (= a b)))) succeed fail))))
 (define numbero (fn (x) (project (x) (if (number? x) succeed fail))))
 (define stringo (fn (x) (project (x) (if (string? x) succeed fail))))
 (define symbolo (fn (x) (project (x) (if (symbol? x) succeed fail))))
 (define
  even-i
  (fn (n) (project (n) (if (and (number? n) (even? n)) succeed fail))))
 (define
  odd-i
  (fn (n) (project (n) (if (and (number? n) (odd? n)) succeed fail))))
 (define
  sortedo
  (fn
    (l)
    (conde
      ((nullo l))
      ((fresh (a) (== l (list a))))
      ((fresh (a b rest mid) (conso a mid l) (conso b rest mid) (lteo-i a b) (sortedo mid))))))
 (define
  mino
  (fn
    (l m)
    (conde
      ((fresh (a) (== l (list a)) (== m a)))
      ((fresh (a d rest-min) (conso a d l) (mino d rest-min) (conde ((lteo-i a rest-min) (== m a)) ((lto-i rest-min a) (== m rest-min))))))))
 (define
  maxo
  (fn
    (l m)
    (conde
      ((fresh (a) (== l (list a)) (== m a)))
      ((fresh (a d rest-max) (conso a d l) (maxo d rest-max) (conde ((lteo-i rest-max a) (== m a)) ((lto-i a rest-max) (== m rest-max))))))))
 (define
  sumo
  (fn
    (l total)
    (conde
      ((nullo l) (== total 0))
      ((fresh (a d rest-sum) (conso a d l) (sumo d rest-sum) (pluso-i a rest-sum total))))))
 (define
  producto
  (fn
    (l total)
    (conde
      ((nullo l) (== total 1))
      ((fresh (a d rest-prod) (conso a d l) (producto d rest-prod) (*o-i a rest-prod total))))))
 (define
  lengtho-i
  (fn
    (l n)
    (conde
      ((nullo l) (== n 0))
      ((fresh (a d n-1) (conso a d l) (lengtho-i d n-1) (pluso-i 1 n-1 n))))))
 (define
  enumerate-from-i
  (fn
    (start l result)
    (conde
      ((nullo l) (nullo result))
      ((fresh (a d r-rest start-prime) (conso a d l) (conso (list start a) r-rest result) (pluso-i 1 start start-prime) (enumerate-from-i start-prime d r-rest))))))
 (define enumerate-i (fn (l result) (enumerate-from-i 0 l result)))
 (define
  counto
  (fn
    (x l n)
    (conde
      ((nullo l) (== n 0))
      ((fresh (a d n-rest) (conso a d l) (conde ((== a x) (counto x d n-rest) (pluso-i 1 n-rest n)) ((nafc (== a x)) (counto x d n))))))))
 (define
  mk-arith-prog
  (fn
    (start step len)
    (cond
      ((= len 0) (list))
      (:else (cons start (mk-arith-prog (+ start step) step (- len 1)))))))
 (define
  arith-progo
  (fn
    (start step len result)
    (project (start step len) (== result (mk-arith-prog start step len)))))
--- a/lib/minikanren/matche.sx
+++ b/lib/minikanren/matche.sx
@@ -1,76 +0,0 @@
 ;; lib/minikanren/matche.sx — Phase 5 piece D: pattern matching over terms.
 ;;
 ;;   (matche TARGET
 ;;     (PATTERN1 g1 g2 ...)
 ;;     (PATTERN2 g1 ...)
 ;;     ...)
 ;;
 ;; Pattern grammar:
 ;;   _                 wildcard — fresh anonymous var
 ;;   x                 plain symbol — fresh var, bind by name
 ;;   ATOM              literal (number, string, boolean) — must equal
 ;;   :keyword          keyword literal — emitted bare (keywords self-evaluate
 ;;                     to their string name in SX, so quoting them changes
 ;;                     their type from string to keyword)
 ;;   ()                empty list — must equal
 ;;   (p1 p2 ... pn)    list pattern — recurse on each element
 ;;
 ;; The macro expands to a `conde` whose clauses are
 ;;   `((fresh (vars-in-pat) (== target pat-expr) body...))`.
 ;;
 ;; Repeated symbol names within a pattern produce the same fresh var, so
 ;; they unify by `==`. Fixed-length list patterns only — head/tail
 ;; destructuring uses `(fresh (a d) (conso a d target) body)` directly.
 ;;
 ;; Note: the macro builds the expansion via `cons` / `list` rather than a
 ;; quasiquote — quasiquote does not recurse into nested lambda bodies in
 ;; SX, so `\`(matche-clause (quote ,target) cl)` left literal
 ;; `(unquote target)` in the output.
 (define matche-symbol-var? (fn (s) (symbol? s)))
 (define
  matche-collect-vars-acc
  (fn
    (pat acc)
    (cond
      ((matche-symbol-var? pat)
        (if (some (fn (s) (= s pat)) acc) acc (append acc (list pat))))
      ((and (list? pat) (not (empty? pat)))
        (reduce (fn (a p) (matche-collect-vars-acc p a)) acc pat))
      (:else acc))))
 (define
  matche-collect-vars
  (fn (pat) (matche-collect-vars-acc pat (list))))
 (define
  matche-pattern->expr
  (fn
    (pat)
    (cond
      ((matche-symbol-var? pat) pat)
      ((and (list? pat) (empty? pat)) (list (quote list)))
      ((list? pat) (cons (quote list) (map matche-pattern->expr pat)))
      ((keyword? pat) pat)
      (:else (list (quote quote) pat)))))
 (define
  matche-clause
  (fn
    (target cl)
    (let
      ((pat (first cl)) (body (rest cl)))
      (let
        ((vars (matche-collect-vars pat)))
        (let
          ((pat-expr (matche-pattern->expr pat)))
          (list
            (cons
              (quote fresh)
              (cons vars (cons (list (quote ==) target pat-expr) body)))))))))
 (defmacro
  matche
  (target &rest clauses)
  (cons (quote conde) (map (fn (cl) (matche-clause target cl)) clauses)))
--- a/lib/minikanren/nafc.sx
+++ b/lib/minikanren/nafc.sx
@@ -1,24 +0,0 @@
 ;; lib/minikanren/nafc.sx — Phase 5 piece C: negation as finite failure.
 ;;
 ;;   (nafc g)
 ;;     succeeds (yields the input substitution) if g has zero answers
 ;;     against that substitution; fails (mzero) if g has at least one.
 ;;
 ;; Caveat: `nafc` is unsound under the open-world assumption. It only
 ;; makes sense for goals over fully-ground terms, or with the explicit
 ;; understanding that adding more facts could flip the answer. Use
 ;; `(project (...) ...)` to ensure the relevant vars are ground first.
 ;;
 ;; Caveat 2: stream-take forces g for at least one answer; if g is
 ;; infinitely-ground (say, a divergent search over an unbound list),
 ;; nafc itself will diverge. Standard miniKanren limitation.
 (define
  nafc
  (fn
    (g)
    (fn
      (s)
      (let
        ((peek (stream-take 1 (g s))))
        (if (empty? peek) (unit s) mzero)))))
--- a/lib/minikanren/peano.sx
+++ b/lib/minikanren/peano.sx
@@ -1,51 +0,0 @@
 ;; lib/minikanren/peano.sx — Peano-encoded natural-number relations.
 ;;
 ;; Same encoding as `lengtho`: zero is the keyword `:z`; successors are
 ;; `(:s n)`. So 3 = `(:s (:s (:s :z)))`. `(:z)` and `(:s ...)` are normal
 ;; SX values that unify positionally — no special primitives needed.
 ;;
 ;; Peano arithmetic is the canonical miniKanren way to test addition /
 ;; multiplication / less-than relationally without an FD constraint store.
 ;; (CLP(FD) integers come in Phase 6.)
 (define zeroo (fn (n) (== n :z)))
 (define succ-of (fn (n m) (== m (list :s n))))
 (define
  pluso
  (fn
    (a b c)
    (conde
      ((== a :z) (== b c))
      ((fresh (a-1 c-1) (== a (list :s a-1)) (== c (list :s c-1)) (pluso a-1 b c-1))))))
 (define minuso (fn (a b c) (pluso b c a)))
 (define lteo (fn (a b) (fresh (k) (pluso a k b))))
 (define lto (fn (a b) (fresh (sa) (succ-of a sa) (lteo sa b))))
 (define
  eveno
  (fn
    (n)
    (conde
      ((== n :z))
      ((fresh (m) (== n (list :s (list :s m))) (eveno m))))))
 (define
  oddo
  (fn
    (n)
    (conde
      ((== n (list :s :z)))
      ((fresh (m) (== n (list :s (list :s m))) (oddo m))))))
 (define
  *o
  (fn
    (a b c)
    (conde
      ((== a :z) (== c :z))
      ((fresh (a-1 ab-1) (== a (list :s a-1)) (*o a-1 b ab-1) (pluso b ab-1 c))))))
--- a/lib/minikanren/project.sx
+++ b/lib/minikanren/project.sx
@@ -1,25 +0,0 @@
 ;; lib/minikanren/project.sx — Phase 5 piece B: `project`.
 ;;
 ;;   (project (x y) g1 g2 ...)
 ;;     — rebinds each named var to (mk-walk* var s) within the body's
 ;;       lexical scope, then runs the conjunction of the body goals on
 ;;       the same substitution. Use to escape into regular SX (arithmetic,
 ;;       string ops, host predicates) when you need a ground value.
 ;;
 ;; If any of the projected vars is still unbound at this point, the body
 ;; sees the raw `(:var NAME)` term — that is intentional and lets you
 ;; mix project with `(== ground? var)` patterns or with conda guards.
 ;;
 ;; Hygiene: substitution parameter is gensym'd so it doesn't capture user
 ;; vars (`s` is a popular relation parameter name).
 (defmacro
  project
  (vars &rest goals)
  (let
    ((s-sym (gensym "proj-s-")))
    (quasiquote
      (fn
        ((unquote s-sym))
        ((let (unquote (map (fn (v) (list v (list (quote mk-walk*) v s-sym))) vars)) (mk-conj (splice-unquote goals)))
          (unquote s-sym))))))
--- a/lib/minikanren/queens.sx
+++ b/lib/minikanren/queens.sx
@@ -1,67 +0,0 @@
 ;; lib/minikanren/queens.sx — N-queens via ino + all-distincto + project.
 ;;
 ;; Encoding: q = (c1 c2 ... cn) where ci is the column of the queen in
 ;; row i. Each ci ∈ {1..n}; all distinct (no two queens share a column);
 ;; no two queens on the same diagonal (|ci - cj| ≠ |i - j| for i ≠ j).
 ;;
 ;; The diagonal check uses `project` to escape into host arithmetic
 ;; once both column values are ground.
 (define
  safe-diag
  (fn
    (a b dist)
    (project (a b) (if (= (abs (- a b)) dist) fail succeed))))
 (define
  safe-cell-vs-rest
  (fn
    (c c-row others next-row)
    (cond
      ((empty? others) succeed)
      (:else
        (mk-conj
          (safe-diag c (first others) (- next-row c-row))
          (safe-cell-vs-rest c c-row (rest others) (+ next-row 1)))))))
 (define
  all-cells-safe
  (fn
    (cols start-row)
    (cond
      ((empty? cols) succeed)
      (:else
        (mk-conj
          (safe-cell-vs-rest
            (first cols)
            start-row
            (rest cols)
            (+ start-row 1))
          (all-cells-safe (rest cols) (+ start-row 1)))))))
 (define
  range-1-to-n
  (fn
    (n)
    (cond
      ((= n 0) (list))
      (:else (append (range-1-to-n (- n 1)) (list n))))))
 (define
  ino-each
  (fn
    (cols dom)
    (cond
      ((empty? cols) succeed)
      (:else (mk-conj (ino (first cols) dom) (ino-each (rest cols) dom))))))
 (define
  queens-cols
  (fn
    (cols n)
    (let
      ((dom (range-1-to-n n)))
      (mk-conj
        (ino-each cols dom)
        (all-distincto cols)
        (all-cells-safe cols 1)))))
--- a/lib/minikanren/relations.sx
+++ b/lib/minikanren/relations.sx
@@ -1,361 +0,0 @@
 ;; lib/minikanren/relations.sx — Phase 4 standard relations.
 ;;
 ;; Programs use native SX lists as data. Relations decompose lists via the
 ;; tagged cons-cell shape `(:cons h t)` because SX has no improper pairs;
 ;; the unifier treats `(:cons h t)` and the native list `(h . t)` as
 ;; equivalent, and `mk-walk*` flattens cons cells back to flat lists for
 ;; reification.
 ;; --- pair / list shape relations ---
 (define nullo (fn (l) (== l (list))))
 (define pairo (fn (p) (fresh (a d) (== p (mk-cons a d)))))
 (define caro (fn (p a) (fresh (d) (== p (mk-cons a d)))))
 (define cdro (fn (p d) (fresh (a) (== p (mk-cons a d)))))
 (define conso (fn (a d p) (== p (mk-cons a d))))
 (define firsto caro)
 (define resto cdro)
 (define
  listo
  (fn (l) (conde ((nullo l)) ((fresh (a d) (conso a d l) (listo d))))))
 ;; --- appendo: the canary ---
 ;;
 ;; (appendo l s ls) — `ls` is the concatenation of `l` and `s`.
 ;; Runs forwards (l, s known → ls), backwards (ls known → all (l, s) pairs),
 ;; and bidirectionally (mix of bound + unbound).
 (define
  appendo
  (fn
    (l s ls)
    (conde
      ((nullo l) (== s ls))
      ((fresh (a d res) (conso a d l) (conso a res ls) (appendo d s res))))))
 ;; --- membero ---
 ;; (membero x l) — x appears (at least once) in l.
 (define
  appendo3
  (fn
    (l1 l2 l3 result)
    (fresh (l12) (appendo l1 l2 l12) (appendo l12 l3 result))))
 (define
  partitiono
  (fn
    (pred l yes no)
    (conde
      ((nullo l) (nullo yes) (nullo no))
      ((fresh (a d y-rest n-rest) (conso a d l) (conde ((pred a) (conso a y-rest yes) (== no n-rest) (partitiono pred d y-rest n-rest)) ((nafc (pred a)) (== yes y-rest) (conso a n-rest no) (partitiono pred d y-rest n-rest))))))))
 (define
  foldr-o
  (fn
    (rel l acc result)
    (conde
      ((nullo l) (== result acc))
      ((fresh (a d r-rest) (conso a d l) (foldr-o rel d acc r-rest) (rel a r-rest result))))))
 (define
  foldl-o
  (fn
    (rel l acc result)
    (conde
      ((nullo l) (== result acc))
      ((fresh (a d new-acc) (conso a d l) (rel acc a new-acc) (foldl-o rel d new-acc result))))))
 (define
  flat-mapo
  (fn
    (rel l result)
    (conde
      ((nullo l) (nullo result))
      ((fresh (a d a-result rest-result) (conso a d l) (rel a a-result) (flat-mapo rel d rest-result) (appendo a-result rest-result result))))))
 (define
  nub-o
  (fn
    (l result)
    (conde
      ((nullo l) (nullo result))
      ((fresh (a d r-rest) (conso a d l) (conde ((membero a d) (nub-o d result)) ((nafc (membero a d)) (conso a r-rest result) (nub-o d r-rest))))))))
 (define
  take-while-o
  (fn
    (pred l result)
    (conde
      ((nullo l) (nullo result))
      ((fresh (a d r-rest) (conso a d l) (conde ((pred a) (conso a r-rest result) (take-while-o pred d r-rest)) ((nafc (pred a)) (== result (list)))))))))
 (define
  drop-while-o
  (fn
    (pred l result)
    (conde
      ((nullo l) (nullo result))
      ((fresh (a d) (conso a d l) (conde ((pred a) (drop-while-o pred d result)) ((nafc (pred a)) (== result l))))))))
 (define
  membero
  (fn
    (x l)
    (conde
      ((fresh (d) (conso x d l)))
      ((fresh (a d) (conso a d l) (membero x d))))))
 (define
  not-membero
  (fn
    (x l)
    (conde
      ((nullo l))
      ((fresh (a d) (conso a d l) (nafc (== a x)) (not-membero x d))))))
 (define
  subseto
  (fn
    (l1 l2)
    (conde
      ((nullo l1))
      ((fresh (a d) (conso a d l1) (membero a l2) (subseto d l2))))))
 (define
  reverseo
  (fn
    (l r)
    (conde
      ((nullo l) (nullo r))
      ((fresh (a d res-rev) (conso a d l) (reverseo d res-rev) (appendo res-rev (list a) r))))))
 (define
  rev-acco
  (fn
    (l acc result)
    (conde
      ((nullo l) (== result acc))
      ((fresh (a d acc-prime) (conso a d l) (conso a acc acc-prime) (rev-acco d acc-prime result))))))
 (define rev-2o (fn (l result) (rev-acco l (list) result)))
 (define palindromeo (fn (l) (fresh (rev) (reverseo l rev) (== l rev))))
 (define prefixo (fn (p l) (fresh (rest) (appendo p rest l))))
 (define suffixo (fn (s l) (fresh (front) (appendo front s l))))
 (define
  subo
  (fn
    (s l)
    (fresh
      (front-and-s back front)
      (appendo front-and-s back l)
      (appendo front s front-and-s))))
 (define
  selecto
  (fn
    (x rest l)
    (conde
      ((conso x rest l))
      ((fresh (a d r) (conso a d l) (conso a r rest) (selecto x r d))))))
 (define
  lengtho
  (fn
    (l n)
    (conde
      ((nullo l) (== n :z))
      ((fresh (a d n-1) (conso a d l) (== n (list :s n-1)) (lengtho d n-1))))))
 (define
  inserto
  (fn
    (a l p)
    (conde
      ((conso a l p))
      ((fresh (h t pt) (conso h t l) (conso h pt p) (inserto a t pt))))))
 (define
  permuteo
  (fn
    (l p)
    (conde
      ((nullo l) (nullo p))
      ((fresh (a d perm-d) (conso a d l) (permuteo d perm-d) (inserto a perm-d p))))))
 (define
  flatteno
  (fn
    (tree flat)
    (conde
      ((nullo tree) (nullo flat))
      ((pairo tree)
        (fresh
          (h t hf tf)
          (conso h t tree)
          (flatteno h hf)
          (flatteno t tf)
          (appendo hf tf flat)))
      ((nafc (nullo tree)) (nafc (pairo tree)) (== flat (list tree))))))
 (define
  rembero
  (fn
    (x l out)
    (conde
      ((nullo l) (nullo out))
      ((fresh (a d) (conso a d l) (== a x) (== out d)))
      ((fresh (a d res) (conso a d l) (nafc (== a x)) (conso a res out) (rembero x d res))))))
 (define
  removeo-allo
  (fn
    (x l result)
    (conde
      ((nullo l) (nullo result))
      ((fresh (a d) (conso a d l) (== a x) (removeo-allo x d result)))
      ((fresh (a d r-rest) (conso a d l) (nafc (== a x)) (conso a r-rest result) (removeo-allo x d r-rest))))))
 (define
  assoco
  (fn
    (key pairs val)
    (fresh
      (rest)
      (conde
        ((conso (list key val) rest pairs))
        ((fresh (other) (conso other rest pairs) (assoco key rest val)))))))
 (define
  nth-o
  (fn
    (n l elem)
    (conde
      ((== n :z) (fresh (d) (conso elem d l)))
      ((fresh (n-1 a d) (== n (list :s n-1)) (conso a d l) (nth-o n-1 d elem))))))
 (define
  samelengtho
  (fn
    (l1 l2)
    (conde
      ((nullo l1) (nullo l2))
      ((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (samelengtho d d-prime))))))
 (define
  mapo
  (fn
    (rel l1 l2)
    (conde
      ((nullo l1) (nullo l2))
      ((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (rel a a-prime) (mapo rel d d-prime))))))
 (define
  iterate-no
  (fn
    (rel n x result)
    (conde
      ((== n :z) (== result x))
      ((fresh (n-1 mid) (== n (list :s n-1)) (rel x mid) (iterate-no rel n-1 mid result))))))
 (define
  pairlisto
  (fn
    (l1 l2 pairs)
    (conde
      ((nullo l1) (nullo l2) (nullo pairs))
      ((fresh (a1 d1 a2 d2 d-pairs) (conso a1 d1 l1) (conso a2 d2 l2) (conso (list a1 a2) d-pairs pairs) (pairlisto d1 d2 d-pairs))))))
 (define
  zip-with-o
  (fn
    (rel l1 l2 result)
    (conde
      ((nullo l1) (nullo l2) (nullo result))
      ((fresh (a1 d1 a2 d2 a-result d-result) (conso a1 d1 l1) (conso a2 d2 l2) (rel a1 a2 a-result) (conso a-result d-result result) (zip-with-o rel d1 d2 d-result))))))
 (define
  swap-firsto
  (fn
    (l result)
    (fresh
      (a b rest mid-l mid-r)
      (conso a mid-l l)
      (conso b rest mid-l)
      (conso b mid-r result)
      (conso a rest mid-r))))
 (define
  everyo
  (fn
    (rel l)
    (conde
      ((nullo l))
      ((fresh (a d) (conso a d l) (rel a) (everyo rel d))))))
 (define
  someo
  (fn
    (rel l)
    (conde
      ((fresh (a d) (conso a d l) (rel a)))
      ((fresh (a d) (conso a d l) (someo rel d))))))
 (define
  lasto
  (fn
    (l x)
    (conde
      ((conso x (list) l))
      ((fresh (a d) (conso a d l) (lasto d x))))))
 (define
  init-o
  (fn
    (l init)
    (conde
      ((fresh (x) (conso x (list) l) (== init (list))))
      ((fresh (a d d-init) (conso a d l) (conso a d-init init) (init-o d d-init))))))
 (define
  tako
  (fn
    (n l prefix)
    (conde
      ((== n :z) (== prefix (list)))
      ((fresh (n-1 a d p-rest) (== n (list :s n-1)) (conso a d l) (conso a p-rest prefix) (tako n-1 d p-rest))))))
 (define
  dropo
  (fn
    (n l suffix)
    (conde
      ((== n :z) (== suffix l))
      ((fresh (n-1 a d) (== n (list :s n-1)) (conso a d l) (dropo n-1 d suffix))))))
 (define
  repeato
  (fn
    (x n result)
    (conde
      ((== n :z) (== result (list)))
      ((fresh (n-1 r-rest) (== n (list :s n-1)) (conso x r-rest result) (repeato x n-1 r-rest))))))
 (define
  concato
  (fn
    (lists result)
    (conde
      ((nullo lists) (nullo result))
      ((fresh (h t r-rest) (conso h t lists) (appendo h r-rest result) (concato t r-rest))))))
--- a/lib/minikanren/run.sx
+++ b/lib/minikanren/run.sx
@@ -1,56 +0,0 @@
 ;; lib/minikanren/run.sx — Phase 3: drive a goal + reify the query var.
 ;;
 ;; reify-name N        — make the canonical "_.N" reified symbol.
 ;; reify-s term rs     — walk term in rs, add a mapping from each fresh
 ;;                       unbound var to its _.N name (left-to-right order).
 ;; reify q s           — walk* q in s, build reify-s, walk* again to
 ;;                       substitute reified names in.
 ;; run-n n q-name g... — defmacro: bind q-name to a fresh var, conj goals,
 ;;                       take ≤ n answers from the stream, reify each
 ;;                       through q-name. n = -1 takes all (used by run*).
 ;; run*                — defmacro: (run* q g...) ≡ (run-n -1 q g...)
 ;; run                 — defmacro: (run n q g...) ≡ (run-n n q g...)
 ;;                       The two-segment form is the standard TRS API.
 (define reify-name (fn (n) (make-symbol (str "_." n))))
 (define
  reify-s
  (fn
    (term rs)
    (let
      ((w (mk-walk term rs)))
      (cond
        ((is-var? w) (extend (var-name w) (reify-name (len rs)) rs))
        ((mk-list-pair? w) (reduce (fn (acc a) (reify-s a acc)) rs w))
        (:else rs)))))
 (define
  reify
  (fn
    (term s)
    (let
      ((w (mk-walk* term s)))
      (let ((rs (reify-s w (empty-subst)))) (mk-walk* w rs)))))
 (defmacro
  run-n
  (n q-name &rest goals)
  (quasiquote
    (let
      (((unquote q-name) (make-var)))
      (map
        (fn (s) (reify (unquote q-name) s))
        (stream-take
          (unquote n)
          ((mk-conj (splice-unquote goals)) empty-s))))))
 (defmacro
  run*
  (q-name &rest goals)
  (quasiquote (run-n -1 (unquote q-name) (splice-unquote goals))))
 (defmacro
  run
  (n q-name &rest goals)
  (quasiquote (run-n (unquote n) (unquote q-name) (splice-unquote goals))))
--- a/lib/minikanren/stream.sx
+++ b/lib/minikanren/stream.sx
@@ -1,66 +0,0 @@
 ;; lib/minikanren/stream.sx — Phase 2 piece A: lazy streams of substitutions.
 ;;
 ;; SX has no improper pairs (cons requires a list cdr), so we use a
 ;; tagged stream-cell shape for mature stream elements:
 ;;
 ;;   stream  ::= mzero                        empty (the SX empty list)
 ;;             | (:s HEAD TAIL)               mature cell, TAIL is a stream
 ;;             | thunk                        (fn () ...) → stream when forced
 ;;
 ;; HEAD is a substitution dict. TAIL is again a stream (possibly a thunk),
 ;; which is what gives us laziness — mk-mplus can return a mature head with
 ;; a thunk in the tail, deferring the rest of the search.
 (define mzero (list))
 (define s-cons (fn (h t) (list :s h t)))
 (define
  s-cons?
  (fn (s) (and (list? s) (not (empty? s)) (= (first s) :s))))
 (define s-car (fn (s) (nth s 1)))
 (define s-cdr (fn (s) (nth s 2)))
 (define unit (fn (s) (s-cons s mzero)))
 (define stream-pause? (fn (s) (and (not (list? s)) (callable? s))))
 ;; mk-mplus — interleave two streams. If s1 is paused we suspend and
 ;; swap (Reasoned Schemer "interleave"); otherwise mature-cons head with
 ;; mk-mplus of the rest.
 (define
  mk-mplus
  (fn
    (s1 s2)
    (cond
      ((empty? s1) s2)
      ((stream-pause? s1) (fn () (mk-mplus s2 (s1))))
      (:else (s-cons (s-car s1) (mk-mplus (s-cdr s1) s2))))))
 ;; mk-bind — apply goal g to every substitution in stream s, mk-mplus-ing.
 (define
  mk-bind
  (fn
    (s g)
    (cond
      ((empty? s) mzero)
      ((stream-pause? s) (fn () (mk-bind (s) g)))
      (:else (mk-mplus (g (s-car s)) (mk-bind (s-cdr s) g))))))
 ;; stream-take — force up to n results out of a (possibly lazy) stream
 ;; into a flat SX list of substitutions. n = -1 means take all.
 (define
  stream-take
  (fn
    (n s)
    (cond
      ((= n 0) (list))
      ((empty? s) (list))
      ((stream-pause? s) (stream-take n (s)))
      (:else
        (cons
          (s-car s)
          (stream-take
            (if (= n -1) -1 (- n 1))
            (s-cdr s)))))))
--- a/lib/minikanren/tabling.sx
+++ b/lib/minikanren/tabling.sx
@@ -1,157 +0,0 @@
 ;; lib/minikanren/tabling.sx — Phase 7 piece A: naive memoization.
 ;;
 ;; A `table-2` wrapper for 2-arg relations (input, output). Caches by
 ;; ground input (walked at call time). On hit, replays the cached output
 ;; values; on miss, runs the relation, collects all output values from
 ;; the answer stream, stores, then replays.
 ;;
 ;; Limitations of naive memoization (vs proper SLG / producer-consumer
 ;; tabling):
 ;;   - Each call must terminate before its result enters the cache —
 ;;     so cyclic recursive calls with the SAME ground input would still
 ;;     diverge (not addressed here).
 ;;   - Caching by full ground walk only; partially-ground args fall
 ;;     through to the underlying relation.
 ;;
 ;; Despite the limitations, naive memoization is enough for the
 ;; canonical demo: Fibonacci goes from exponential to linear because
 ;; each fib(k) result is computed at most once.
 ;;
 ;; Cache lifetime: a single global mk-tab-cache. Use `(mk-tab-clear!)`
 ;; between independent queries.
 (define mk-tab-cache {})
 (define mk-tab-clear! (fn () (set! mk-tab-cache {})))
 (define
  mk-tab-lookup
  (fn
    (key)
    (cond
      ((has-key? mk-tab-cache key) (get mk-tab-cache key))
      (:else :miss))))
 (define
  mk-tab-store!
  (fn (key vals) (set! mk-tab-cache (assoc mk-tab-cache key vals))))
 (define
  mk-tab-ground-term?
  (fn
    (t)
    (cond
      ((is-var? t) false)
      ((mk-cons-cell? t)
        (and
          (mk-tab-ground-term? (mk-cons-head t))
          (mk-tab-ground-term? (mk-cons-tail t))))
      ((mk-list-pair? t) (every? mk-tab-ground-term? t))
      (:else true))))
 (define
  mk-tab-replay-vals
  (fn
    (vals output s)
    (cond
      ((empty? vals) mzero)
      (:else
        (let
          ((sp (mk-unify output (first vals) s)))
          (let
            ((this-stream (cond ((= sp nil) mzero) (:else (unit sp)))))
            (mk-mplus this-stream (mk-tab-replay-vals (rest vals) output s))))))))
 (define
  table-2
  (fn
    (name rel-fn)
    (fn
      (input output)
      (fn
        (s)
        (let
          ((winput (mk-walk* input s)))
          (cond
            ((mk-tab-ground-term? winput)
              (let
                ((key (str name "@" winput)))
                (let
                  ((cached (mk-tab-lookup key)))
                  (cond
                    ((= cached :miss)
                      (let
                        ((all-substs (stream-take -1 ((rel-fn input output) s))))
                        (let
                          ((vals (map (fn (s2) (mk-walk* output s2)) all-substs)))
                          (begin
                            (mk-tab-store! key vals)
                            (mk-tab-replay-vals vals output s)))))
                    (:else (mk-tab-replay-vals cached output s))))))
            (:else ((rel-fn input output) s))))))))
 ;; --- table-1: 1-arg relation (one input, no output to cache) ---
 ;; The relation is a predicate `(p input)` that succeeds or fails.
 ;; Cache stores either :ok or :no.
 (define
  table-1
  (fn
    (name rel-fn)
    (fn
      (input)
      (fn
        (s)
        (let
          ((winput (mk-walk* input s)))
          (cond
            ((mk-tab-ground-term? winput)
              (let
                ((key (str name "@1@" winput)))
                (let
                  ((cached (mk-tab-lookup key)))
                  (cond
                    ((= cached :miss)
                      (let
                        ((stream ((rel-fn input) s)))
                        (let
                          ((peek (stream-take 1 stream)))
                          (cond
                            ((empty? peek)
                              (begin (mk-tab-store! key :no) mzero))
                            (:else (begin (mk-tab-store! key :ok) stream))))))
                    ((= cached :ok) (unit s))
                    ((= cached :no) mzero)
                    (:else mzero)))))
            (:else ((rel-fn input) s))))))))
 ;; --- table-3: 3-arg relation (input1 input2 output) ---
 ;; Cache keyed by (input1, input2). Output values cached as a list.
 (define
  table-3
  (fn
    (name rel-fn)
    (fn
      (i1 i2 output)
      (fn
        (s)
        (let
          ((wi1 (mk-walk* i1 s)) (wi2 (mk-walk* i2 s)))
          (cond
            ((and (mk-tab-ground-term? wi1) (mk-tab-ground-term? wi2))
              (let
                ((key (str name "@3@" wi1 "/" wi2)))
                (let
                  ((cached (mk-tab-lookup key)))
                  (cond
                    ((= cached :miss)
                      (let
                        ((all-substs (stream-take -1 ((rel-fn i1 i2 output) s))))
                        (let
                          ((vals (map (fn (s2) (mk-walk* output s2)) all-substs)))
                          (begin
                            (mk-tab-store! key vals)
                            (mk-tab-replay-vals vals output s)))))
                    (:else (mk-tab-replay-vals cached output s))))))
            (:else ((rel-fn i1 i2 output) s))))))))
--- a/lib/minikanren/tests/appendo3.sx
+++ b/lib/minikanren/tests/appendo3.sx
@@ -1,49 +0,0 @@
 ;; lib/minikanren/tests/appendo3.sx — 3-list append.
 (mk-test
  "appendo3-forward"
  (run*
    q
    (appendo3
      (list 1 2)
      (list 3 4)
      (list 5 6)
      q))
  (list
    (list 1 2 3 4 5 6)))
 (mk-test
  "appendo3-empty-everything"
  (run* q (appendo3 (list) (list) (list) q))
  (list (list)))
 (mk-test
  "appendo3-recover-middle"
  (run*
    q
    (appendo3
      (list 1 2)
      q
      (list 5 6)
      (list 1 2 3 4 5 6)))
  (list (list 3 4)))
 (mk-test
  "appendo3-empty-middle"
  (run*
    q
    (appendo3
      (list 1 2)
      (list)
      (list 3 4)
      q))
  (list (list 1 2 3 4)))
 (mk-test
  "appendo3-empty-first-and-last"
  (run*
    q
    (appendo3 (list) (list 1 2 3) (list) q))
  (list (list 1 2 3)))
 (mk-tests-run!)
--- a/lib/minikanren/tests/arith-prog.sx
+++ b/lib/minikanren/tests/arith-prog.sx
@@ -1,33 +0,0 @@
 ;; lib/minikanren/tests/arith-prog.sx — arithmetic progression generation.
 (mk-test
  "arith-progo-zero-len"
  (run* q (arith-progo 5 1 0 q))
  (list (list)))
 (mk-test
  "arith-progo-1-to-5"
  (run* q (arith-progo 1 1 5 q))
  (list (list 1 2 3 4 5)))
 (mk-test
  "arith-progo-evens-from-0"
  (run* q (arith-progo 0 2 5 q))
  (list (list 0 2 4 6 8)))
 (mk-test
  "arith-progo-descending"
  (run* q (arith-progo 10 -1 4 q))
  (list (list 10 9 8 7)))
 (mk-test
  "arith-progo-zero-step"
  (run* q (arith-progo 7 0 3 q))
  (list (list 7 7 7)))
 (mk-test
  "arith-progo-negative-start"
  (run* q (arith-progo -3 2 4 q))
  (list (list -3 -1 1 3)))
 (mk-tests-run!)
--- a/lib/minikanren/tests/btree-walko.sx
+++ b/lib/minikanren/tests/btree-walko.sx
@@ -1,54 +0,0 @@
 ;; lib/minikanren/tests/btree-walko.sx — walk a leaves-of-binary-tree relation
 ;; using matche dispatch on (:leaf v) and (:node left right) patterns.
 (define
  btree-walko
  (fn
    (tree v)
    (matche
      tree
      ((:leaf x) (== v x))
      ((:node l r) (conde ((btree-walko l v)) ((btree-walko r v)))))))
 ;; A small test tree: ((1 2) (3 (4 5))).
 (define
  test-btree
  (list
    :node (list :node (list :leaf 1) (list :leaf 2))
    (list
      :node (list :leaf 3)
      (list :node (list :leaf 4) (list :leaf 5)))))
 (mk-test
  "btree-walko-enumerates-all-leaves"
  (let
    ((leaves (run* q (btree-walko test-btree q))))
    (and
      (= (len leaves) 5)
      (and
        (some (fn (l) (= l 1)) leaves)
        (and
          (some (fn (l) (= l 2)) leaves)
          (and
            (some (fn (l) (= l 3)) leaves)
            (and
              (some (fn (l) (= l 4)) leaves)
              (some (fn (l) (= l 5)) leaves)))))))
  true)
 (mk-test
  "btree-walko-find-3-membership"
  (run 1 q (btree-walko test-btree 3))
  (list (make-symbol "_.0")))
 (mk-test
  "btree-walko-find-99-not-present"
  (run* q (btree-walko test-btree 99))
  (list))
 (mk-test
  "btree-walko-leaf-only"
  (run* q (btree-walko (list :leaf 42) q))
  (list 42))
 (mk-tests-run!)
--- a/lib/minikanren/tests/classics.sx
+++ b/lib/minikanren/tests/classics.sx
@@ -1,87 +0,0 @@
 ;; lib/minikanren/tests/classics.sx — small classic-style puzzles that
 ;; exercise the full system end to end (relations + conde + matche +
 ;; fresh + run*). Each test is a self-contained miniKanren program.
 ;; -----------------------------------------------------------------------
 ;; Pet puzzle (3 friends, 3 pets, 1-each).
 ;; -----------------------------------------------------------------------
 (mk-test
  "classics-pet-puzzle"
  (run*
    q
    (fresh
      (a b c)
      (== q (list a b c))
      (permuteo (list :dog :cat :fish) (list a b c))
      (== b :fish)
      (conde ((== a :cat)) ((== a :fish)))))
  (list (list :cat :fish :dog)))
 ;; -----------------------------------------------------------------------
 ;; Family-relations puzzle (uses membero on a fact list).
 ;; -----------------------------------------------------------------------
 (define
  parent-facts
  (list
    (list "alice" "bob")
    (list "alice" "carol")
    (list "bob" "dave")
    (list "carol" "eve")
    (list "dave" "frank")))
 (define parento (fn (x y) (membero (list x y) parent-facts)))
 (define grandparento (fn (x z) (fresh (y) (parento x y) (parento y z))))
 (mk-test
  "classics-grandparents-of-frank"
  (run* q (grandparento q "frank"))
  (list "bob"))
 (mk-test
  "classics-grandchildren-of-alice"
  (run* q (grandparento "alice" q))
  (list "dave" "eve"))
 ;; -----------------------------------------------------------------------
 ;; Symbolic differentiation, matche-driven.
 ;;   Variable :x:                d/dx x  = 1
 ;;   Sum (:+ a b):                d/dx (a+b) = (da + db)
 ;;   Product (:* a b):            d/dx (a*b) = (da*b + a*db)
 ;; -----------------------------------------------------------------------
 (define
  diffo
  (fn
    (expr var d)
    (matche
      expr
      (:x (== d 1))
      ((:+ a b)
        (fresh
          (da db)
          (== d (list :+ da db))
          (diffo a var da)
          (diffo b var db)))
      ((:* a b)
        (fresh
          (da db)
          (== d (list :+ (list :* da b) (list :* a db)))
          (diffo a var da)
          (diffo b var db))))))
 (mk-test "classics-diff-of-x" (run* q (diffo :x :x q)) (list 1))
 (mk-test
  "classics-diff-of-x-plus-x"
  (run* q (diffo (list :+ :x :x) :x q))
  (list (list :+ 1 1)))
 (mk-test
  "classics-diff-of-x-times-x"
  (run* q (diffo (list :* :x :x) :x q))
  (list (list :+ (list :* 1 :x) (list :* :x 1))))
 (mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-distinct.sx
+++ b/lib/minikanren/tests/clpfd-distinct.sx
@@ -1,52 +0,0 @@
 ;; lib/minikanren/tests/clpfd-distinct.sx — fd-distinct (alldifferent).
 (mk-test
  "fd-distinct-empty"
  (run* q (fd-distinct (list)))
  (list (make-symbol "_.0")))
 (mk-test
  "fd-distinct-singleton"
  (run* q (fd-distinct (list 5)))
  (list (make-symbol "_.0")))
 (mk-test
  "fd-distinct-pair-distinct"
  (run* q (fd-distinct (list 1 2)))
  (list (make-symbol "_.0")))
 (mk-test
  "fd-distinct-pair-equal-fails"
  (run* q (fd-distinct (list 5 5)))
  (list))
 (mk-test
  "fd-distinct-3-perms-of-3"
  (let
    ((res (run* q (fresh (a b c) (fd-in a (list 1 2 3)) (fd-in b (list 1 2 3)) (fd-in c (list 1 2 3)) (fd-distinct (list a b c)) (fd-label (list a b c)) (== q (list a b c))))))
    (= (len res) 6))
  true)
 (mk-test
  "fd-distinct-4-perms-of-4-count"
  (let
    ((res (run* q (fresh (a b c d) (fd-in a (list 1 2 3 4)) (fd-in b (list 1 2 3 4)) (fd-in c (list 1 2 3 4)) (fd-in d (list 1 2 3 4)) (fd-distinct (list a b c d)) (fd-label (list a b c d)) (== q (list a b c d))))))
    (= (len res) 24))
  true)
 (mk-test
  "fd-distinct-pigeonhole-fails"
  (run*
    q
    (fresh
      (a b c d)
      (fd-in a (list 1 2 3))
      (fd-in b (list 1 2 3))
      (fd-in c (list 1 2 3))
      (fd-in d (list 1 2 3))
      (fd-distinct (list a b c d))
      (fd-label (list a b c d))
      (== q (list a b c d))))
  (list))
 (mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-domains.sx
+++ b/lib/minikanren/tests/clpfd-domains.sx
@@ -1,133 +0,0 @@
 ;; lib/minikanren/tests/clpfd-domains.sx — Phase 6 piece B: domain primitives.
 ;; --- domain construction ---
 (mk-test
  "fd-dom-from-list-sorts"
  (fd-dom-from-list
    (list 3 1 2 1 5))
  (list 1 2 3 5))
 (mk-test "fd-dom-from-list-empty" (fd-dom-from-list (list)) (list))
 (mk-test
  "fd-dom-from-list-single"
  (fd-dom-from-list (list 7))
  (list 7))
 (mk-test
  "fd-dom-range-1-5"
  (fd-dom-range 1 5)
  (list 1 2 3 4 5))
 (mk-test "fd-dom-range-empty" (fd-dom-range 5 1) (list))
 ;; --- predicates ---
 (mk-test "fd-dom-empty-yes" (fd-dom-empty? (list)) true)
 (mk-test "fd-dom-empty-no" (fd-dom-empty? (list 1)) false)
 (mk-test "fd-dom-singleton-yes" (fd-dom-singleton? (list 5)) true)
 (mk-test
  "fd-dom-singleton-multi"
  (fd-dom-singleton? (list 1 2))
  false)
 (mk-test "fd-dom-singleton-empty" (fd-dom-singleton? (list)) false)
 (mk-test
  "fd-dom-min"
  (fd-dom-min (list 3 7 9))
  3)
 (mk-test
  "fd-dom-max"
  (fd-dom-max (list 3 7 9))
  9)
 (mk-test
  "fd-dom-member-yes"
  (fd-dom-member?
    3
    (list 1 2 3 4))
  true)
 (mk-test
  "fd-dom-member-no"
  (fd-dom-member?
    9
    (list 1 2 3 4))
  false)
 ;; --- intersect / without ---
 (mk-test
  "fd-dom-intersect"
  (fd-dom-intersect
    (list 1 2 3 4 5)
    (list 2 4 6))
  (list 2 4))
 (mk-test
  "fd-dom-intersect-disjoint"
  (fd-dom-intersect
    (list 1 2 3)
    (list 4 5 6))
  (list))
 (mk-test
  "fd-dom-intersect-empty"
  (fd-dom-intersect (list) (list 1 2 3))
  (list))
 (mk-test
  "fd-dom-intersect-equal"
  (fd-dom-intersect
    (list 1 2 3)
    (list 1 2 3))
  (list 1 2 3))
 (mk-test
  "fd-dom-without-mid"
  (fd-dom-without
    3
    (list 1 2 3 4 5))
  (list 1 2 4 5))
 (mk-test
  "fd-dom-without-missing"
  (fd-dom-without 9 (list 1 2 3))
  (list 1 2 3))
 (mk-test
  "fd-dom-without-min"
  (fd-dom-without 1 (list 1 2 3))
  (list 2 3))
 ;; --- store accessors ---
 (mk-test "fd-domain-of-unset" (fd-domain-of {} "x") nil)
 (mk-test
  "fd-domain-of-set"
  (let
    ((s (fd-set-domain {} "x" (list 1 2 3))))
    (fd-domain-of s "x"))
  (list 1 2 3))
 (mk-test
  "fd-set-domain-empty-fails"
  (fd-set-domain {} "x" (list))
  nil)
 (mk-test
  "fd-set-domain-overrides"
  (let
    ((s (fd-set-domain {} "x" (list 1 2 3))))
    (fd-domain-of (fd-set-domain s "x" (list 5)) "x"))
  (list 5))
 (mk-test
  "fd-set-domain-multiple-vars"
  (let
    ((s (fd-set-domain (fd-set-domain {} "x" (list 1)) "y" (list 2 3))))
    (list (fd-domain-of s "x") (fd-domain-of s "y")))
  (list (list 1) (list 2 3)))
 (mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-in-label.sx
+++ b/lib/minikanren/tests/clpfd-in-label.sx
@@ -1,120 +0,0 @@
 ;; lib/minikanren/tests/clpfd-in-label.sx — fd-in (domain narrowing) + fd-label.
 ;; --- fd-in: domain narrowing ---
 (mk-test
  "fd-in-bare-label"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 1 2 3 4 5))
      (fd-label (list x))
      (== q x)))
  (list 1 2 3 4 5))
 (mk-test
  "fd-in-intersection"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 1 2 3 4 5))
      (fd-in x (list 3 4 5 6 7))
      (fd-label (list x))
      (== q x)))
  (list 3 4 5))
 (mk-test
  "fd-in-disjoint-empty"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 1 2 3))
      (fd-in x (list 7 8 9))
      (fd-label (list x))
      (== q x)))
  (list))
 (mk-test
  "fd-in-singleton-domain"
  (run*
    q
    (fresh (x) (fd-in x (list 5)) (fd-label (list x)) (== q x)))
  (list 5))
 ;; --- ground value checks the domain ---
 (mk-test
  "fd-in-ground-in-domain"
  (run*
    q
    (fresh
      (x)
      (== x 3)
      (fd-in x (list 1 2 3 4 5))
      (== q x)))
  (list 3))
 (mk-test
  "fd-in-ground-not-in-domain"
  (run*
    q
    (fresh
      (x)
      (== x 9)
      (fd-in x (list 1 2 3 4 5))
      (== q x)))
  (list))
 ;; --- fd-label across multiple vars ---
 (mk-test
  "fd-label-multiple-vars"
  (let
    ((res (run* q (fresh (a b) (fd-in a (list 1 2 3)) (fd-in b (list 10 20)) (fd-label (list a b)) (== q (list a b))))))
    (= (len res) 6))
  true)
 (mk-test
  "fd-label-empty-vars"
  (run* q (fd-label (list)))
  (list (make-symbol "_.0")))
 ;; --- composition with regular goals ---
 (mk-test
  "fd-in-with-membero-style-filtering"
  (run*
    q
    (fresh
      (x)
      (fd-in
        x
        (list
          1
          2
          3
          4
          5
          6
          7
          8
          9
          10))
      (fd-label (list x))
      (== q x)))
  (list
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10))
 (mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-neq.sx
+++ b/lib/minikanren/tests/clpfd-neq.sx
@@ -1,82 +0,0 @@
 ;; lib/minikanren/tests/clpfd-neq.sx — fd-neq with constraint propagation.
 ;; --- ground / domain interaction ---
 (mk-test
  "fd-neq-ground-distinct"
  (run*
    q
    (fresh
      (x)
      (fd-neq x 5)
      (fd-in x (list 4 5 6))
      (fd-label (list x))
      (== q x)))
  (list 4 6))
 (mk-test
  "fd-neq-ground-equal-fails"
  (run* q (fresh (x) (== x 5) (fd-neq x 5) (== q x)))
  (list))
 (mk-test
  "fd-neq-symmetric"
  (run*
    q
    (fresh
      (x)
      (fd-neq 7 x)
      (fd-in x (list 5 6 7 8 9))
      (fd-label (list x))
      (== q x)))
  (list 5 6 8 9))
 ;; --- two vars with overlapping domains ---
 (mk-test
  "fd-neq-pair-from-3"
  (let
    ((res (run* q (fresh (x y) (fd-in x (list 1 2 3)) (fd-in y (list 1 2 3)) (fd-neq x y) (fd-label (list x y)) (== q (list x y))))))
    (= (len res) 6))
  true)
 (mk-test
  "fd-all-distinct-3-of-3"
  (let
    ((res (run* q (fresh (a b c) (fd-in a (list 1 2 3)) (fd-in b (list 1 2 3)) (fd-in c (list 1 2 3)) (fd-neq a b) (fd-neq a c) (fd-neq b c) (fd-label (list a b c)) (== q (list a b c))))))
    (= (len res) 6))
  true)
 (mk-test
  "fd-pigeonhole-fails"
  (run*
    q
    (fresh
      (a b c)
      (fd-in a (list 1 2))
      (fd-in b (list 1 2))
      (fd-in c (list 1 2))
      (fd-neq a b)
      (fd-neq a c)
      (fd-neq b c)
      (fd-label (list a b c))
      (== q (list a b c))))
  (list))
 ;; --- propagation when one side becomes ground ---
 (mk-test
  "fd-neq-propagates-after-ground"
  (run*
    q
    (fresh
      (x y)
      (fd-in x (list 1 2 3))
      (fd-in y (list 1 2 3))
      (fd-neq x y)
      (== x 2)
      (fd-label (list y))
      (== q y)))
  (list 1 3))
 (mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-ord.sx
+++ b/lib/minikanren/tests/clpfd-ord.sx
@@ -1,128 +0,0 @@
 ;; lib/minikanren/tests/clpfd-ord.sx — fd-lt / fd-lte / fd-eq.
 ;; --- fd-lt ---
 (mk-test
  "fd-lt-narrows-x-against-num"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 1 2 3 4 5))
      (fd-lt x 3)
      (fd-label (list x))
      (== q x)))
  (list 1 2))
 (mk-test
  "fd-lt-narrows-x-against-num-symmetric"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 1 2 3 4 5))
      (fd-lt 3 x)
      (fd-label (list x))
      (== q x)))
  (list 4 5))
 (mk-test
  "fd-lt-pair-ordered"
  (let
    ((res (run* q (fresh (x y) (fd-in x (list 1 2 3 4)) (fd-in y (list 1 2 3 4)) (fd-lt x y) (fd-label (list x y)) (== q (list x y))))))
    (= (len res) 6))
  true)
 (mk-test
  "fd-lt-impossible-fails"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 5 6 7))
      (fd-lt x 3)
      (fd-label (list x))
      (== q x)))
  (list))
 ;; --- fd-lte ---
 (mk-test
  "fd-lte-includes-equal"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 1 2 3 4 5))
      (fd-lte x 3)
      (fd-label (list x))
      (== q x)))
  (list 1 2 3))
 (mk-test
  "fd-lte-equal-bound"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 1 2 3 4 5))
      (fd-lte 3 x)
      (fd-label (list x))
      (== q x)))
  (list 3 4 5))
 ;; --- fd-eq ---
 (mk-test
  "fd-eq-bind"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 1 2 3 4 5))
      (fd-eq x 3)
      (== q x)))
  (list 3))
 (mk-test
  "fd-eq-out-of-domain-fails"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 1 2 3))
      (fd-eq x 5)
      (== q x)))
  (list))
 (mk-test
  "fd-eq-two-vars-share-domain"
  (run*
    q
    (fresh
      (x y)
      (fd-in x (list 1 2 3))
      (fd-in y (list 2 3 4))
      (fd-eq x y)
      (fd-label (list x y))
      (== q (list x y))))
  (list (list 2 2) (list 3 3)))
 ;; --- combine fd-lt + fd-neq for "between" puzzle ---
 (mk-test
  "fd-lt-neq-combined"
  (run*
    q
    (fresh
      (x y z)
      (fd-in x (list 1 2 3))
      (fd-in y (list 1 2 3))
      (fd-in z (list 1 2 3))
      (fd-lt x y)
      (fd-lt y z)
      (fd-label (list x y z))
      (== q (list x y z))))
  (list (list 1 2 3)))
 (mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-plus.sx
+++ b/lib/minikanren/tests/clpfd-plus.sx
@@ -1,62 +0,0 @@
 ;; lib/minikanren/tests/clpfd-plus.sx — fd-plus (x + y = z).
 (mk-test
  "fd-plus-all-ground"
  (run* q (fresh (z) (fd-plus 2 3 z) (== q z)))
  (list 5))
 (mk-test
  "fd-plus-recover-x"
  (run* q (fresh (x) (fd-plus x 3 5) (== q x)))
  (list 2))
 (mk-test
  "fd-plus-recover-y"
  (run* q (fresh (y) (fd-plus 2 y 5) (== q y)))
  (list 3))
 (mk-test
  "fd-plus-impossible-fails"
  (run*
    q
    (fresh
      (z)
      (fd-plus 2 3 z)
      (== z 99)
      (== q z)))
  (list))
 (mk-test
  "fd-plus-domain-check"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 3 4 5))
      (fd-plus x 3 5)
      (== q x)))
  (list))
 (mk-test
  "fd-plus-pairs-summing-to-5"
  (run*
    q
    (fresh
      (x y)
      (fd-in x (list 1 2 3 4))
      (fd-in y (list 1 2 3 4))
      (fd-plus x y 5)
      (fd-label (list x y))
      (== q (list x y))))
  (list
    (list 1 4)
    (list 2 3)
    (list 3 2)
    (list 4 1)))
 (mk-test
  "fd-plus-z-derived"
  (run* q (fresh (z) (fd-plus 7 8 z) (== q z)))
  (list 15))
 (mk-tests-run!)
--- a/lib/minikanren/tests/clpfd-times.sx
+++ b/lib/minikanren/tests/clpfd-times.sx
@@ -1,85 +0,0 @@
 ;; lib/minikanren/tests/clpfd-times.sx — fd-times (x * y = z).
 (mk-test
  "fd-times-3-4"
  (run* q (fresh (z) (fd-times 3 4 z) (== q z)))
  (list 12))
 (mk-test
  "fd-times-recover-divisor"
  (run* q (fresh (x) (fd-times x 5 30) (== q x)))
  (list 6))
 (mk-test
  "fd-times-non-divisible-fails"
  (run* q (fresh (x) (fd-times x 5 31) (== q x)))
  (list))
 (mk-test
  "fd-times-by-zero"
  (run* q (fresh (z) (fd-times 0 99 z) (== q z)))
  (list 0))
 (mk-test
  "fd-times-zero-by-anything-zero"
  (run*
    q
    (fresh
      (x)
      (fd-in x (list 1 2 3))
      (fd-times x 0 0)
      (fd-label (list x))
      (== q x)))
  (list 1 2 3))
 (mk-test
  "fd-times-12-divisor-pairs"
  (run*
    q
    (fresh
      (x y)
      (fd-in
        x
        (list
          1
          2
          3
          4
          5
          6))
      (fd-in
        y
        (list
          1
          2
          3
          4
          5
          6))
      (fd-times x y 12)
      (fd-label (list x y))
      (== q (list x y))))
  (list
    (list 2 6)
    (list 3 4)
    (list 4 3)
    (list 6 2)))
 (mk-test
  "fd-times-square-of-each"
  (run*
    q
    (fresh
      (x z)
      (fd-in x (list 1 2 3 4 5))
      (fd-times x x z)
      (fd-label (list x))
      (== q (list x z))))
  (list
    (list 1 1)
    (list 2 4)
    (list 3 9)
    (list 4 16)
    (list 5 25)))
 (mk-tests-run!)
--- a/lib/minikanren/tests/conda.sx
+++ b/lib/minikanren/tests/conda.sx
@@ -1,75 +0,0 @@
 ;; lib/minikanren/tests/conda.sx — Phase 5 piece A tests for `conda`.
 ;; --- conda commits to first non-failing head, keeps ALL its answers ---
 (mk-test
  "conda-first-clause-keeps-all"
  (run*
    q
    (conda
      ((mk-disj (== q 1) (== q 2)))
      ((== q 100))))
  (list 1 2))
 (mk-test
  "conda-skips-failing-head"
  (run*
    q
    (conda
      ((== 1 2))
      ((mk-disj (== q 10) (== q 20)))))
  (list 10 20))
 (mk-test
  "conda-all-fail"
  (run*
    q
    (conda ((== 1 2)) ((== 3 4))))
  (list))
 (mk-test "conda-no-clauses" (run* q (conda)) (list))
 ;; --- conda DIFFERS from condu: conda keeps all head answers ---
 (mk-test
  "conda-vs-condu-divergence"
  (list
    (run*
      q
      (conda
        ((mk-disj (== q 1) (== q 2)))
        ((== q 100))))
    (run*
      q
      (condu
        ((mk-disj (== q 1) (== q 2)))
        ((== q 100)))))
  (list (list 1 2) (list 1)))
 ;; --- conda head's rest-goals run on every head answer ---
 (mk-test
  "conda-rest-goals-run-on-all-answers"
  (run*
    q
    (fresh
      (x r)
      (conda
        ((mk-disj (== x 1) (== x 2))
          (== r (list :tag x))))
      (== q r)))
  (list (list :tag 1) (list :tag 2)))
 ;; --- if rest-goals fail on a head answer, that head answer is filtered;
 ;;     the clause does not fall through to next clauses (per soft-cut). ---
 (mk-test
  "conda-rest-fails-no-fallthrough"
  (run*
    q
    (conda
      ((mk-disj (== q 1) (== q 2)) (== q 99))
      ((== q 200))))
  (list))
 (mk-tests-run!)
--- a/lib/minikanren/tests/conde.sx
+++ b/lib/minikanren/tests/conde.sx
@@ -1,89 +0,0 @@
 ;; lib/minikanren/tests/conde.sx — Phase 2 piece C tests for `conde`.
 ;;
 ;; Note on ordering: conde clauses are wrapped in Zzz (inverse-eta delay),
 ;; so applying the conde goal to a substitution returns thunks. mk-mplus
 ;; suspends-and-swaps when its left operand is paused, giving fair
 ;; interleaving — this is exactly what makes recursive relations work,
 ;; but it does mean conde answers can interleave rather than appear in
 ;; strict left-to-right clause order.
 ;; --- single-clause conde ≡ conj of clause body ---
 (mk-test
  "conde-one-clause"
  (let ((q (mk-var "q"))) (run* q (conde ((== q 7)))))
  (list 7))
 (mk-test
  "conde-one-clause-multi-goals"
  (let
    ((q (mk-var "q")))
    (run* q (conde ((fresh (x) (== x 5) (== q (list x x)))))))
  (list (list 5 5)))
 ;; --- multi-clause: produces one row per clause (interleaved) ---
 (mk-test
  "conde-three-clauses-as-set"
  (let
    ((qs (run* q (conde ((== q 1)) ((== q 2)) ((== q 3))))))
    (and
      (= (len qs) 3)
      (and
        (some (fn (x) (= x 1)) qs)
        (and
          (some (fn (x) (= x 2)) qs)
          (some (fn (x) (= x 3)) qs)))))
  true)
 (mk-test
  "conde-mixed-success-failure-as-set"
  (let
    ((qs (run* q (conde ((== q "a")) ((== 1 2)) ((== q "b"))))))
    (and
      (= (len qs) 2)
      (and (some (fn (x) (= x "a")) qs) (some (fn (x) (= x "b")) qs))))
  true)
 ;; --- conde with conjuncts inside clauses ---
 (mk-test
  "conde-clause-conj-as-set"
  (let
    ((rows (run* q (fresh (x y) (conde ((== x 1) (== y 10)) ((== x 2) (== y 20))) (== q (list x y))))))
    (and
      (= (len rows) 2)
      (and
        (some (fn (r) (= r (list 1 10))) rows)
        (some (fn (r) (= r (list 2 20))) rows))))
  true)
 ;; --- nested conde ---
 (mk-test
  "conde-nested-yields-three"
  (let
    ((qs (run* q (conde ((conde ((== q 1)) ((== q 2)))) ((== q 3))))))
    (and
      (= (len qs) 3)
      (and
        (some (fn (x) (= x 1)) qs)
        (and
          (some (fn (x) (= x 2)) qs)
          (some (fn (x) (= x 3)) qs)))))
  true)
 ;; --- conde all clauses fail → empty stream ---
 (mk-test
  "conde-all-fail"
  (run*
    q
    (conde ((== 1 2)) ((== 3 4))))
  (list))
 ;; --- empty conde: no clauses ⇒ fail ---
 (mk-test "conde-no-clauses" (run* q (conde)) (list))
 (mk-tests-run!)
--- a/lib/minikanren/tests/condu.sx
+++ b/lib/minikanren/tests/condu.sx
@@ -1,86 +0,0 @@
 ;; lib/minikanren/tests/condu.sx — Phase 2 piece D tests for `onceo` and `condu`.
 ;; --- onceo: at most one answer ---
 (mk-test
  "onceo-single-success-passes-through"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 5 ((onceo (== q 7)) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list 7))
 (mk-test
  "onceo-multi-success-trimmed-to-one"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 5 ((onceo (mk-disj (== q 1) (== q 2) (== q 3))) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list 1))
 (mk-test
  "onceo-failure-stays-failure"
  ((onceo (== 1 2)) empty-s)
  (list))
 (mk-test
  "onceo-conde-trimmed"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 5 ((onceo (conde ((== q "a")) ((== q "b")))) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list "a"))
 ;; --- condu: first clause with successful head wins ---
 (mk-test
  "condu-first-clause-wins"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 10 ((condu ((== q 1)) ((== q 2))) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list 1))
 (mk-test
  "condu-skips-failing-head"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 10 ((condu ((== 1 2)) ((== q 100)) ((== q 200))) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list 100))
 (mk-test
  "condu-all-fail-empty"
  ((condu ((== 1 2)) ((== 3 4)))
    empty-s)
  (list))
 (mk-test "condu-empty-clauses-fail" ((condu) empty-s) (list))
 ;; --- condu commits head's first answer; rest-goals can still backtrack
 ;;     within that committed substitution but cannot revisit other heads. ---
 (mk-test
  "condu-head-onceo-rest-runs"
  (let
    ((q (mk-var "q")) (r (mk-var "r")))
    (let
      ((res (stream-take 10 ((condu ((mk-disj (== q 1) (== q 2)) (== r 99))) empty-s))))
      (map (fn (s) (list (mk-walk q s) (mk-walk r s))) res)))
  (list (list 1 99)))
 (mk-test
  "condu-rest-goals-can-fail-the-clause"
  (let
    ((q (mk-var "q")))
    (let
      ((res (stream-take 10 ((condu ((== q 1) (== 2 3)) ((== q 99))) empty-s))))
      (map (fn (s) (mk-walk q s)) res)))
  (list))
 (mk-tests-run!)
--- a/lib/minikanren/tests/counto.sx
+++ b/lib/minikanren/tests/counto.sx
@@ -1,35 +0,0 @@
 ;; lib/minikanren/tests/counto.sx — count occurrences of x in l (intarith).
 (mk-test
  "counto-empty"
  (run* q (counto 1 (list) q))
  (list 0))
 (mk-test
  "counto-not-found"
  (run* q (counto 99 (list 1 2 3) q))
  (list 0))
 (mk-test
  "counto-once"
  (run* q (counto 2 (list 1 2 3) q))
  (list 1))
 (mk-test
  "counto-thrice"
  (run*
    q
    (counto
      1
      (list 1 2 1 3 1)
      q))
  (list 3))
 (mk-test
  "counto-all-same"
  (run*
    q
    (counto 7 (list 7 7 7 7) q))
  (list 4))
 (mk-test
  "counto-string"
  (run* q (counto "x" (list "x" "y" "x") q))
  (list 2))
 (mk-tests-run!)
--- a/lib/minikanren/tests/cyclic-graph.sx
+++ b/lib/minikanren/tests/cyclic-graph.sx
@@ -1,48 +0,0 @@
 ;; lib/minikanren/tests/cyclic-graph.sx — demonstrates the naive-patho
 ;; behaviour on a cyclic graph. Without Phase-7 tabling/SLG, the search
 ;; produces ever-longer paths revisiting the cycle. `run n` truncates;
 ;; `run*` would diverge.
 (define cyclic-edges (list (list :a :b) (list :b :a) (list :b :c)))
 (define cyclic-edgeo (fn (x y) (membero (list x y) cyclic-edges)))
 (define
  cyclic-patho
  (fn
    (x y path)
    (conde
      ((cyclic-edgeo x y) (== path (list x y)))
      ((fresh (z mid) (cyclic-edgeo x z) (cyclic-patho z y mid) (conso x mid path))))))
 ;; --- direct edge ---
 (mk-test
  "cyclic-direct"
  (run 1 q (cyclic-patho :a :b q))
  (list (list :a :b)))
 ;; --- runs first 5 paths from a to b: bare edge, then increasing
 ;;     numbers of cycle traversals (a->b->a->b, etc.) ---
 (mk-test
  "cyclic-enumerates-prefix-via-run-n"
  (let
    ((paths (run 5 q (cyclic-patho :a :b q))))
    (and
      (= (len paths) 5)
      (and
        (every? (fn (p) (= (first p) :a)) paths)
        (every? (fn (p) (= (last p) :b)) paths))))
  true)
 (mk-test
  "cyclic-finds-c-via-cycle-or-direct"
  (let
    ((paths (run 3 q (cyclic-patho :a :c q))))
    (and
      (>= (len paths) 1)
      (some (fn (p) (= p (list :a :b :c))) paths)))
  true)
 (mk-tests-run!)
--- a/lib/minikanren/tests/defrel.sx
+++ b/lib/minikanren/tests/defrel.sx
@@ -1,40 +0,0 @@
 ;; lib/minikanren/tests/defrel.sx — Prolog-style relation definition macro.
 (defrel
  (my-membero x l)
  ((fresh (d) (conso x d l)))
  ((fresh (a d) (conso a d l) (my-membero x d))))
 (mk-test
  "defrel-defines-membero"
  (run* q (my-membero q (list 1 2 3)))
  (list 1 2 3))
 (defrel
  (my-listo l)
  ((nullo l))
  ((fresh (a d) (conso a d l) (my-listo d))))
 (mk-test
  "defrel-listo-bounded"
  (run 3 q (my-listo q))
  (list
    (list)
    (list (make-symbol "_.0"))
    (list (make-symbol "_.0") (make-symbol "_.1"))))
 ;; Multi-arg relation with arithmetic.
 (defrel
  (my-pluso a b c)
  ((== a :z) (== b c))
  ((fresh (a-1 c-1) (== a (list :s a-1)) (== c (list :s c-1)) (my-pluso a-1 b c-1))))
 (mk-test
  "defrel-pluso-2-3"
  (run*
    q
    (my-pluso (list :s (list :s :z)) (list :s (list :s (list :s :z))) q))
  (list (list :s (list :s (list :s (list :s (list :s :z)))))))
 (mk-tests-run!)
--- a/lib/minikanren/tests/enumerate.sx
+++ b/lib/minikanren/tests/enumerate.sx
@@ -1,31 +0,0 @@
 ;; lib/minikanren/tests/enumerate.sx — index-each-element relation.
 (mk-test
  "enumerate-i-empty"
  (run* q (enumerate-i (list) q))
  (list (list)))
 (mk-test
  "enumerate-i-three"
  (run* q (enumerate-i (list :a :b :c) q))
  (list
    (list (list 0 :a) (list 1 :b) (list 2 :c))))
 (mk-test
  "enumerate-i-strings"
  (run* q (enumerate-i (list "x" "y" "z") q))
  (list
    (list (list 0 "x") (list 1 "y") (list 2 "z"))))
 (mk-test
  "enumerate-from-i-100"
  (run* q (enumerate-from-i 100 (list :x :y :z) q))
  (list
    (list (list 100 :x) (list 101 :y) (list 102 :z))))
 (mk-test
  "enumerate-from-i-singleton"
  (run* q (enumerate-from-i 0 (list :only) q))
  (list (list (list 0 :only))))
 (mk-tests-run!)
--- a/lib/minikanren/tests/fd.sx
+++ b/lib/minikanren/tests/fd.sx
@@ -1,75 +0,0 @@
 ;; lib/minikanren/tests/fd.sx — Phase 6 piece A: ino + all-distincto.
 ;; --- ino ---
 (mk-test
  "ino-element-in-domain"
  (run* q (ino q (list 1 2 3)))
  (list 1 2 3))
 (mk-test "ino-empty-domain" (run* q (ino q (list))) (list))
 (mk-test
  "ino-singleton-domain"
  (run* q (ino q (list 42)))
  (list 42))
 ;; --- all-distincto ---
 (mk-test
  "all-distincto-empty"
  (run* q (all-distincto (list)))
  (list (make-symbol "_.0")))
 (mk-test
  "all-distincto-singleton"
  (run* q (all-distincto (list 1)))
  (list (make-symbol "_.0")))
 (mk-test
  "all-distincto-distinct-three"
  (run* q (all-distincto (list 1 2 3)))
  (list (make-symbol "_.0")))
 (mk-test
  "all-distincto-duplicate-fails"
  (run* q (all-distincto (list 1 2 1)))
  (list))
 (mk-test
  "all-distincto-adjacent-duplicate-fails"
  (run* q (all-distincto (list 1 1 2)))
  (list))
 ;; --- ino + all-distincto: classic enumerate-all-permutations ---
 (mk-test
  "fd-puzzle-three-distinct-from-domain"
  (let
    ((perms (run* q (fresh (a b c) (== q (list a b c)) (ino a (list 1 2 3)) (ino b (list 1 2 3)) (ino c (list 1 2 3)) (all-distincto (list a b c))))))
    (and
      (= (len perms) 6)
      (and
        (some (fn (p) (= p (list 1 2 3))) perms)
        (and
          (some
            (fn (p) (= p (list 1 3 2)))
            perms)
          (and
            (some
              (fn (p) (= p (list 2 1 3)))
              perms)
            (and
              (some
                (fn (p) (= p (list 2 3 1)))
                perms)
              (and
                (some
                  (fn (p) (= p (list 3 1 2)))
                  perms)
                (some
                  (fn (p) (= p (list 3 2 1)))
                  perms))))))))
  true)
 (mk-tests-run!)
--- a/lib/minikanren/tests/flat-mapo.sx
+++ b/lib/minikanren/tests/flat-mapo.sx
@@ -1,39 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/flatteno.sx
+++ b/lib/minikanren/tests/flatteno.sx
@@ -1,42 +0,0 @@
 (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!)
--- a/lib/minikanren/tests/foldl-o.sx
+++ b/lib/minikanren/tests/foldl-o.sx
@@ -1,48 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/foldr-o.sx
+++ b/lib/minikanren/tests/foldr-o.sx
@@ -1,38 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/fresh.sx
+++ b/lib/minikanren/tests/fresh.sx
@@ -1,101 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/goals.sx
+++ b/lib/minikanren/tests/goals.sx
@@ -1,260 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/graph.sx
+++ b/lib/minikanren/tests/graph.sx
@@ -1,70 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/intarith.sx
+++ b/lib/minikanren/tests/intarith.sx
@@ -1,103 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/iterate-no.sx
+++ b/lib/minikanren/tests/iterate-no.sx
@@ -1,38 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/lasto.sx
+++ b/lib/minikanren/tests/lasto.sx
@@ -1,38 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/latin.sx
+++ b/lib/minikanren/tests/latin.sx
@@ -1,61 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/laziness.sx
+++ b/lib/minikanren/tests/laziness.sx
@@ -1,77 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/lengtho-i.sx
+++ b/lib/minikanren/tests/lengtho-i.sx
@@ -1,28 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/list-relations.sx
+++ b/lib/minikanren/tests/list-relations.sx
@@ -1,126 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/mapo.sx
+++ b/lib/minikanren/tests/mapo.sx
@@ -1,62 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/matche.sx
+++ b/lib/minikanren/tests/matche.sx
@@ -1,138 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/minmax.sx
+++ b/lib/minikanren/tests/minmax.sx
@@ -1,49 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/nafc.sx
+++ b/lib/minikanren/tests/nafc.sx
@@ -1,50 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/not-membero.sx
+++ b/lib/minikanren/tests/not-membero.sx
@@ -1,29 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/nub-o.sx
+++ b/lib/minikanren/tests/nub-o.sx
@@ -1,31 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/pairlisto.sx
+++ b/lib/minikanren/tests/pairlisto.sx
@@ -1,41 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/palindromeo.sx
+++ b/lib/minikanren/tests/palindromeo.sx
@@ -1,44 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/parity.sx
+++ b/lib/minikanren/tests/parity.sx
@@ -1,58 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/partitiono.sx
+++ b/lib/minikanren/tests/partitiono.sx
@@ -1,75 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/path-cycle-free.sx
+++ b/lib/minikanren/tests/path-cycle-free.sx
@@ -1,40 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/peano.sx
+++ b/lib/minikanren/tests/peano.sx
@@ -1,119 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/predicates.sx
+++ b/lib/minikanren/tests/predicates.sx
@@ -1,87 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/prefix-suffix.sx
+++ b/lib/minikanren/tests/prefix-suffix.sx
@@ -1,76 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/project.sx
+++ b/lib/minikanren/tests/project.sx
@@ -1,60 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/pythag.sx
+++ b/lib/minikanren/tests/pythag.sx
@@ -1,36 +0,0 @@
 ;; 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!)
--- a/lib/minikanren/tests/queens-fd.sx
+++ b/lib/minikanren/tests/queens-fd.sx
@@ -1,97 +0,0 @@
 ;; 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!)
--- a/Show More
+++ b/Show More