briefing: push to origin/loops/erlang after each commit

2026-05-06 06:47:16 +00:00
355 changed files with 13549 additions and 91282 deletions
--- a/hosts/javascript/platform.py
+++ b/hosts/javascript/platform.py
--- a/hosts/javascript/run_tests.js
+++ b/hosts/javascript/run_tests.js
@@ -293,8 +293,6 @@ env["pop-suite"] = function() {
  return null;
 };
 env["test-allowed?"] = function(name) { return true; };
 // Load test framework
 const projectDir = path.join(__dirname, "..", "..");
 const specTests = path.join(projectDir, "spec", "tests");
@@ -343,20 +341,6 @@ if (fs.existsSync(swapPath)) {
  }
 }
 // Load spec library files (define-library modules imported by tests)
 for (const libFile of ["stdlib.sx", "signals.sx", "coroutines.sx"]) {
  const libPath = path.join(projectDir, "spec", libFile);
  if (fs.existsSync(libPath)) {
    const libSrc = fs.readFileSync(libPath, "utf8");
    const libExprs = Sx.parse(libSrc);
    for (const expr of libExprs) {
      try { Sx.eval(expr, env); } catch (e) {
        console.error(`Error loading spec/${libFile}: ${e.message}`);
      }
    }
  }
 }
 // Load tw system (needed by spec/tests/test-tw.sx)
 const twDir = path.join(projectDir, "shared", "sx", "templates");
 for (const twFile of ["tw-type.sx", "tw-layout.sx", "tw.sx"]) {
--- a/hosts/javascript/transpiler.sx
+++ b/hosts/javascript/transpiler.sx
--- a/hosts/ocaml/bin/bench_cek.ml
+++ b/hosts/ocaml/bin/bench_cek.ml
@@ -1,73 +0,0 @@
 (** CEK benchmark — measures throughput of the CEK evaluator on tight loops.
    Usage:
      dune exec bin/bench_cek.exe
      dune exec bin/bench_cek.exe -- 5      (5 runs each)
 *)
 open Sx_types
 open Sx_parser
 let parse_one s =
  let exprs = parse_all s in
  match exprs with
  | e :: _ -> e
  | [] -> failwith "empty parse"
 let parse_many s = parse_all s
 let bench_run name setup expr iters =
  let env = Sx_types.make_env () in
  (* Run setup forms in env *)
  List.iter (fun e -> ignore (Sx_ref.eval_expr e (Env env))) setup;
  let times = ref [] in
  for _ = 1 to iters do
    Gc.full_major ();
    let t0 = Unix.gettimeofday () in
    let _r = Sx_ref.eval_expr expr (Env env) in
    let t1 = Unix.gettimeofday () in
    times := (t1 -. t0) :: !times
  done;
  let sorted = List.sort compare !times in
  let median = List.nth sorted (iters / 2) in
  let min_t = List.nth sorted 0 in
  let max_t = List.nth sorted (iters - 1) in
  Printf.printf "  %-22s  min=%8.2fms  median=%8.2fms  max=%8.2fms\n%!"
    name (min_t *. 1000.0) (median *. 1000.0) (max_t *. 1000.0);
  median
 let () =
  let iters =
    if Array.length Sys.argv > 1
    then int_of_string Sys.argv.(1)
    else 5
  in
  Printf.printf "CEK benchmark (%d runs each, taking median)\n%!" iters;
  Printf.printf "==========================================\n%!";
  (* fib 18 — recursive function call benchmark, smallish *)
  let fib_setup = parse_many "(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))" in
  let fib_expr = parse_one "(fib 18)" in
  let _ = bench_run "fib(18)" fib_setup fib_expr iters in
  (* loop 5000 — tight let loop *)
  let loop_setup = parse_many "(define (loop n acc) (if (= n 0) acc (loop (- n 1) (+ acc 1))))" in
  let loop_expr = parse_one "(loop 5000 0)" in
  let _ = bench_run "loop(5000)" loop_setup loop_expr iters in
  (* map+square over 1000 elem list *)
  let map_setup = parse_many "(define (range-list n) (let loop ((i 0) (acc (list))) (if (= i n) acc (loop (+ i 1) (cons i acc))))) (define xs (range-list 1000))" in
  let map_expr = parse_one "(map (fn (x) (* x x)) xs)" in
  let _ = bench_run "map sq xs(1000)" map_setup map_expr iters in
  (* reduce + over 2000 elem list *)
  let red_setup = parse_many "(define (range-list n) (let loop ((i 0) (acc (list))) (if (= i n) acc (loop (+ i 1) (cons i acc))))) (define ys (range-list 2000))" in
  let red_expr = parse_one "(reduce + 0 ys)" in
  let _ = bench_run "reduce + ys(2000)" red_setup red_expr iters in
  (* let-heavy: many bindings + if *)
  let lh_setup = parse_many "(define (lh n) (let ((a 1) (b 2) (c 3) (d 4)) (if (= n 0) (+ a b c d) (lh (- n 1)))))" in
  let lh_expr = parse_one "(lh 2000)" in
  let _ = bench_run "let-heavy(2000)" lh_setup lh_expr iters in
  Printf.printf "\nDone.\n%!"
--- a/hosts/ocaml/bin/bench_inspect.ml
+++ b/hosts/ocaml/bin/bench_inspect.ml
@@ -1,46 +0,0 @@
 (* Benchmark inspect on representative SX values.
   Takes min of 9 runs of n iterations to dampen GC noise. *)
 open Sx_types
 let rec make_tree d =
  if d = 0 then String "leaf"
  else List [String "node"; make_tree (d - 1); make_tree (d - 1); make_tree (d - 1)]
 let bench_min label f n runs =
  let times = ref [] in
  for _ = 1 to runs do
    Gc.compact ();
    let t0 = Unix.gettimeofday () in
    for _ = 1 to n do ignore (f ()) done;
    let t1 = Unix.gettimeofday () in
    times := (t1 -. t0) :: !times
  done;
  let sorted = List.sort compare !times in
  let min_t = List.nth sorted 0 in
  let median = List.nth sorted (runs / 2) in
  Printf.printf "  %-30s  min=%6.2fms  median=%6.2fms  (n=%d * %d runs)\n%!"
    label (min_t *. 1000.0 /. float_of_int n)
    (median *. 1000.0 /. float_of_int n) n runs
 let () =
  let tree8 = make_tree 8 in
  let s = inspect tree8 in
  Printf.printf "tree-d8 inspect len=%d\n%!" (String.length s);
  bench_min "inspect tree-d8" (fun () -> inspect tree8) 50 9;
  let tree10 = make_tree 10 in
  let s = inspect tree10 in
  Printf.printf "tree-d10 inspect len=%d\n%!" (String.length s);
  bench_min "inspect tree-d10" (fun () -> inspect tree10) 5 9;
  let dict_xs = make_dict () in
  for i = 0 to 999 do
    Hashtbl.replace dict_xs (string_of_int i) (Integer i)
  done;
  let d = Dict dict_xs in
  bench_min "inspect dict-1000" (fun () -> inspect d) 100 9;
  let xs = ref [] in
  for i = 0 to 1999 do xs := Integer i :: !xs done;
  let lst = List !xs in
  bench_min "inspect list-2000" (fun () -> inspect lst) 200 9
--- a/hosts/ocaml/bin/bench_vm.ml
+++ b/hosts/ocaml/bin/bench_vm.ml
@@ -1,155 +0,0 @@
 (** VM bytecode benchmark — measures throughput of the VM (compiled bytecode).
    Loads the SX compiler via CEK, then for each test:
      1. Define the function via CEK (as a Lambda).
      2. Trigger JIT compilation via Sx_vm.jit_compile_lambda.
      3. Call the compiled VmClosure repeatedly via Sx_vm.call_closure.
    This measures pure VM execution time on the JIT path. *)
 open Sx_types
 let load_compiler env globals =
  let compiler_path =
    if Sys.file_exists "lib/compiler.sx" then "lib/compiler.sx"
    else if Sys.file_exists "../../lib/compiler.sx" then "../../lib/compiler.sx"
    else if Sys.file_exists "../../../lib/compiler.sx" then "../../../lib/compiler.sx"
    else failwith "compiler.sx not found"
  in
  let ic = open_in compiler_path in
  let src = really_input_string ic (in_channel_length ic) in
  close_in ic;
  let exprs = Sx_parser.parse_all src in
  List.iter (fun e -> ignore (Sx_ref.eval_expr e (Env env))) exprs;
  let rec sync e =
    Hashtbl.iter (fun id v ->
      let name = Sx_types.unintern id in
      Hashtbl.replace globals name v) e.bindings;
    match e.parent with Some p -> sync p | None -> ()
  in
  sync env
 let _make_globals env =
  let g = Hashtbl.create 512 in
  Hashtbl.iter (fun name fn ->
    Hashtbl.replace g name (NativeFn (name, fn))
  ) Sx_primitives.primitives;
  let rec sync e =
    Hashtbl.iter (fun id v ->
      let name = Sx_types.unintern id in
      if not (Hashtbl.mem g name) then Hashtbl.replace g name v) e.bindings;
    match e.parent with Some p -> sync p | None -> ()
  in
  sync env;
  g
 let define_fn env globals name params body_src =
  (* Define via CEK so we get a Lambda value with proper closure. *)
  let body_expr = match Sx_parser.parse_all body_src with
    | [e] -> e
    | _ -> failwith "expected one body expression"
  in
  let param_syms = List (List.map (fun p -> Symbol p) params) in
  let define_expr = List [Symbol "define"; Symbol name; List [Symbol "fn"; param_syms; body_expr]] in
  ignore (Sx_ref.eval_expr define_expr (Env env));
  (* Sync env to globals so JIT can resolve free vars. *)
  let rec sync e =
    Hashtbl.iter (fun id v ->
      let n = Sx_types.unintern id in
      Hashtbl.replace globals n v) e.bindings;
    match e.parent with Some p -> sync p | None -> ()
  in
  sync env;
  (* Now find the Lambda and JIT-compile it. *)
  let lam_val = Hashtbl.find globals name in
  match lam_val with
  | Lambda l ->
    (match Sx_vm.jit_compile_lambda l globals with
     | Some cl ->
       l.l_compiled <- Some cl;
       Hashtbl.replace globals name (NativeFn (name, fun args ->
         Sx_vm.call_closure cl args globals));
       cl
     | None ->
       failwith (Printf.sprintf "JIT failed for %s" name))
  | _ -> failwith (Printf.sprintf "%s is not a Lambda after define" name)
 let bench_call name cl globals args iters =
  let times = ref [] in
  for _ = 1 to iters do
    Gc.full_major ();
    let t0 = Unix.gettimeofday () in
    let _r = Sx_vm.call_closure cl args globals in
    let t1 = Unix.gettimeofday () in
    times := (t1 -. t0) :: !times
  done;
  let sorted = List.sort compare !times in
  let median = List.nth sorted (iters / 2) in
  let min_t = List.nth sorted 0 in
  let max_t = List.nth sorted (iters - 1) in
  Printf.printf "  %-22s  min=%8.2fms  median=%8.2fms  max=%8.2fms\n%!"
    name (min_t *. 1000.0) (median *. 1000.0) (max_t *. 1000.0);
  median
 let () =
  let iters =
    if Array.length Sys.argv > 1
    then int_of_string Sys.argv.(1)
    else 7
  in
  Printf.printf "VM (bytecode/JIT) benchmark (%d runs each, taking median)\n%!" iters;
  Printf.printf "========================================================\n%!";
  let env = Sx_types.make_env () in
  let bind n fn = ignore (Sx_types.env_bind env n (NativeFn (n, fn))) in
  (* Seed env with primitives as NativeFn so CEK lookups work. *)
  Hashtbl.iter (fun name fn ->
    Hashtbl.replace env.bindings (Sx_types.intern name) (NativeFn (name, fn))
  ) Sx_primitives.primitives;
  (* Helpers the SX compiler relies on but aren't kernel primitives. *)
  bind "symbol-name" (fun args -> match args with
    | [Symbol s] -> String s | _ -> raise (Eval_error "symbol-name"));
  bind "keyword-name" (fun args -> match args with
    | [Keyword k] -> String k | _ -> raise (Eval_error "keyword-name"));
  bind "make-symbol" (fun args -> match args with
    | [String s] -> Symbol s
    | [v] -> Symbol (Sx_types.value_to_string v)
    | _ -> raise (Eval_error "make-symbol"));
  bind "sx-serialize" (fun args -> match args with
    | [v] -> String (Sx_types.inspect v)
    | _ -> raise (Eval_error "sx-serialize"));
  let globals = Hashtbl.create 1024 in
  Hashtbl.iter (fun name fn ->
    Hashtbl.replace globals name (NativeFn (name, fn))
  ) Sx_primitives.primitives;
  Printf.printf "Loading compiler.sx ... %!";
  let t0 = Unix.gettimeofday () in
  load_compiler env globals;
  Printf.printf "%.0fms\n%!" ((Unix.gettimeofday () -. t0) *. 1000.0);
  (* fib(22) — recursive call benchmark *)
  let fib_cl = define_fn env globals "fib" ["n"]
    "(if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))" in
  let _ = bench_call "fib(22)" fib_cl globals [Number 22.0] iters in
  (* tight loop *)
  let loop_cl = define_fn env globals "loop" ["n"; "acc"]
    "(if (= n 0) acc (loop (- n 1) (+ acc 1)))" in
  let _ = bench_call "loop(200000)" loop_cl globals [Number 200000.0; Number 0.0] iters in
  (* sum-to *)
  let sum_cl = define_fn env globals "sum_to" ["n"; "acc"]
    "(if (= n 0) acc (sum_to (- n 1) (+ acc n)))" in
  let _ = bench_call "sum-to(50000)" sum_cl globals [Number 50000.0; Number 0.0] iters in
  (* count-lt: comparison-heavy *)
  let cnt_cl = define_fn env globals "count_lt" ["n"; "acc"]
    "(if (= n 0) acc (count_lt (- n 1) (if (< n 10000) (+ acc 1) acc)))" in
  let _ = bench_call "count-lt(20000)" cnt_cl globals [Number 20000.0; Number 0.0] iters in
  (* count-eq: equality-heavy on multiples of 7 *)
  let eq_cl = define_fn env globals "count_eq" ["n"; "acc"]
    "(if (= n 0) acc (count_eq (- n 1) (if (= 0 (- n (* 7 (/ n 7)))) (+ acc 1) acc)))" in
  let _ = bench_call "count-eq(20000)" eq_cl globals [Number 20000.0; Number 0.0] iters in
  Printf.printf "\nDone.\n%!"
--- a/hosts/ocaml/bin/dune
+++ b/hosts/ocaml/bin/dune
@@ -1,5 +1,5 @@
 (executables
- (names run_tests debug_set sx_server integration_tests bench_cek bench_inspect bench_vm)
+ (names run_tests debug_set sx_server integration_tests)
 (libraries sx unix threads.posix otfm yojson))
 (executable
--- a/hosts/ocaml/bin/mcp_tree.ml
+++ b/hosts/ocaml/bin/mcp_tree.ml
@@ -1892,34 +1892,8 @@ let handle_sx_harness_eval args =
    let file = args |> member "file" |> to_string_option in
    let setup_str = args |> member "setup" |> to_string_option in
    let files_json = try args |> member "files" with _ -> `Null in
    let host_stubs = match args |> member "host_stubs" with `Bool b -> b | _ -> false in
    let e = !env in
    let warnings = ref [] in
    (* Inject stub host primitives so files using host-get/host-new/etc. can load *)
    if host_stubs then begin
      let stubs = {|
        (define host-global (fn (&rest _) nil))
        (define host-get (fn (&rest _) nil))
        (define host-set! (fn (obj k v) v))
        (define host-call (fn (&rest _) nil))
        (define host-new (fn (&rest _) (dict)))
        (define host-callback (fn (f) f))
        (define host-typeof (fn (&rest _) "string"))
        (define hs-ref-eq (fn (a b) (identical? a b)))
        (define host-call-fn (fn (&rest _) nil))
        (define host-iter? (fn (&rest _) false))
        (define host-to-list (fn (&rest _) (list)))
        (define host-await (fn (&rest _) nil))
        (define host-new-function (fn (&rest _) nil))
        (define load-library! (fn (&rest _) false))
      |} in
      let stub_exprs = Sx_parser.parse_all stubs in
      List.iter (fun expr ->
        try ignore (Sx_ref.eval_expr expr (Env e))
        with exn ->
          warnings := Printf.sprintf "Stub warning: %s" (Printexc.to_string exn) :: !warnings
      ) stub_exprs
    end;
    (* Collect all files to load *)
    let all_files = match files_json with
      | `List items ->
@@ -3044,8 +3018,7 @@ let tool_definitions = `List [
     ("mock", `Assoc [("type", `String "string"); ("description", `String "Optional mock platform overrides as SX dict, e.g. {:fetch (fn (url) {:status 200})}")]);
     ("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load for definitions")]);
     ("files", `Assoc [("type", `String "array"); ("items", `Assoc [("type", `String "string")]); ("description", `String "Multiple .sx files to load in order")]);
-     ("setup", `Assoc [("type", `String "string"); ("description", `String "SX setup expression to run before main evaluation")]);
+     ("setup", `Assoc [("type", `String "string"); ("description", `String "SX setup expression to run before main evaluation")])]
     ("host_stubs", `Assoc [("type", `String "boolean"); ("description", `String "If true, inject nil-returning stubs for host-get/host-set!/host-call/host-new/etc. so files that use host primitives can load in the harness")])]
    ["expr"];
  tool "sx_nav" "Manage sx-docs navigation and articles. Modes: list (all nav items with status), check (validate consistency), add (create article + nav entry), delete (remove nav entry + page fn), move (move entry between sections, rewriting hrefs)."
    [("mode", `Assoc [("type", `String "string"); ("description", `String "Mode: list, check, add, delete, or move")]);
--- a/hosts/ocaml/bin/run_tests.ml
+++ b/hosts/ocaml/bin/run_tests.ml
@@ -37,10 +37,7 @@ let rec deep_equal a b =
  match a, b with
  | Nil, Nil -> true
  | Bool a, Bool b -> a = b
  | Integer a, Integer b -> a = b
  | Number a, Number b -> a = b
  | Integer a, Number b -> float_of_int a = b
  | Number a, Integer b -> a = float_of_int b
  | String a, String b -> a = b
  | Symbol a, Symbol b -> a = b
  | Keyword a, Keyword b -> a = b
@@ -229,7 +226,7 @@ let make_test_env () =
    | [String s] ->
      let parsed = Sx_parser.parse_all s in
      (match parsed with
-       | [List (Symbol "sxbc" :: (Number _ | Integer _) :: payload :: _)] -> payload
+       | [List (Symbol "sxbc" :: Number _ :: payload :: _)] -> payload
       | _ -> raise (Eval_error "bytecode-deserialize: invalid sxbc format"))
    | _ -> raise (Eval_error "bytecode-deserialize: expected string"));
@@ -243,7 +240,7 @@ let make_test_env () =
    | [String s] ->
      let parsed = Sx_parser.parse_all s in
      (match parsed with
-       | [List (Symbol "cek-state" :: (Number _ | Integer _) :: payload :: _)] -> payload
+       | [List (Symbol "cek-state" :: Number _ :: payload :: _)] -> payload
       | _ -> raise (Eval_error "cek-deserialize: invalid cek-state format"))
    | _ -> raise (Eval_error "cek-deserialize: expected string"));
@@ -323,10 +320,7 @@ let make_test_env () =
  bind "identical?" (fun args ->
    match args with
    | [a; b] -> Bool (match a, b with
      | Integer x, Integer y -> x = y
      | Number x, Number y -> x = y
      | Integer x, Number y -> float_of_int x = y
      | Number x, Integer y -> x = float_of_int y
      | String x, String y -> x = y
      | Bool x, Bool y -> x = y
      | Nil, Nil -> true
@@ -372,15 +366,11 @@ let make_test_env () =
  bind "append!" (fun args ->
    match args with
-    | [ListRef r; v; (Number n)] when int_of_float n = 0 ->
+    | [ListRef r; v; Number n] when int_of_float n = 0 ->
      r := v :: !r; ListRef r  (* prepend *)
    | [ListRef r; v; (Integer 0)] ->
      r := v :: !r; ListRef r  (* prepend Integer index *)
    | [ListRef r; v] -> r := !r @ [v]; ListRef r  (* append in place *)
-    | [List items; v; (Number n)] when int_of_float n = 0 ->
+    | [List items; v; Number n] when int_of_float n = 0 ->
      List (v :: items)  (* immutable prepend *)
    | [List items; v; (Integer 0)] ->
      List (v :: items)  (* immutable prepend Integer index *)
    | [List items; v] -> List (items @ [v])  (* immutable fallback *)
    | _ -> raise (Eval_error "append!: expected list and value"));
@@ -556,10 +546,7 @@ let make_test_env () =
  bind "batch-begin!" (fun _args -> Sx_ref.batch_begin_b ());
  bind "batch-end!" (fun _args -> Sx_ref.batch_end_b ());
  bind "now-ms" (fun _args -> Number 1000.0);
-  bind "random-int" (fun args -> match args with
+  bind "random-int" (fun args -> match args with [Number lo; _] -> Number lo | _ -> Number 0.0);
    | [Number lo; _] -> Number lo
    | [Integer lo; _] -> Integer lo
    | _ -> Integer 0);
  bind "try-rerender-page" (fun _args -> Nil);
  bind "collect!" (fun args ->
    match args with
@@ -1120,47 +1107,6 @@ let make_test_env () =
    | _ :: _ -> String "confirmed"
    | _ -> Nil);
  bind "values" (fun args ->
    match args with
    | [v] -> v
    | vs ->
      let d = Hashtbl.create 2 in
      Hashtbl.replace d "_values" (Bool true);
      Hashtbl.replace d "_list" (List vs);
      Dict d);
  bind "call-with-values" (fun args ->
    match args with
    | [producer; consumer] ->
      let result = Sx_ref.cek_call producer (List []) in
      let spread = (match result with
        | Dict d when (match Hashtbl.find_opt d "_values" with Some (Bool true) -> true | _ -> false) ->
          (match Hashtbl.find_opt d "_list" with Some (List l) -> l | _ -> [result])
        | _ -> [result])
      in
      Sx_ref.cek_call consumer (List spread)
    | _ -> raise (Eval_error "call-with-values: expected 2 args"));
  bind "promise?" (fun args ->
    match args with
    | [v] -> Bool (Sx_ref.is_promise v)
    | _ -> Bool false);
  bind "make-promise" (fun args ->
    match args with
    | [v] ->
      let d = Hashtbl.create 4 in
      Hashtbl.replace d "_promise" (Bool true);
      Hashtbl.replace d "forced" (Bool true);
      Hashtbl.replace d "value" v;
      Dict d
    | _ -> Nil);
  bind "force" (fun args ->
    match args with
    | [p] -> Sx_ref.force_promise p
    | _ -> Nil);
  env
 (* ====================================================================== *)
@@ -1196,20 +1142,18 @@ let run_foundation_tests () =
  in
  Printf.printf "Suite: parser\n";
-  assert_eq "number" (Integer 42) (List.hd (parse_all "42"));
+  assert_eq "number" (Number 42.0) (List.hd (parse_all "42"));
  assert_eq "string" (String "hello") (List.hd (parse_all "\"hello\""));
  assert_eq "bool true" (Bool true) (List.hd (parse_all "true"));
  assert_eq "nil" Nil (List.hd (parse_all "nil"));
  assert_eq "keyword" (Keyword "class") (List.hd (parse_all ":class"));
  assert_eq "symbol" (Symbol "foo") (List.hd (parse_all "foo"));
-  assert_eq "list" (List [Symbol "+"; Integer 1; Integer 2]) (List.hd (parse_all "(+ 1 2)"));
+  assert_eq "list" (List [Symbol "+"; Number 1.0; Number 2.0]) (List.hd (parse_all "(+ 1 2)"));
  (match List.hd (parse_all "(div :class \"card\" (p \"hi\"))") with
   | List [Symbol "div"; Keyword "class"; String "card"; List [Symbol "p"; String "hi"]] ->
     incr pass_count; Printf.printf "  PASS: nested list\n"
   | v -> incr fail_count; Printf.printf "  FAIL: nested list — got %s\n" (Sx_types.inspect v));
  (match List.hd (parse_all "'(1 2 3)") with
   | List [Symbol "quote"; List [Integer 1; Integer 2; Integer 3]] ->
     incr pass_count; Printf.printf "  PASS: quote sugar\n"
   | List [Symbol "quote"; List [Number 1.0; Number 2.0; Number 3.0]] ->
     incr pass_count; Printf.printf "  PASS: quote sugar\n"
   | v -> incr fail_count; Printf.printf "  FAIL: quote sugar — got %s\n" (Sx_types.inspect v));
@@ -1217,7 +1161,7 @@ let run_foundation_tests () =
   | Dict d when dict_has d "a" && dict_has d "b" ->
     incr pass_count; Printf.printf "  PASS: dict literal\n"
   | v -> incr fail_count; Printf.printf "  FAIL: dict literal — got %s\n" (Sx_types.inspect v));
-  assert_eq "comment" (Integer 42) (List.hd (parse_all ";; comment\n42"));
+  assert_eq "comment" (Number 42.0) (List.hd (parse_all ";; comment\n42"));
  assert_eq "string escape" (String "hello\nworld") (List.hd (parse_all "\"hello\\nworld\""));
  assert_eq "multiple exprs" (Number 2.0) (Number (float_of_int (List.length (parse_all "(1 2 3) (4 5)"))));
@@ -2034,10 +1978,6 @@ let run_spec_tests env test_files =
      (match Hashtbl.find_opt d "children" with
       | Some (List l) when i >= 0 && i < List.length l -> List.nth l i
       | _ -> (match Hashtbl.find_opt d (string_of_int i) with Some v -> v | None -> Nil))
    | [Dict d; Integer n] ->
      (match Hashtbl.find_opt d "children" with
       | Some (List l) when n >= 0 && n < List.length l -> List.nth l n
       | _ -> (match Hashtbl.find_opt d (string_of_int n) with Some v -> v | None -> Nil))
    | _ -> Nil);
  (* Stringify a value for DOM string properties *)
@@ -2112,8 +2052,8 @@ let run_spec_tests env test_files =
         Hashtbl.replace d "childNodes" (List [])
       | _ -> ());
      stored
-    | [ListRef r; idx_v; value] when (match idx_v with Number _ | Integer _ -> true | _ -> false) ->
+    | [ListRef r; Number n; value] ->
-      let idx = match idx_v with Number n -> int_of_float n | Integer n -> n | _ -> 0 in
+      let idx = int_of_float n in
      let lst = !r in
      if idx >= 0 && idx < List.length lst then
        r := List.mapi (fun i v -> if i = idx then value else v) lst
@@ -2250,7 +2190,7 @@ let run_spec_tests env test_files =
            | [String name; value] ->
              let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ ->
                let a = Hashtbl.create 4 in Hashtbl.replace d "attributes" (Dict a); a in
-              let sv = match value with String s -> s | Integer n -> string_of_int n | Number n ->
+              let sv = match value with String s -> s | Number n ->
                let i = int_of_float n in if float_of_int i = n then string_of_int i
                else string_of_float n | _ -> Sx_types.inspect value in
              Hashtbl.replace attrs name (String sv);
@@ -2692,7 +2632,6 @@ let run_spec_tests env test_files =
  let rec json_of_value = function
    | Nil -> `Null
    | Bool b -> `Bool b
    | Integer n -> `Int n
    | Number n ->
      if Float.is_integer n && Float.abs n < 1e16
      then `Int (int_of_float n) else `Float n
@@ -2708,8 +2647,8 @@ let run_spec_tests env test_files =
  let rec value_of_json = function
    | `Null -> Nil
    | `Bool b -> Bool b
-    | `Int i -> Integer i
+    | `Int i -> Number (float_of_int i)
-    | `Intlit s -> (try Integer (int_of_string s) with _ -> try Number (float_of_string s) with _ -> String s)
+    | `Intlit s -> (try Number (float_of_string s) with _ -> String s)
    | `Float f -> Number f
    | `String s -> String s
    | `List xs -> List (List.map value_of_json xs)
@@ -2872,7 +2811,6 @@ let run_spec_tests env test_files =
      match sx_vm_execute with
      | Some fn -> Sx_ref.cek_call fn (List args)
      | None -> Nil)));
  load_module "stdlib.sx" spec_dir;   (* pure SX stdlib: format etc. *)
  load_module "signals.sx" spec_dir;  (* core reactive primitives *)
  load_module "signals.sx" web_dir;   (* web extensions *)
  load_module "freeze.sx" lib_dir;
@@ -2899,9 +2837,6 @@ let run_spec_tests env test_files =
  load_module "parser.sx" hs_dir;
  load_module "compiler.sx" hs_dir;
  load_module "runtime.sx" hs_dir;
  let hs_plugins_dir = Filename.concat hs_dir "plugins" in
  load_module "worker.sx" hs_plugins_dir;
  load_module "prolog.sx" hs_plugins_dir;
  load_module "integration.sx" hs_dir;
  load_module "htmx.sx" hs_dir;
  (* Override console-log to avoid str on circular mock DOM refs *)
--- a/hosts/ocaml/bin/sx_server.ml
+++ b/hosts/ocaml/bin/sx_server.ml
@@ -296,10 +296,6 @@ let read_blob () =
      (* consume trailing newline *)
      (try ignore (input_line stdin) with End_of_file -> ());
      data
    | [List [Symbol "blob"; Integer n]] ->
      let data = read_exact_bytes n in
      (try ignore (input_line stdin) with End_of_file -> ());
      data
    | _ -> raise (Eval_error ("read_blob: expected (blob N), got: " ^ line))
 (** Batch IO mode — collect requests during aser-slot, resolve after. *)
@@ -361,11 +357,6 @@ let rec read_io_response () =
    | [List (Symbol "io-response" :: Number n :: values)]
      when int_of_float n = !current_epoch ->
      (match values with [v] -> v | _ -> List values)
    | [List [Symbol "io-response"; Integer n; value]]
      when n = !current_epoch -> value
    | [List (Symbol "io-response" :: Integer n :: values)]
      when n = !current_epoch ->
      (match values with [v] -> v | _ -> List values)
    (* Legacy untagged: (io-response value) — accept for backwards compat *)
    | [List [Symbol "io-response"; value]] -> value
    | [List (Symbol "io-response" :: values)] ->
@@ -405,12 +396,6 @@ let read_batched_io_response () =
        when int_of_float n = !current_epoch -> s
      | [List [Symbol "io-response"; Number n; v]]
        when int_of_float n = !current_epoch -> serialize_value v
      | [List [Symbol "io-response"; Integer n; String s]]
        when n = !current_epoch -> s
      | [List [Symbol "io-response"; Integer n; SxExpr s]]
        when n = !current_epoch -> s
      | [List [Symbol "io-response"; Integer n; v]]
        when n = !current_epoch -> serialize_value v
      (* Legacy untagged *)
      | [List [Symbol "io-response"; String s]]
      | [List [Symbol "io-response"; SxExpr s]] -> s
@@ -703,11 +688,6 @@ let setup_evaluator_bridge env =
    | [expr; e] -> Sx_ref.eval_expr expr (Env (Sx_runtime.unwrap_env e))
    | [expr] -> Sx_ref.eval_expr expr (Env env)
    | _ -> raise (Eval_error "eval-expr: expected (expr env?)"));
  (* eval-in-env: (env expr) → result.  Evaluates expr in the given env. *)
  Sx_primitives.register "eval-in-env" (fun args ->
    match args with
    | [e; expr] -> Sx_ref.eval_expr expr e
    | _ -> raise (Eval_error "eval-in-env: (env expr)"));
  bind "trampoline" (fun args ->
    match args with
    | [v] ->
@@ -769,13 +749,7 @@ let setup_evaluator_bridge env =
    | _ -> raise (Eval_error "register-special-form!: expected (name handler)"));
  ignore (env_bind env "*custom-special-forms*" Sx_ref.custom_special_forms);
  ignore (Sx_ref.register_special_form (String "<>") (NativeFn ("<>", fun args ->
-    List (List.map (fun a -> Sx_ref.eval_expr a (Env env)) args))));
+    List (List.map (fun a -> Sx_ref.eval_expr a (Env env)) args))))
  (* current-env: special form — returns current lexical env as a first-class value *)
  ignore (Sx_ref.register_special_form (String "current-env")
    (NativeFn ("current-env", fun args ->
      match args with
      | [_arg_list; env_val] -> env_val
      | _ -> Nil)))
 (* ---- Type predicates and introspection ---- *)
 let setup_introspection env =
@@ -961,24 +935,7 @@ let setup_env_operations env =
  bind "env-has?" (fun args -> match args with [e; String k] -> Bool (Sx_types.env_has (uw e) k) | [e; Keyword k] -> Bool (Sx_types.env_has (uw e) k) | _ -> raise (Eval_error "env-has?: expected env and string"));
  bind "env-bind!" (fun args -> match args with [e; String k; v] -> Sx_types.env_bind (uw e) k v | [e; Keyword k; v] -> Sx_types.env_bind (uw e) k v | _ -> raise (Eval_error "env-bind!: expected env, key, value"));
  bind "env-set!" (fun args -> match args with [e; String k; v] -> Sx_types.env_set (uw e) k v | [e; Keyword k; v] -> Sx_types.env_set (uw e) k v | _ -> raise (Eval_error "env-set!: expected env, key, value"));
-  bind "env-extend" (fun args ->
+  bind "env-extend" (fun args -> match args with [e] -> Env (Sx_types.env_extend (uw e)) | _ -> raise (Eval_error "env-extend: expected env"));
    match args with
    | e :: pairs ->
      let child = Sx_types.env_extend (uw e) in
      let rec go = function
        | [] -> ()
        | k :: v :: rest ->
          ignore (Sx_types.env_bind child (Sx_runtime.value_to_str k) v); go rest
        | [_] -> raise (Eval_error "env-extend: odd number of key-val pairs") in
      go pairs; Env child
    | _ -> raise (Eval_error "env-extend: expected env"));
  bind "env-lookup" (fun args ->
    match args with
    | [e; key] ->
      let k = Sx_runtime.value_to_str key in
      let raw = uw e in
      if Sx_types.env_has raw k then Sx_types.env_get raw k else Nil
    | _ -> raise (Eval_error "env-lookup: (env key)"));
  bind "env-merge" (fun args -> match args with [a; b] -> Sx_runtime.env_merge a b | _ -> raise (Eval_error "env-merge: expected 2 envs"))
 (* ---- Strict mode (gradual type system support) ---- *)
@@ -1002,7 +959,6 @@ let setup_io_bridges env =
  bind "sleep" (fun args -> io_request "sleep" args);
  bind "set-response-status" (fun args -> match args with
    | [Number n] -> _pending_response_status := int_of_float n; Nil
    | [Integer n] -> _pending_response_status := n; Nil
    | _ -> Nil);
  bind "set-response-header" (fun args -> io_request "set-response-header" args)
@@ -1405,7 +1361,6 @@ let rec dispatch env cmd =
        | Bool true -> "true"
        | Bool false -> "false"
        | Number n -> Sx_types.format_number n
        | Integer n -> string_of_int n
        | String s -> "\"" ^ escape_sx_string s ^ "\""
        | Symbol s -> s
        | Keyword k -> ":" ^ k
@@ -1419,10 +1374,6 @@ let rec dispatch env cmd =
        | Island i -> "~" ^ i.i_name
        | SxExpr s -> s
        | RawHTML s -> "\"" ^ escape_sx_string s ^ "\""
        | Char n -> Sx_types.inspect (Char n)
        | Eof -> Sx_types.inspect Eof
        | Port _ -> Sx_types.inspect result
        | Rational (n, d) -> Printf.sprintf "%d/%d" n d
        | _ -> "nil"
      in
      send_ok_raw (raw_serialize result)
@@ -4499,8 +4450,6 @@ let site_mode () =
          match exprs with
          | [List [Symbol "epoch"; Number n]] ->
            current_epoch := int_of_float n
          | [List [Symbol "epoch"; Integer n]] ->
            current_epoch := n
          (* render-page: full SSR pipeline — URL → complete HTML *)
          | [List [Symbol "render-page"; String path]] ->
            (try match http_render_page env path [] with
@@ -4558,8 +4507,6 @@ let () =
            (* Epoch marker: (epoch N) — set current epoch, read next command *)
            | [List [Symbol "epoch"; Number n]] ->
              current_epoch := int_of_float n
            | [List [Symbol "epoch"; Integer n]] ->
              current_epoch := n
            | [cmd] -> dispatch env cmd
            | _ -> send_error ("Expected single command, got " ^ string_of_int (List.length exprs))
          end
--- a/hosts/ocaml/bootstrap.py
+++ b/hosts/ocaml/bootstrap.py
@@ -47,9 +47,7 @@ open Sx_runtime
 let trampoline_fn : (value -> value) ref = ref (fun v -> v)
 let trampoline v = !trampoline_fn v
-(* Step limit for timeout detection — set to 0 to disable *)
+
 let step_limit : int ref = ref 0
 let step_count : int ref = ref 0
 (* === Mutable globals — backing refs for transpiler's !_ref / _ref := === *)
 let _strict_ref = ref (Bool false)
@@ -128,90 +126,6 @@ let enhance_error_with_trace msg =
  _last_error_kont_ref := Nil;
  msg ^ (format_comp_trace trace)
 (* Hand-written sf_define_type — skipped from transpile because the spec uses
   &rest params and empty-dict literals that the transpiler can't emit cleanly.
   Implements: (define-type Name (Ctor1 f1 f2) (Ctor2 f3) ...)
   Creates constructor fns, Name?/Ctor? predicates, Ctor-field accessors,
   and records ctors in *adt-registry*. *)
 let sf_define_type args env_val =
  let items = (match args with List l -> l | _ -> []) in
  let type_sym = List.nth items 0 in
  let type_name = value_to_string type_sym in
  let ctor_specs = List.tl items in
  let env_has_v k = sx_truthy (env_has env_val (String k)) in
  let env_bind_v k v = ignore (env_bind env_val (String k) v) in
  let env_get_v k = env_get env_val (String k) in
  if not (env_has_v "*adt-registry*") then
    env_bind_v "*adt-registry*" (Dict (Hashtbl.create 8));
  let registry = env_get_v "*adt-registry*" in
  let ctor_names = List.map (fun spec ->
    (match spec with List (sym :: _) -> String (value_to_string sym) | _ -> Nil)
  ) ctor_specs in
  (match registry with Dict d -> Hashtbl.replace d type_name (List ctor_names) | _ -> ());
  env_bind_v (type_name ^ "?")
    (NativeFn (type_name ^ "?", fun pargs ->
      (match pargs with
      | [v] ->
        (match v with
        | Dict d -> Bool (Hashtbl.mem d "_adt" &&
          (match Hashtbl.find_opt d "_type" with Some (String t) -> t = type_name | _ -> false))
        | _ -> Bool false)
      | _ -> Bool false)));
  List.iter (fun spec ->
    (match spec with
    | List (sym :: fields) ->
      let cn = value_to_string sym in
      let field_names = List.map value_to_string fields in
      let arity = List.length fields in
      env_bind_v cn
        (NativeFn (cn, fun ctor_args ->
          if List.length ctor_args <> arity then
            raise (Eval_error (Printf.sprintf "%s: expected %d args, got %d"
              cn arity (List.length ctor_args)))
          else begin
            let d = Hashtbl.create 4 in
            Hashtbl.replace d "_adt"    (Bool true);
            Hashtbl.replace d "_type"   (String type_name);
            Hashtbl.replace d "_ctor"   (String cn);
            Hashtbl.replace d "_fields" (List ctor_args);
            Dict d
          end));
      env_bind_v (cn ^ "?")
        (NativeFn (cn ^ "?", fun pargs ->
          (match pargs with
          | [v] ->
            (match v with
            | Dict d -> Bool (Hashtbl.mem d "_adt" &&
              (match Hashtbl.find_opt d "_ctor" with Some (String c) -> c = cn | _ -> false))
            | _ -> Bool false)
          | _ -> Bool false)));
      List.iteri (fun idx fname ->
        env_bind_v (cn ^ "-" ^ fname)
          (NativeFn (cn ^ "-" ^ fname, fun pargs ->
            (match pargs with
            | [v] ->
              (match v with
              | Dict d ->
                (match Hashtbl.find_opt d "_fields" with
                | Some (List fs) ->
                  if idx < List.length fs then List.nth fs idx
                  else raise (Eval_error (cn ^ "-" ^ fname ^ ": index out of bounds"))
                | _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not an ADT")))
              | _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not a dict")))
            | _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": expected 1 arg")))))
      ) field_names
    | _ -> ())
  ) ctor_specs;
  Nil
 (* Register define-type via custom_special_forms so the CEK dispatch finds it.
   The top-level (register-special-form! ...) in spec/evaluator.sx is not a
   define and therefore is not transpiled; we wire it up here instead. *)
 let () = ignore (register_special_form (String "define-type")
  (NativeFn ("define-type", fun call_args ->
    match call_args with
    | [args; env] -> sf_define_type args env
    | _ -> Nil)))
 """
@@ -257,10 +171,7 @@ def compile_spec_to_ml(spec_dir: str | None = None) -> str:
                "debug-log", "debug_log", "range", "chunk-every", "zip-pairs",
                "string-contains?", "starts-with?", "ends-with?",
                "string-replace", "trim", "split", "index-of",
-                "pad-left", "pad-right", "char-at", "substring",
+                "pad-left", "pad-right", "char-at", "substring"}
                # sf-define-type uses &rest + empty-dict literals that the transpiler
                # can't emit as valid OCaml; hand-written implementation in FIXUPS.
                "sf-define-type"}
        defines = [(n, e) for n, e in defines if n not in skip]
        # Deduplicate — keep last definition for each name (CEK overrides tree-walk)
--- a/hosts/ocaml/browser/bundle.sh
+++ b/hosts/ocaml/browser/bundle.sh
@@ -75,9 +75,6 @@ cp "$ROOT/shared/sx/templates/tw.sx"        "$DIST/sx/"
 for f in tokenizer parser compiler runtime integration htmx; do
  cp "$ROOT/lib/hyperscript/$f.sx" "$DIST/sx/hs-$f.sx"
 done
 for f in worker prolog; do
  cp "$ROOT/lib/hyperscript/plugins/$f.sx" "$DIST/sx/hs-$f.sx"
 done
 # Summary
 WASM_SIZE=$(du -sh "$DIST/sx_browser.bc.wasm.assets" | cut -f1)
--- a/hosts/ocaml/browser/compile-modules.js
+++ b/hosts/ocaml/browser/compile-modules.js
@@ -85,7 +85,6 @@ const FILES = [
  'harness-web.sx', 'engine.sx', 'orchestration.sx',
  // Hyperscript modules — loaded on demand via transparent lazy loader
  'hs-tokenizer.sx', 'hs-parser.sx', 'hs-compiler.sx', 'hs-runtime.sx',
  'hs-worker.sx', 'hs-prolog.sx',
  'hs-integration.sx', 'hs-htmx.sx',
  'boot.sx',
 ];
@@ -456,10 +455,8 @@ for (const file of FILES) {
        'hs-parser': ['hs-tokenizer'],
        'hs-compiler': ['hs-tokenizer', 'hs-parser'],
        'hs-runtime': ['hs-tokenizer', 'hs-parser', 'hs-compiler'],
-        'hs-worker': ['hs-tokenizer', 'hs-parser'],
+        'hs-integration': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime'],
-        'hs-prolog': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime'],
+        'hs-htmx': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-integration'],
        'hs-integration': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-worker', 'hs-prolog'],
        'hs-htmx': ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-worker', 'hs-prolog', 'hs-integration'],
      };
      manifest[key] = {
        file: sxbcFile,
@@ -480,7 +477,7 @@ if (entryFile) {
  const lazyDeps = entryFile.deps.filter(d => LAZY_ENTRY_DEPS.has(d));
  // Hyperscript modules aren't define-library, so not auto-detected as deps.
  // Load them lazily after boot — eager loading breaks the boot sequence.
-  const HS_LAZY = ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-worker', 'hs-prolog', 'hs-integration', 'hs-htmx'];
+  const HS_LAZY = ['hs-tokenizer', 'hs-parser', 'hs-compiler', 'hs-runtime', 'hs-integration', 'hs-htmx'];
  for (const m of HS_LAZY) {
    if (manifest[m] && !lazyDeps.includes(m)) lazyDeps.push(m);
  }
--- a/hosts/ocaml/lib/dune
+++ b/hosts/ocaml/lib/dune
@@ -1,4 +1,4 @@
 (library
 (name sx)
 (wrapped false)
- (libraries re re.pcre unix))
+ (libraries re re.pcre))
--- a/hosts/ocaml/lib/sx_compiler.ml
+++ b/hosts/ocaml/lib/sx_compiler.ml
@@ -200,30 +200,7 @@ and compile_qq_list em items scope =
 (* compile-call *)
 and compile_call em head args scope tail_p =
-  (let is_prim = (let _and = (prim_call "=" [(type_of (head)); (String "symbol")]) in if not (sx_truthy _and) then _and else (let name = (symbol_name (head)) in (let _and = (Bool (not (sx_truthy ((prim_call "=" [(get ((scope_resolve (scope) (name))) ((String "type"))); (String "local")]))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((prim_call "=" [(get ((scope_resolve (scope) (name))) ((String "type"))); (String "upvalue")]))))) in if not (sx_truthy _and) then _and else (is_primitive (name)))))) in (if sx_truthy (is_prim) then (let name = (symbol_name (head)) in let argc = (len (args)) in
+  (let is_prim = (let _and = (prim_call "=" [(type_of (head)); (String "symbol")]) in if not (sx_truthy _and) then _and else (let name = (symbol_name (head)) in (let _and = (Bool (not (sx_truthy ((prim_call "=" [(get ((scope_resolve (scope) (name))) ((String "type"))); (String "local")]))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((prim_call "=" [(get ((scope_resolve (scope) (name))) ((String "type"))); (String "upvalue")]))))) in if not (sx_truthy _and) then _and else (is_primitive (name)))))) in (if sx_truthy (is_prim) then (let name = (symbol_name (head)) in let argc = (len (args)) in let name_idx = (pool_add ((get (em) ((String "pool")))) (name)) in (let () = ignore ((List.iter (fun a -> ignore ((compile_expr (em) (a) (scope) ((Bool false))))) (sx_to_list args); Nil)) in (let () = ignore ((emit_op (em) ((Number 52.0)))) in (let () = ignore ((emit_u16 (em) (name_idx))) in (emit_byte (em) (argc)))))) else (let () = ignore ((compile_expr (em) (head) (scope) ((Bool false)))) in (let () = ignore ((List.iter (fun a -> ignore ((compile_expr (em) (a) (scope) ((Bool false))))) (sx_to_list args); Nil)) in (if sx_truthy (tail_p) then (let () = ignore ((emit_op (em) ((Number 49.0)))) in (emit_byte (em) ((len (args))))) else (let () = ignore ((emit_op (em) ((Number 48.0)))) in (emit_byte (em) ((len (args))))))))))
    (* Specialized opcode for hot 2-arg / 1-arg primitives. *)
    let specialized_op = (match name, argc with
      | String "+",     Number 2.0 -> Some 160
      | String "-",     Number 2.0 -> Some 161
      | String "*",     Number 2.0 -> Some 162
      | String "/",     Number 2.0 -> Some 163
      | String "=",     Number 2.0 -> Some 164
      | String "<",     Number 2.0 -> Some 165
      | String ">",     Number 2.0 -> Some 166
      | String "cons",  Number 2.0 -> Some 172
      | String "not",   Number 1.0 -> Some 167
      | String "len",   Number 1.0 -> Some 168
      | String "first", Number 1.0 -> Some 169
      | String "rest",  Number 1.0 -> Some 170
      | _ -> None) in
    (let () = ignore ((List.iter (fun a -> ignore ((compile_expr (em) (a) (scope) ((Bool false))))) (sx_to_list args); Nil)) in
     (match specialized_op with
      | Some op -> emit_op em (Number (float_of_int op))
      | None ->
        let name_idx = (pool_add ((get (em) ((String "pool")))) (name)) in
        let () = ignore ((emit_op (em) ((Number 52.0)))) in
        let () = ignore ((emit_u16 (em) (name_idx))) in
        emit_byte (em) (argc)))) else (let () = ignore ((compile_expr (em) (head) (scope) ((Bool false)))) in (let () = ignore ((List.iter (fun a -> ignore ((compile_expr (em) (a) (scope) ((Bool false))))) (sx_to_list args); Nil)) in (if sx_truthy (tail_p) then (let () = ignore ((emit_op (em) ((Number 49.0)))) in (emit_byte (em) ((len (args))))) else (let () = ignore ((emit_op (em) ((Number 48.0)))) in (emit_byte (em) ((len (args))))))))))
 (* compile *)
 and compile expr =
--- a/hosts/ocaml/lib/sx_parser.ml
+++ b/hosts/ocaml/lib/sx_parser.ml
@@ -89,35 +89,7 @@ let read_symbol s =
  while s.pos < s.len && is_symbol_char s.src.[s.pos] do advance s done;
  String.sub s.src start (s.pos - start)
 let gcd a b =
  let rec g a b = if b = 0 then a else g b (a mod b) in g (abs a) (abs b)
 let make_rat n d =
  if d = 0 then raise (Parse_error "rational: division by zero");
  let sign = if d < 0 then -1 else 1 in
  let g = gcd (abs n) (abs d) in
  let rn = sign * n / g and rd = sign * d / g in
  if rd = 1 then Integer rn else Rational (rn, rd)
 let try_number str =
  (* Integers (no '.' or 'e'/'E') → exact Integer; rationals N/D; floats → inexact Number *)
  let has_dec = String.contains str '.' in
  let has_exp = String.contains str 'e' || String.contains str 'E' in
  if has_dec || has_exp then
    match float_of_string_opt str with
    | Some n -> Some (Number n)
    | None -> None
  else
    match String.split_on_char '/' str with
    | [num_s; den_s] when num_s <> "" && den_s <> "" ->
      (match int_of_string_opt num_s, int_of_string_opt den_s with
       | Some n, Some d -> (try Some (make_rat n d) with _ -> None)
       | _ -> None)
    | _ ->
      match int_of_string_opt str with
      | Some n -> Some (Integer n)
      | None ->
        (* handles "nan", "inf", "-inf" *)
  match float_of_string_opt str with
  | Some n -> Some (Number n)
  | None -> None
@@ -136,34 +108,6 @@ let rec read_value s : value =
  | '"' -> String (read_string s)
  | '\'' -> advance s; List [Symbol "quote"; read_value s]
  | '`' -> advance s; List [Symbol "quasiquote"; read_value s]
  | '#' when s.pos + 1 < s.len && s.src.[s.pos + 1] = '\\' ->
    (* Character literal: #\a, #\space, #\newline, etc. *)
    advance s; advance s;
    if at_end s then raise (Parse_error "Unexpected end of input after #\\");
    let char_start = s.pos in
    (* Read a name if starts with ident char, else single char *)
    if is_ident_start s.src.[s.pos] then begin
      while s.pos < s.len && is_ident_char s.src.[s.pos] do advance s done;
      let name = String.sub s.src char_start (s.pos - char_start) in
      let cp = match name with
        | "space" -> 32 | "newline" -> 10 | "tab" -> 9
        | "return" -> 13 | "nul" -> 0 | "null" -> 0
        | "escape" -> 27 | "delete" -> 127 | "backspace" -> 8
        | "altmode" -> 27 | "rubout" -> 127
        | _ -> Char.code name.[0]  (* single letter like #\a *)
      in Char cp
    end else begin
      let c = s.src.[s.pos] in
      advance s;
      Char (Char.code c)
    end
  | '#' when s.pos + 1 < s.len &&
             (s.src.[s.pos + 1] = 't' || s.src.[s.pos + 1] = 'f') &&
             (s.pos + 2 >= s.len || not (is_ident_char s.src.[s.pos + 2])) ->
    (* #t / #f — boolean literals (R7RS shorthand) *)
    let b = s.src.[s.pos + 1] = 't' in
    advance s; advance s;
    Bool b
  | '#' when s.pos + 1 < s.len && s.src.[s.pos + 1] = ';' ->
    (* Datum comment: #; discards next expression *)
    advance s; advance s;
--- a/hosts/ocaml/lib/sx_primitives.ml
+++ b/hosts/ocaml/lib/sx_primitives.ml
--- a/hosts/ocaml/lib/sx_ref.ml
+++ b/hosts/ocaml/lib/sx_ref.ml
--- a/hosts/ocaml/lib/sx_runtime.ml
+++ b/hosts/ocaml/lib/sx_runtime.ml
@@ -6,69 +6,8 @@
 open Sx_types
-(** Fast path equality — same as Sx_primitives.safe_eq for the common cases
+(** Call a registered primitive by name. *)
    that show up in hot dispatch (string vs string, etc). Falls through to
    the registered "=" primitive for complex cases. *)
 let rec _fast_eq a b =
  if a == b then true
  else match a, b with
  | String x, String y -> x = y
  | Integer x, Integer y -> x = y
  | Number x, Number y -> x = y
  | Integer x, Number y -> float_of_int x = y
  | Number x, Integer y -> x = float_of_int y
  | Bool x, Bool y -> x = y
  | Nil, Nil -> true
  | Symbol x, Symbol y -> x = y
  | Keyword x, Keyword y -> x = y
  | List la, List lb ->
    (try List.for_all2 _fast_eq la lb with Invalid_argument _ -> false)
  | _ -> false
 (** Call a registered primitive by name.
    Fast path for hot dispatch primitives ([=], [<], [>], [<=], [>=], [empty?],
    [first], [rest], [len]) skips the Hashtbl lookup entirely — these are
    called millions of times in the CEK [step_continue]/[step_eval] dispatch. *)
 let prim_call name args =
  (* Hot path: most-frequently-called primitives by step_continue dispatch *)
  match name, args with
  | "=", [a; b] -> Bool (_fast_eq a b)
  | "empty?", [List []] -> Bool true
  | "empty?", [List _] -> Bool false
  | "empty?", [ListRef { contents = [] }] -> Bool true
  | "empty?", [ListRef _] -> Bool false
  | "empty?", [Nil] -> Bool true
  | "first", [List (x :: _)] -> x
  | "first", [List []] -> Nil
  | "first", [ListRef { contents = (x :: _) }] -> x
  | "first", [ListRef _] -> Nil
  | "first", [Nil] -> Nil
  | "rest", [List (_ :: xs)] -> List xs
  | "rest", [List []] -> List []
  | "rest", [ListRef { contents = (_ :: xs) }] -> List xs
  | "rest", [ListRef _] -> List []
  | "rest", [Nil] -> List []
  | "len", [List l] -> Integer (List.length l)
  | "len", [ListRef r] -> Integer (List.length !r)
  | "len", [String s] -> Integer (String.length s)
  | "len", [Nil] -> Integer 0
  | "<", [Integer x; Integer y] -> Bool (x < y)
  | "<", [Number x; Number y] -> Bool (x < y)
  | "<", [Integer x; Number y] -> Bool (float_of_int x < y)
  | "<", [Number x; Integer y] -> Bool (x < float_of_int y)
  | ">", [Integer x; Integer y] -> Bool (x > y)
  | ">", [Number x; Number y] -> Bool (x > y)
  | ">", [Integer x; Number y] -> Bool (float_of_int x > y)
  | ">", [Number x; Integer y] -> Bool (x > float_of_int y)
  | "<=", [Integer x; Integer y] -> Bool (x <= y)
  | "<=", [Number x; Number y] -> Bool (x <= y)
  | "<=", [Integer x; Number y] -> Bool (float_of_int x <= y)
  | "<=", [Number x; Integer y] -> Bool (x <= float_of_int y)
  | ">=", [Integer x; Integer y] -> Bool (x >= y)
  | ">=", [Number x; Number y] -> Bool (x >= y)
  | ">=", [Integer x; Number y] -> Bool (float_of_int x >= y)
  | ">=", [Number x; Integer y] -> Bool (x >= float_of_int y)
  | _ ->
  match Hashtbl.find_opt Sx_primitives.primitives name with
  | Some f -> f args
  | None -> raise (Eval_error ("Unknown primitive: " ^ name))
@@ -107,7 +46,7 @@ let sx_call f args =
    !Sx_types._cek_eval_lambda_ref f args
  | Continuation (k, _) ->
    k (match args with x :: _ -> x | [] -> Nil)
-  | CallccContinuation (_, _) ->
+  | CallccContinuation _ ->
    raise (Eval_error "callcc continuations must be invoked through the CEK machine")
  | _ ->
    let nargs = List.length args in
@@ -217,9 +156,6 @@ let get_val container key =
     | "extra" -> f.cf_extra | "extra2" -> f.cf_extra2
     | "subscribers" -> f.cf_results
     | "prev-tracking" -> f.cf_extra
     | "after-thunk" -> f.cf_f        (* wind-after frame *)
     | "winders-len" -> f.cf_extra    (* wind-after frame *)
     | "body-result" -> f.cf_name     (* wind-return frame *)
     | _ -> Nil)
  | VmFrame f, String k ->
    (match k with
@@ -270,17 +206,8 @@ let get_val container key =
     | _ -> Nil)
  | Dict d, String k -> dict_get d k
  | Dict d, Keyword k -> dict_get d k
  | AdtValue a, String k | AdtValue a, Keyword k ->
    (match k with
     | "_adt"    -> Bool true
     | "_type"   -> String a.av_type
     | "_ctor"   -> String a.av_ctor
     | "_fields" -> List (Array.to_list a.av_fields)
     | _         -> Nil)
  | (List l | ListRef { contents = l }), Number n ->
    (try List.nth l (int_of_float n) with _ -> Nil)
  | (List l | ListRef { contents = l }), Integer n ->
    (try List.nth l n with _ -> Nil)
  | Nil, _ -> Nil  (* nil.anything → nil *)
  | _, _ -> Nil    (* type mismatch → nil (matches JS/Python behavior) *)
@@ -454,28 +381,19 @@ let continuation_data v = match v with
  | _ -> raise (Eval_error "not a continuation")
 (* Callcc (undelimited) continuation support *)
-let callcc_continuation_p v = match v with CallccContinuation (_, _) -> Bool true | _ -> Bool false
+let callcc_continuation_p v = match v with CallccContinuation _ -> Bool true | _ -> Bool false
-let make_callcc_continuation captured winders_len =
+let make_callcc_continuation captured =
-  let n = match winders_len with Number f -> int_of_float f | Integer n -> n | _ -> 0 in
+  CallccContinuation (sx_to_list captured)
  CallccContinuation (sx_to_list captured, n)
 let callcc_continuation_data v = match v with
-  | CallccContinuation (frames, _) -> List frames
+  | CallccContinuation frames -> List frames
  | _ -> raise (Eval_error "not a callcc continuation")
 let callcc_continuation_winders_len v = match v with
  | CallccContinuation (_, n) -> Number (float_of_int n)
  | _ -> Number 0.0
 (* Dynamic wind — simplified for OCaml (no async) *)
 let host_error msg =
  raise (Eval_error (value_to_str msg))
 let host_warn msg =
  prerr_endline (value_to_str msg);
  Nil
 let dynamic_wind_call before body after _env =
  ignore (sx_call before []);
  let result = sx_call body [] in
@@ -611,4 +529,3 @@ let jit_try_call f args =
      (match hook f arg_list with Some result -> incr _jit_hit; result | None -> incr _jit_miss; _jit_skip_sentinel)
    | _ -> incr _jit_skip; _jit_skip_sentinel
--- a/hosts/ocaml/lib/sx_types.ml
+++ b/hosts/ocaml/lib/sx_types.ml
@@ -44,8 +44,7 @@ type env = {
 and value =
  | Nil
  | Bool   of bool
-  | Integer of int    (** Exact integer — distinct from inexact float. *)
+  | Number of float
  | Number  of float  (** Inexact float. *)
  | String of string
  | Symbol of string
  | Keyword of string
@@ -57,7 +56,7 @@ and value =
  | Macro  of macro
  | Thunk  of value * env
  | Continuation of (value -> value) * dict option
-  | CallccContinuation of value list * int  (** Undelimited continuation — captured kont frames + winders depth at capture *)
+  | CallccContinuation of value list  (** Undelimited continuation — captured kont frames *)
  | NativeFn of string * (value list -> value)
  | Signal of signal
  | RawHTML of string
@@ -73,35 +72,6 @@ and value =
  | Record of record  (** R7RS record — opaque, generative, field-indexed. *)
  | Parameter of parameter  (** R7RS parameter — dynamic binding via kont-stack provide frames. *)
  | Vector of value array  (** R7RS vector — mutable fixed-size array. *)
  | StringBuffer of Buffer.t  (** Mutable string buffer — O(1) amortized append. *)
  | HashTable of (value, value) Hashtbl.t  (** Mutable hash table with arbitrary keys. *)
  | Char of int  (** Unicode codepoint — R7RS char type. *)
  | Eof            (** EOF sentinel — returned by read-char etc. at end of input. *)
  | Port of sx_port  (** String port — input (string cursor) or output (buffer). *)
  | Rational of int * int  (** Exact rational: numerator, denominator (reduced, denom>0). *)
  | SxSet of (string, value) Hashtbl.t  (** Mutable set keyed by inspect(value). *)
  | SxRegexp of string * string * Re.re  (** Regexp: source, flags, compiled. *)
  | SxBytevector of bytes  (** Mutable bytevector — R7RS bytevector type. *)
  | AdtValue of adt_value  (** Native algebraic data type instance — opaque sum type. *)
 (** Algebraic data type instance — produced by [define-type] constructors.
    [av_type] is the type name (e.g. "Maybe"), [av_ctor] is the constructor
    name (e.g. "Just"), [av_fields] are the positional field values. *)
 and adt_value = {
  av_type   : string;
  av_ctor   : string;
  av_fields : value array;
 }
 (** String input port: source string + mutable cursor position. *)
 and sx_port_kind =
  | PortInput of string * int ref
  | PortOutput of Buffer.t
 and sx_port = {
  mutable sp_closed : bool;
  sp_kind : sx_port_kind;
 }
 (** CEK machine state — record instead of Dict for performance.
    5 fields × 55K steps/sec = 275K Hashtbl allocations/sec eliminated. *)
@@ -422,7 +392,6 @@ let format_number n =
 let value_to_string = function
  | String s -> s | Symbol s -> s | Keyword k -> k
  | Integer n -> string_of_int n
  | Number n -> format_number n
  | Bool true -> "true" | Bool false -> "false"
  | Nil -> "" | _ -> "<value>"
@@ -492,7 +461,6 @@ let make_keyword name = Keyword (value_to_string name)
 let type_of = function
  | Nil            -> "nil"
  | Bool _         -> "boolean"
  | Integer _      -> "number"
  | Number _       -> "number"
  | String _       -> "string"
  | Symbol _       -> "symbol"
@@ -505,7 +473,7 @@ let type_of = function
  | Macro _        -> "macro"
  | Thunk _        -> "thunk"
  | Continuation (_, _) -> "continuation"
-  | CallccContinuation (_, _) -> "continuation"
+  | CallccContinuation _ -> "continuation"
  | NativeFn _     -> "function"
  | Signal _       -> "signal"
  | RawHTML _      -> "raw-html"
@@ -520,17 +488,6 @@ let type_of = function
  | Record r       -> r.r_type.rt_name
  | Parameter _    -> "parameter"
  | Vector _       -> "vector"
  | StringBuffer _ -> "string-buffer"
  | HashTable _    -> "hash-table"
  | Char _         -> "char"
  | Eof            -> "eof-object"
  | Port { sp_kind = PortInput _; _ }  -> "input-port"
  | Port { sp_kind = PortOutput _; _ } -> "output-port"
  | Rational _  -> "rational"
  | SxSet _          -> "set"
  | SxRegexp _       -> "regexp"
  | SxBytevector _   -> "bytevector"
  | AdtValue a       -> a.av_type
 let is_nil = function Nil -> true | _ -> false
 let is_lambda = function Lambda _ -> true | _ -> false
@@ -546,7 +503,7 @@ let is_signal = function
 let is_record = function Record _ -> true | _ -> false
 let is_callable = function
-  | Lambda _ | NativeFn _ | Continuation (_, _) | CallccContinuation (_, _) | VmClosure _ -> true
+  | Lambda _ | NativeFn _ | Continuation (_, _) | CallccContinuation _ | VmClosure _ -> true
  | _ -> false
@@ -659,7 +616,6 @@ let thunk_env = function
 (** {1 Record operations} *)
 let val_to_int = function
  | Integer n -> n
  | Number n -> int_of_float n
  | v -> raise (Eval_error ("Expected number, got " ^ type_of v))
@@ -817,15 +773,13 @@ let dict_vals (d : dict) =
 (** {1 Value display} *)
-(* Single shared buffer for the entire inspect recursion — eliminates
+let rec inspect = function
-   the per-level [String.concat (List.map inspect ...)] allocation. *)
+  | Nil -> "nil"
-let rec inspect_into buf = function
+  | Bool true -> "true"
-  | Nil -> Buffer.add_string buf "nil"
+  | Bool false -> "false"
-  | Bool true -> Buffer.add_string buf "true"
+  | Number n -> format_number n
  | Bool false -> Buffer.add_string buf "false"
  | Integer n -> Buffer.add_string buf (string_of_int n)
  | Number n -> Buffer.add_string buf (format_number n)
  | String s ->
    let buf = Buffer.create (String.length s + 2) in
    Buffer.add_char buf '"';
    String.iter (function
      | '"'  -> Buffer.add_string buf "\\\""
@@ -834,129 +788,46 @@ let rec inspect_into buf = function
      | '\r' -> Buffer.add_string buf "\\r"
      | '\t' -> Buffer.add_string buf "\\t"
      | c    -> Buffer.add_char buf c) s;
-    Buffer.add_char buf '"'
+    Buffer.add_char buf '"';
-  | Symbol s -> Buffer.add_string buf s
+    Buffer.contents buf
-  | Keyword k -> Buffer.add_char buf ':'; Buffer.add_string buf k
+  | Symbol s -> s
  | Keyword k -> ":" ^ k
  | List items | ListRef { contents = items } ->
-    Buffer.add_char buf '(';
+    "(" ^ String.concat " " (List.map inspect items) ^ ")"
    (match items with
     | [] -> ()
     | x :: rest ->
       inspect_into buf x;
       List.iter (fun v -> Buffer.add_char buf ' '; inspect_into buf v) rest);
    Buffer.add_char buf ')'
  | Dict d ->
-    Buffer.add_char buf '{';
+    let pairs = Hashtbl.fold (fun k v acc ->
-    let first = ref true in
+      (Printf.sprintf ":%s %s" k (inspect v)) :: acc) d [] in
-    Hashtbl.iter (fun k v ->
+    "{" ^ String.concat " " pairs ^ "}"
      if !first then first := false else Buffer.add_char buf ' ';
      Buffer.add_char buf ':'; Buffer.add_string buf k;
      Buffer.add_char buf ' '; inspect_into buf v) d;
    Buffer.add_char buf '}'
  | Lambda l ->
    let tag = match l.l_name with Some n -> n | None -> "lambda" in
-    Buffer.add_char buf '<'; Buffer.add_string buf tag;
+    Printf.sprintf "<%s(%s)>" tag (String.concat ", " l.l_params)
    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " l.l_params);
    Buffer.add_string buf ")>"
  | Component c ->
-    Buffer.add_string buf "<Component ~"; Buffer.add_string buf c.c_name;
+    Printf.sprintf "<Component ~%s(%s)>" c.c_name (String.concat ", " c.c_params)
    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " c.c_params);
    Buffer.add_string buf ")>"
  | Island i ->
-    Buffer.add_string buf "<Island ~"; Buffer.add_string buf i.i_name;
+    Printf.sprintf "<Island ~%s(%s)>" i.i_name (String.concat ", " i.i_params)
    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " i.i_params);
    Buffer.add_string buf ")>"
  | Macro m ->
    let tag = match m.m_name with Some n -> n | None -> "macro" in
-    Buffer.add_char buf '<'; Buffer.add_string buf tag;
+    Printf.sprintf "<%s(%s)>" tag (String.concat ", " m.m_params)
-    Buffer.add_char buf '('; Buffer.add_string buf (String.concat ", " m.m_params);
+  | Thunk _ -> "<thunk>"
-    Buffer.add_string buf ")>"
+  | Continuation (_, _) -> "<continuation>"
-  | Thunk _ -> Buffer.add_string buf "<thunk>"
+  | CallccContinuation _ -> "<callcc-continuation>"
-  | Continuation (_, _) -> Buffer.add_string buf "<continuation>"
+  | NativeFn (name, _) -> Printf.sprintf "<native:%s>" name
-  | CallccContinuation (_, _) -> Buffer.add_string buf "<callcc-continuation>"
+  | Signal _ -> "<signal>"
-  | NativeFn (name, _) ->
+  | RawHTML s -> Printf.sprintf "\"<raw-html:%d>\"" (String.length s)
-    Buffer.add_string buf "<native:"; Buffer.add_string buf name; Buffer.add_char buf '>'
+  | Spread _ -> "<spread>"
-  | Signal _ -> Buffer.add_string buf "<signal>"
+  | SxExpr s -> Printf.sprintf "\"<sx-expr:%d>\"" (String.length s)
-  | RawHTML s ->
+  | Env _ -> "<env>"
-    Buffer.add_string buf "\"<raw-html:";
+  | CekState _ -> "<cek-state>"
-    Buffer.add_string buf (string_of_int (String.length s));
+  | CekFrame f -> Printf.sprintf "<frame:%s>" f.cf_type
-    Buffer.add_string buf ">\""
+  | VmClosure cl -> Printf.sprintf "<vm:%s>" (match cl.vm_name with Some n -> n | None -> "anon")
  | Spread _ -> Buffer.add_string buf "<spread>"
  | SxExpr s ->
    Buffer.add_string buf "\"<sx-expr:";
    Buffer.add_string buf (string_of_int (String.length s));
    Buffer.add_string buf ">\""
  | Env _ -> Buffer.add_string buf "<env>"
  | CekState _ -> Buffer.add_string buf "<cek-state>"
  | CekFrame f ->
    Buffer.add_string buf "<frame:"; Buffer.add_string buf f.cf_type; Buffer.add_char buf '>'
  | VmClosure cl ->
    Buffer.add_string buf "<vm:";
    Buffer.add_string buf (match cl.vm_name with Some n -> n | None -> "anon");
    Buffer.add_char buf '>'
  | Record r ->
-    Buffer.add_string buf "<record:"; Buffer.add_string buf r.r_type.rt_name;
+    let fields = Array.to_list (Array.mapi (fun i v ->
-    Array.iteri (fun i v ->
+      Printf.sprintf "%s=%s" r.r_type.rt_fields.(i) (inspect v)
-      Buffer.add_char buf ' ';
+    ) r.r_fields) in
-      Buffer.add_string buf r.r_type.rt_fields.(i);
+    Printf.sprintf "<record:%s %s>" r.r_type.rt_name (String.concat " " fields)
-      Buffer.add_char buf '=';
+  | Parameter p -> Printf.sprintf "<parameter:%s>" p.pm_uid
      inspect_into buf v) r.r_fields;
    Buffer.add_char buf '>'
  | Parameter p ->
    Buffer.add_string buf "<parameter:"; Buffer.add_string buf p.pm_uid; Buffer.add_char buf '>'
  | Vector arr ->
-    Buffer.add_string buf "#(";
+    let elts = Array.to_list (Array.map inspect arr) in
-    Array.iteri (fun i v ->
+    Printf.sprintf "#(%s)" (String.concat " " elts)
-      if i > 0 then Buffer.add_char buf ' ';
+  | VmFrame f -> Printf.sprintf "<vm-frame:ip=%d base=%d>" f.vf_ip f.vf_base
-      inspect_into buf v) arr;
+  | VmMachine m -> Printf.sprintf "<vm-machine:sp=%d frames=%d>" m.vm_sp (List.length m.vm_frames)
    Buffer.add_char buf ')'
  | VmFrame f ->
    Buffer.add_string buf (Printf.sprintf "<vm-frame:ip=%d base=%d>" f.vf_ip f.vf_base)
  | VmMachine m ->
    Buffer.add_string buf (Printf.sprintf "<vm-machine:sp=%d frames=%d>" m.vm_sp (List.length m.vm_frames))
  | StringBuffer b ->
    Buffer.add_string buf (Printf.sprintf "<string-buffer:%d>" (Buffer.length b))
  | HashTable ht ->
    Buffer.add_string buf (Printf.sprintf "<hash-table:%d>" (Hashtbl.length ht))
  | Char n ->
    Buffer.add_string buf "#\\";
    (match n with
     | 32 -> Buffer.add_string buf "space"
     | 10 -> Buffer.add_string buf "newline"
     | 9 -> Buffer.add_string buf "tab"
     | 13 -> Buffer.add_string buf "return"
     | 0 -> Buffer.add_string buf "nul"
     | 27 -> Buffer.add_string buf "escape"
     | 127 -> Buffer.add_string buf "delete"
     | 8 -> Buffer.add_string buf "backspace"
     | _ -> Buffer.add_utf_8_uchar buf (Uchar.of_int n))
  | Eof -> Buffer.add_string buf "#!eof"
  | Port { sp_kind = PortInput (_, pos); sp_closed } ->
    Buffer.add_string buf (Printf.sprintf "<input-port:pos=%d%s>" !pos (if sp_closed then ":closed" else ""))
  | Port { sp_kind = PortOutput b; sp_closed } ->
    Buffer.add_string buf (Printf.sprintf "<output-port:len=%d%s>" (Buffer.length b) (if sp_closed then ":closed" else ""))
  | Rational (n, d) ->
    Buffer.add_string buf (string_of_int n); Buffer.add_char buf '/';
    Buffer.add_string buf (string_of_int d)
  | SxSet ht ->
    Buffer.add_string buf (Printf.sprintf "<set:%d>" (Hashtbl.length ht))
  | SxRegexp (src, flags, _) ->
    Buffer.add_string buf "#/"; Buffer.add_string buf src;
    Buffer.add_char buf '/'; Buffer.add_string buf flags
  | SxBytevector b ->
    Buffer.add_string buf "#u8(";
    let n = Bytes.length b in
    for i = 0 to n - 1 do
      if i > 0 then Buffer.add_char buf ' ';
      Buffer.add_string buf (string_of_int (Char.code (Bytes.get b i)))
    done;
    Buffer.add_char buf ')'
  | AdtValue a ->
    Buffer.add_char buf '('; Buffer.add_string buf a.av_ctor;
    Array.iter (fun v -> Buffer.add_char buf ' '; inspect_into buf v) a.av_fields;
    Buffer.add_char buf ')'
 let inspect v =
  let buf = Buffer.create 64 in
  inspect_into buf v;
  Buffer.contents buf
--- a/hosts/ocaml/lib/sx_vm.ml
+++ b/hosts/ocaml/lib/sx_vm.ml
@@ -185,8 +185,7 @@ let code_from_value v =
      | Some _ as r -> r | None -> Hashtbl.find_opt d k2 in
    let bc_list = match find2 "bytecode" "vc-bytecode" with
      | Some (List l | ListRef { contents = l }) ->
-        Array.of_list (List.map (fun x -> match x with
+        Array.of_list (List.map (fun x -> match x with Number n -> int_of_float n | _ -> 0) l)
          | Integer n -> n | Number n -> int_of_float n | _ -> 0) l)
      | _ -> [||]
    in
    let entries = match find2 "constants" "vc-constants" with
@@ -199,10 +198,10 @@ let code_from_value v =
      | _ -> entry
    ) entries in
    let arity = match find2 "arity" "vc-arity" with
-      | Some (Integer n) -> n | Some (Number n) -> int_of_float n | _ -> 0
+      | Some (Number n) -> int_of_float n | _ -> 0
    in
    let rest_arity = match find2 "rest-arity" "vc-rest-arity" with
-      | Some (Integer n) -> n | Some (Number n) -> int_of_float n | _ -> -1
+      | Some (Number n) -> int_of_float n | _ -> -1
    in
    (* Compute locals from bytecode: scan for highest LOCAL_GET/LOCAL_SET slot.
       The compiler's arity may undercount when nested lets add many locals. *)
@@ -327,18 +326,7 @@ and call_closure_reuse cl args =
       vm.sp <- saved_sp;
       raise e);
    vm.frames <- saved_frames;
-    (* Snapshot/restore sp around the popped result.
+    pop vm
       OP_RETURN normally leaves sp = saved_sp + 1, but the bytecode-exhausted
       path (or a callee that returns a closure whose own RETURN leaves extra
       stack residue) can leave sp inconsistent. Read the result at the
       expected slot and reset sp explicitly so the parent frame's
       intermediate values are not corrupted. *)
    let result =
      if vm.sp > saved_sp then vm.stack.(vm.sp - 1)
      else Nil
    in
    vm.sp <- saved_sp;
    result
  | None ->
    call_closure cl args cl.vm_env_ref
@@ -742,67 +730,51 @@ and run vm =
        | 160 (* OP_ADD *) ->
          let b = pop vm and a = pop vm in
          push vm (match a, b with
            | Integer x, Integer y -> Integer (x + y)
            | Number x, Number y -> Number (x +. y)
            | Integer x, Number y -> Number (float_of_int x +. y)
            | Number x, Integer y -> Number (x +. float_of_int y)
            | _ -> (Hashtbl.find Sx_primitives.primitives "+") [a; b])
        | 161 (* OP_SUB *) ->
          let b = pop vm and a = pop vm in
          push vm (match a, b with
            | Integer x, Integer y -> Integer (x - y)
            | Number x, Number y -> Number (x -. y)
            | Integer x, Number y -> Number (float_of_int x -. y)
            | Number x, Integer y -> Number (x -. float_of_int y)
            | _ -> (Hashtbl.find Sx_primitives.primitives "-") [a; b])
        | 162 (* OP_MUL *) ->
          let b = pop vm and a = pop vm in
          push vm (match a, b with
            | Integer x, Integer y -> Integer (x * y)
            | Number x, Number y -> Number (x *. y)
            | Integer x, Number y -> Number (float_of_int x *. y)
            | Number x, Integer y -> Number (x *. float_of_int y)
            | _ -> (Hashtbl.find Sx_primitives.primitives "*") [a; b])
        | 163 (* OP_DIV *) ->
          let b = pop vm and a = pop vm in
          push vm (match a, b with
            | Integer x, Integer y when y <> 0 && x mod y = 0 -> Integer (x / y)
            | Integer x, Integer y -> Number (float_of_int x /. float_of_int y)
            | Number x, Number y -> Number (x /. y)
            | Integer x, Number y -> Number (float_of_int x /. y)
            | Number x, Integer y -> Number (x /. float_of_int y)
            | _ -> (Hashtbl.find Sx_primitives.primitives "/") [a; b])
        | 164 (* OP_EQ *) ->
          let b = pop vm and a = pop vm in
-          push vm (Bool (Sx_runtime._fast_eq a b))
+          let rec norm = function
            | ListRef { contents = l } -> List (List.map norm l)
            | List l -> List (List.map norm l) | v -> v in
          push vm (Bool (norm a = norm b))
        | 165 (* OP_LT *) ->
          let b = pop vm and a = pop vm in
          push vm (match a, b with
            | Integer x, Integer y -> Bool (x < y)
            | Number x, Number y -> Bool (x < y)
            | Integer x, Number y -> Bool (float_of_int x < y)
            | Number x, Integer y -> Bool (x < float_of_int y)
            | String x, String y -> Bool (x < y)
-            | _ -> Sx_runtime.prim_call "<" [a; b])
+            | _ -> (Hashtbl.find Sx_primitives.primitives "<") [a; b])
        | 166 (* OP_GT *) ->
          let b = pop vm and a = pop vm in
          push vm (match a, b with
            | Integer x, Integer y -> Bool (x > y)
            | Number x, Number y -> Bool (x > y)
            | Integer x, Number y -> Bool (float_of_int x > y)
            | Number x, Integer y -> Bool (x > float_of_int y)
            | String x, String y -> Bool (x > y)
-            | _ -> Sx_runtime.prim_call ">" [a; b])
+            | _ -> (Hashtbl.find Sx_primitives.primitives ">") [a; b])
        | 167 (* OP_NOT *) ->
          let v = pop vm in
          push vm (Bool (not (sx_truthy v)))
        | 168 (* OP_LEN *) ->
          let v = pop vm in
          push vm (match v with
-            | List l | ListRef { contents = l } -> Integer (List.length l)
+            | List l | ListRef { contents = l } -> Number (float_of_int (List.length l))
-            | String s -> Integer (String.length s)
+            | String s -> Number (float_of_int (String.length s))
-            | Dict d -> Integer (Hashtbl.length d)
+            | Dict d -> Number (float_of_int (Hashtbl.length d))
-            | Nil -> Integer 0
+            | Nil -> Number 0.0
            | _ -> (Hashtbl.find Sx_primitives.primitives "len") [v])
        | 169 (* OP_FIRST *) ->
          let v = pop vm in
@@ -915,17 +887,9 @@ let resume_vm vm result =
  let rec restore_reuse pending =
    match pending with
    | [] -> ()
-    | (saved_frames, saved_sp) :: rest ->
+    | (saved_frames, _saved_sp) :: rest ->
      let callback_result = pop vm in
      vm.frames <- saved_frames;
      (* Restore sp to the value captured before the suspended callee was
         pushed. The callee's locals/temps may still be on the stack above
         saved_sp; without this reset, subsequent LOCAL_GET/SET in the
         caller frame (e.g. letrec sibling bindings waiting on the call)
         see stale callee data instead of their own slots. Mirrors the
         OP_RETURN+sp-reset semantics that sync `call_closure_reuse`
         relies on for clean caller-frame state. *)
      if saved_sp < vm.sp then vm.sp <- saved_sp;
      push vm callback_result;
      (try
        run vm;
--- a/hosts/ocaml/transpiler.sx
+++ b/hosts/ocaml/transpiler.sx
@@ -256,7 +256,6 @@
    "callcc-continuation?"
    "callcc-continuation-data"
    "make-callcc-continuation"
    "callcc-continuation-winders-len"
    "dynamic-wind-call"
    "strip-prefix"
    "component-set-param-types!"
@@ -296,8 +295,7 @@
    "*bind-tracking*"
    "*provide-batch-depth*"
    "*provide-batch-queue*"
-    "*provide-subscribers*"
+    "*provide-subscribers*"))
    "*winders*"))
 (define
  ml-is-mutable-global?
@@ -535,13 +533,13 @@
              "; cf_env = "
              (ef "env")
              "; cf_name = "
-              (if (= frame-type "if") (ef "else") (cond (some (fn (k) (= k "body-result")) items) (ef "body-result") :else (ef "name")))
+              (if (= frame-type "if") (ef "else") (ef "name"))
              "; cf_body = "
              (if (= frame-type "if") (ef "then") (ef "body"))
              "; cf_remaining = "
              (ef "remaining")
              "; cf_f = "
-              (cond (some (fn (k) (= k "after-thunk")) items) (ef "after-thunk") (some (fn (k) (= k "f")) items) (ef "f") :else "Nil")
+              (ef "f")
              "; cf_args = "
              (cond
                (some (fn (k) (= k "evaled")) items)
@@ -584,8 +582,6 @@
                (ef "prev-tracking")
                (some (fn (k) (= k "extra")) items)
                (ef "extra")
                (some (fn (k) (= k "winders-len")) items)
                (ef "winders-len")
                :else "Nil")
              "; cf_extra2 = "
              (cond
--- a/lib/apl/runtime.sx
+++ b/lib/apl/runtime.sx
@@ -1,289 +0,0 @@
 ;; lib/apl/runtime.sx — APL primitives on SX
 ;;
 ;; APL vectors are represented as SX lists (functional, immutable results).
 ;; Operations are rank-polymorphic: scalar/vector arguments both accepted.
 ;; Index origin: 1 (traditional APL).
 ;;
 ;; Primitives used:
 ;;   map (multi-arg, Phase 1)
 ;;   bitwise-and/or/xor/not/arithmetic-shift (Phase 7)
 ;;   make-set/set-member?/set-add!/set->list (Phase 18)
 ;; ---------------------------------------------------------------------------
 ;; 1. Core vector constructors
 ;; ---------------------------------------------------------------------------
 ;; ⍳N — iota: generate integer vector 1, 2, ..., N
 (define
  (apl-iota n)
  (letrec
    ((go (fn (i acc) (if (< i 1) acc (go (- i 1) (cons i acc))))))
    (go n (list))))
 ;; ⍴A — shape (length of a vector)
 (define (apl-rho v) (if (list? v) (len v) 1))
 ;; A[I] — 1-indexed access
 (define (apl-at v i) (nth v (- i 1)))
 ;; Scalar predicate
 (define (apl-scalar? v) (not (list? v)))
 ;; ---------------------------------------------------------------------------
 ;; 2. Rank-polymorphic helpers
 ;;    dyadic: scalar/vector × scalar/vector → scalar/vector
 ;;    monadic: scalar/vector → scalar/vector
 ;; ---------------------------------------------------------------------------
 (define
  (apl-dyadic op a b)
  (cond
    ((and (list? a) (list? b)) (map op a b))
    ((list? a) (map (fn (x) (op x b)) a))
    ((list? b) (map (fn (y) (op a y)) b))
    (else (op a b))))
 (define (apl-monadic op a) (if (list? a) (map op a) (op a)))
 ;; ---------------------------------------------------------------------------
 ;; 3. Arithmetic (element-wise, rank-polymorphic)
 ;; ---------------------------------------------------------------------------
 (define (apl-add a b) (apl-dyadic + a b))
 (define (apl-sub a b) (apl-dyadic - a b))
 (define (apl-mul a b) (apl-dyadic * a b))
 (define (apl-div a b) (apl-dyadic / a b))
 (define (apl-mod a b) (apl-dyadic modulo a b))
 (define (apl-pow a b) (apl-dyadic pow a b))
 (define (apl-max a b) (apl-dyadic (fn (x y) (if (> x y) x y)) a b))
 (define (apl-min a b) (apl-dyadic (fn (x y) (if (< x y) x y)) a b))
 (define (apl-neg a) (apl-monadic (fn (x) (- 0 x)) a))
 (define (apl-abs a) (apl-monadic abs a))
 (define (apl-floor a) (apl-monadic floor a))
 (define (apl-ceil a) (apl-monadic ceil a))
 (define (apl-sqrt a) (apl-monadic sqrt a))
 (define (apl-exp a) (apl-monadic exp a))
 (define (apl-log a) (apl-monadic log a))
 ;; ---------------------------------------------------------------------------
 ;; 4. Comparison (element-wise, returns 0/1 booleans)
 ;; ---------------------------------------------------------------------------
 (define (apl-bool v) (if v 1 0))
 (define (apl-eq a b) (apl-dyadic (fn (x y) (apl-bool (= x y))) a b))
 (define
  (apl-neq a b)
  (apl-dyadic (fn (x y) (apl-bool (not (= x y)))) a b))
 (define (apl-lt a b) (apl-dyadic (fn (x y) (apl-bool (< x y))) a b))
 (define (apl-le a b) (apl-dyadic (fn (x y) (apl-bool (<= x y))) a b))
 (define (apl-gt a b) (apl-dyadic (fn (x y) (apl-bool (> x y))) a b))
 (define (apl-ge a b) (apl-dyadic (fn (x y) (apl-bool (>= x y))) a b))
 ;; Boolean logic (0/1 vectors)
 (define
  (apl-and a b)
  (apl-dyadic
    (fn
      (x y)
      (if
        (and (not (= x 0)) (not (= y 0)))
        1
        0))
    a
    b))
 (define
  (apl-or a b)
  (apl-dyadic
    (fn
      (x y)
      (if
        (or (not (= x 0)) (not (= y 0)))
        1
        0))
    a
    b))
 (define
  (apl-not a)
  (apl-monadic (fn (x) (if (= x 0) 1 0)) a))
 ;; ---------------------------------------------------------------------------
 ;; 5. Bitwise operations (element-wise)
 ;; ---------------------------------------------------------------------------
 (define (apl-bitand a b) (apl-dyadic bitwise-and a b))
 (define (apl-bitor a b) (apl-dyadic bitwise-or a b))
 (define (apl-bitxor a b) (apl-dyadic bitwise-xor a b))
 (define (apl-bitnot a) (apl-monadic bitwise-not a))
 (define
  (apl-lshift a b)
  (apl-dyadic (fn (x n) (arithmetic-shift x n)) a b))
 (define
  (apl-rshift a b)
  (apl-dyadic (fn (x n) (arithmetic-shift x (- 0 n))) a b))
 ;; ---------------------------------------------------------------------------
 ;; 6. Reduction (fold) and scan
 ;; ---------------------------------------------------------------------------
 (define (apl-reduce-add v) (reduce + 0 v))
 (define (apl-reduce-mul v) (reduce * 1 v))
 (define
  (apl-reduce-max v)
  (reduce (fn (acc x) (if (> acc x) acc x)) (first v) (rest v)))
 (define
  (apl-reduce-min v)
  (reduce (fn (acc x) (if (< acc x) acc x)) (first v) (rest v)))
 (define
  (apl-reduce-and v)
  (reduce
    (fn
      (acc x)
      (if
        (and (not (= acc 0)) (not (= x 0)))
        1
        0))
    1
    v))
 (define
  (apl-reduce-or v)
  (reduce
    (fn
      (acc x)
      (if
        (or (not (= acc 0)) (not (= x 0)))
        1
        0))
    0
    v))
 ;; Scan: prefix reduction (yields a vector of running totals)
 (define
  (apl-scan op v)
  (if
    (= (len v) 0)
    (list)
    (letrec
      ((go (fn (xs acc result) (if (= (len xs) 0) (reverse result) (let ((next (op acc (first xs)))) (go (rest xs) next (cons next result)))))))
      (go (rest v) (first v) (list (first v))))))
 (define (apl-scan-add v) (apl-scan + v))
 (define (apl-scan-mul v) (apl-scan * v))
 ;; ---------------------------------------------------------------------------
 ;; 7. Vector manipulation
 ;; ---------------------------------------------------------------------------
 ;; ⌽A — reverse
 (define (apl-reverse v) (reverse v))
 ;; A,B — catenate
 (define
  (apl-cat a b)
  (cond
    ((and (list? a) (list? b)) (append a b))
    ((list? a) (append a (list b)))
    ((list? b) (cons a b))
    (else (list a b))))
 ;; ↑N A — take first N elements (negative: take last N)
 (define
  (apl-take n v)
  (if
    (>= n 0)
    (letrec
      ((go (fn (xs i) (if (or (= i 0) (= (len xs) 0)) (list) (cons (first xs) (go (rest xs) (- i 1)))))))
      (go v n))
    (apl-reverse (apl-take (- 0 n) (apl-reverse v)))))
 ;; ↓N A — drop first N elements
 (define
  (apl-drop n v)
  (if
    (>= n 0)
    (letrec
      ((go (fn (xs i) (if (or (= i 0) (= (len xs) 0)) xs (go (rest xs) (- i 1))))))
      (go v n))
    (apl-reverse (apl-drop (- 0 n) (apl-reverse v)))))
 ;; Rotate left by n positions
 (define
  (apl-rotate n v)
  (let ((m (modulo n (len v)))) (append (apl-drop m v) (apl-take m v))))
 ;; Compression: A/B — select elements of B where A is 1
 (define
  (apl-compress mask v)
  (if
    (= (len mask) 0)
    (list)
    (let
      ((rest-result (apl-compress (rest mask) (rest v))))
      (if
        (not (= (first mask) 0))
        (cons (first v) rest-result)
        rest-result))))
 ;; Indexing: A[B] — select elements at indices B (1-indexed)
 (define (apl-index v indices) (map (fn (i) (apl-at v i)) indices))
 ;; Grade up: indices that would sort the vector ascending
 (define
  (apl-grade-up v)
  (let
    ((indexed (map (fn (x i) (list x i)) v (apl-iota (len v)))))
    (map (fn (p) (nth p 1)) (sort indexed))))
 ;; ---------------------------------------------------------------------------
 ;; 8. Set operations (∊ ∪ ∩ ~)
 ;; ---------------------------------------------------------------------------
 ;; Membership ∊: for each element in A, is it in B? → 0/1 vector
 (define
  (apl-member a b)
  (let
    ((bset (let ((s (make-set))) (for-each (fn (x) (set-add! s x)) b) s)))
    (if
      (list? a)
      (map (fn (x) (apl-bool (set-member? bset x))) a)
      (apl-bool (set-member? bset a)))))
 ;; Nub ∪A — unique elements, preserving order
 (define
  (apl-nub v)
  (let
    ((seen (make-set)))
    (letrec
      ((go (fn (xs acc) (if (= (len xs) 0) (reverse acc) (if (set-member? seen (first xs)) (go (rest xs) acc) (begin (set-add! seen (first xs)) (go (rest xs) (cons (first xs) acc))))))))
      (go v (list)))))
 ;; Union A∪B — nub of concatenation
 (define (apl-union a b) (apl-nub (apl-cat a b)))
 ;; Intersection A∩B
 (define
  (apl-intersect a b)
  (let
    ((bset (let ((s (make-set))) (for-each (fn (x) (set-add! s x)) b) s)))
    (filter (fn (x) (set-member? bset x)) a)))
 ;; Without A~B
 (define
  (apl-without a b)
  (let
    ((bset (let ((s (make-set))) (for-each (fn (x) (set-add! s x)) b) s)))
    (filter (fn (x) (not (set-member? bset x))) a)))
 ;; ---------------------------------------------------------------------------
 ;; 9. Format (⍕) — APL-style display
 ;; ---------------------------------------------------------------------------
 (define
  (apl-format v)
  (if
    (list? v)
    (letrec
      ((go (fn (xs acc) (if (= (len xs) 0) acc (go (rest xs) (str acc (if (= acc "") "" " ") (str (first xs))))))))
      (go v ""))
    (str v)))
--- a/lib/apl/test.sh
+++ b/lib/apl/test.sh
@@ -1,51 +0,0 @@
 #!/usr/bin/env bash
 # lib/apl/test.sh — smoke-test the APL runtime layer.
 set -uo pipefail
 cd "$(git rev-parse --show-toplevel)"
 SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
 if [ ! -x "$SX_SERVER" ]; then
  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
 fi
 if [ ! -x "$SX_SERVER" ]; then
  echo "ERROR: sx_server.exe not found."
  exit 1
 fi
 TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
 cat > "$TMPFILE" << 'EPOCHS'
 (epoch 1)
 (load "spec/stdlib.sx")
 (load "lib/apl/runtime.sx")
 (epoch 2)
 (load "lib/apl/tests/runtime.sx")
 (epoch 3)
 (eval "(list apl-test-pass apl-test-fail)")
 EPOCHS
 OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
 LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}')
 if [ -z "$LINE" ]; then
  LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \
          | sed -E 's/^\(ok 3 //; s/\)$//')
 fi
 if [ -z "$LINE" ]; then
  echo "ERROR: could not extract summary"
  echo "$OUTPUT" | tail -10
  exit 1
 fi
 P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
 F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
 TOTAL=$((P + F))
 if [ "$F" -eq 0 ]; then
  echo "ok $P/$TOTAL lib/apl tests passed"
 else
  echo "FAIL $P/$TOTAL passed, $F failed"
 fi
 [ "$F" -eq 0 ]
--- a/lib/apl/tests/runtime.sx
+++ b/lib/apl/tests/runtime.sx
@@ -1,327 +0,0 @@
 ;; lib/apl/tests/runtime.sx — Tests for lib/apl/runtime.sx
 ;; --- Test framework ---
 (define apl-test-pass 0)
 (define apl-test-fail 0)
 (define apl-test-fails (list))
 (define
  (apl-test name got expected)
  (if
    (= got expected)
    (set! apl-test-pass (+ apl-test-pass 1))
    (begin
      (set! apl-test-fail (+ apl-test-fail 1))
      (set! apl-test-fails (append apl-test-fails (list {:got got :expected expected :name name}))))))
 ;; ---------------------------------------------------------------------------
 ;; 1. Core vector constructors
 ;; ---------------------------------------------------------------------------
 (apl-test
  "iota 5"
  (apl-iota 5)
  (list 1 2 3 4 5))
 (apl-test "iota 1" (apl-iota 1) (list 1))
 (apl-test "iota 0" (apl-iota 0) (list))
 (apl-test
  "rho list"
  (apl-rho (list 1 2 3))
  3)
 (apl-test "rho scalar" (apl-rho 42) 1)
 (apl-test
  "at 1"
  (apl-at (list 10 20 30) 1)
  10)
 (apl-test
  "at 3"
  (apl-at (list 10 20 30) 3)
  30)
 ;; ---------------------------------------------------------------------------
 ;; 2. Arithmetic — element-wise and rank-polymorphic
 ;; ---------------------------------------------------------------------------
 (apl-test
  "add v+v"
  (apl-add
    (list 1 2 3)
    (list 10 20 30))
  (list 11 22 33))
 (apl-test
  "add s+v"
  (apl-add 10 (list 1 2 3))
  (list 11 12 13))
 (apl-test
  "add v+s"
  (apl-add (list 1 2 3) 100)
  (list 101 102 103))
 (apl-test "add s+s" (apl-add 3 4) 7)
 (apl-test
  "sub v-v"
  (apl-sub
    (list 5 4 3)
    (list 1 2 3))
  (list 4 2 0))
 (apl-test
  "mul v*s"
  (apl-mul (list 1 2 3) 3)
  (list 3 6 9))
 (apl-test
  "neg -v"
  (apl-neg (list 1 -2 3))
  (list -1 2 -3))
 (apl-test
  "abs v"
  (apl-abs (list -1 2 -3))
  (list 1 2 3))
 (apl-test
  "floor v"
  (apl-floor (list 1.7 2.2 3.9))
  (list 1 2 3))
 (apl-test
  "ceil v"
  (apl-ceil (list 1.1 2.5 3))
  (list 2 3 3))
 (apl-test
  "max v v"
  (apl-max
    (list 1 5 3)
    (list 4 2 6))
  (list 4 5 6))
 (apl-test
  "min v v"
  (apl-min
    (list 1 5 3)
    (list 4 2 6))
  (list 1 2 3))
 ;; ---------------------------------------------------------------------------
 ;; 3. Comparison (returns 0/1)
 ;; ---------------------------------------------------------------------------
 (apl-test "eq 3 3" (apl-eq 3 3) 1)
 (apl-test "eq 3 4" (apl-eq 3 4) 0)
 (apl-test
  "gt v>s"
  (apl-gt (list 1 5 3 7) 4)
  (list 0 1 0 1))
 (apl-test
  "lt v<v"
  (apl-lt
    (list 1 2 3)
    (list 3 2 1))
  (list 1 0 0))
 (apl-test
  "le v<=s"
  (apl-le (list 3 4 5) 4)
  (list 1 1 0))
 (apl-test
  "ge v>=s"
  (apl-ge (list 3 4 5) 4)
  (list 0 1 1))
 (apl-test
  "neq v!=s"
  (apl-neq (list 1 2 3) 2)
  (list 1 0 1))
 ;; ---------------------------------------------------------------------------
 ;; 4. Boolean logic (0/1 values)
 ;; ---------------------------------------------------------------------------
 (apl-test "and 1 1" (apl-and 1 1) 1)
 (apl-test "and 1 0" (apl-and 1 0) 0)
 (apl-test "or 0 1" (apl-or 0 1) 1)
 (apl-test "or 0 0" (apl-or 0 0) 0)
 (apl-test "not 0" (apl-not 0) 1)
 (apl-test "not 1" (apl-not 1) 0)
 (apl-test
  "not vec"
  (apl-not (list 1 0 1 0))
  (list 0 1 0 1))
 ;; ---------------------------------------------------------------------------
 ;; 5. Bitwise operations
 ;; ---------------------------------------------------------------------------
 (apl-test "bitand s" (apl-bitand 5 3) 1)
 (apl-test "bitor s" (apl-bitor 5 3) 7)
 (apl-test "bitxor s" (apl-bitxor 5 3) 6)
 (apl-test "bitnot 0" (apl-bitnot 0) -1)
 (apl-test "lshift 1 4" (apl-lshift 1 4) 16)
 (apl-test "rshift 16 2" (apl-rshift 16 2) 4)
 (apl-test
  "bitand vec"
  (apl-bitand (list 5 6) (list 3 7))
  (list 1 6))
 (apl-test
  "bitor vec"
  (apl-bitor (list 5 6) (list 3 7))
  (list 7 7))
 ;; ---------------------------------------------------------------------------
 ;; 6. Reduction and scan
 ;; ---------------------------------------------------------------------------
 (apl-test
  "reduce-add"
  (apl-reduce-add
    (list 1 2 3 4 5))
  15)
 (apl-test
  "reduce-mul"
  (apl-reduce-mul (list 1 2 3 4))
  24)
 (apl-test
  "reduce-max"
  (apl-reduce-max
    (list 3 1 4 1 5))
  5)
 (apl-test
  "reduce-min"
  (apl-reduce-min
    (list 3 1 4 1 5))
  1)
 (apl-test
  "reduce-and"
  (apl-reduce-and (list 1 1 1))
  1)
 (apl-test
  "reduce-and0"
  (apl-reduce-and (list 1 0 1))
  0)
 (apl-test
  "reduce-or"
  (apl-reduce-or (list 0 1 0))
  1)
 (apl-test
  "scan-add"
  (apl-scan-add (list 1 2 3 4))
  (list 1 3 6 10))
 (apl-test
  "scan-mul"
  (apl-scan-mul (list 1 2 3 4))
  (list 1 2 6 24))
 ;; ---------------------------------------------------------------------------
 ;; 7. Vector manipulation
 ;; ---------------------------------------------------------------------------
 (apl-test
  "reverse"
  (apl-reverse (list 1 2 3 4))
  (list 4 3 2 1))
 (apl-test
  "cat v v"
  (apl-cat (list 1 2) (list 3 4))
  (list 1 2 3 4))
 (apl-test
  "cat v s"
  (apl-cat (list 1 2) 3)
  (list 1 2 3))
 (apl-test
  "cat s v"
  (apl-cat 1 (list 2 3))
  (list 1 2 3))
 (apl-test
  "cat s s"
  (apl-cat 1 2)
  (list 1 2))
 (apl-test
  "take 3"
  (apl-take
    3
    (list 10 20 30 40 50))
  (list 10 20 30))
 (apl-test
  "take 0"
  (apl-take 0 (list 1 2 3))
  (list))
 (apl-test
  "take neg"
  (apl-take -2 (list 10 20 30))
  (list 20 30))
 (apl-test
  "drop 2"
  (apl-drop 2 (list 10 20 30 40))
  (list 30 40))
 (apl-test
  "drop neg"
  (apl-drop -1 (list 10 20 30))
  (list 10 20))
 (apl-test
  "rotate 2"
  (apl-rotate
    2
    (list 1 2 3 4 5))
  (list 3 4 5 1 2))
 (apl-test
  "compress"
  (apl-compress
    (list 1 0 1 0)
    (list 10 20 30 40))
  (list 10 30))
 (apl-test
  "index"
  (apl-index
    (list 10 20 30 40)
    (list 2 4))
  (list 20 40))
 ;; ---------------------------------------------------------------------------
 ;; 8. Set operations
 ;; ---------------------------------------------------------------------------
 (apl-test
  "member yes"
  (apl-member
    (list 1 2 5)
    (list 2 4 6))
  (list 0 1 0))
 (apl-test
  "member s"
  (apl-member 2 (list 1 2 3))
  1)
 (apl-test
  "member no"
  (apl-member 9 (list 1 2 3))
  0)
 (apl-test
  "nub"
  (apl-nub (list 1 2 1 3 2))
  (list 1 2 3))
 (apl-test
  "union"
  (apl-union
    (list 1 2 3)
    (list 2 3 4))
  (list 1 2 3 4))
 (apl-test
  "intersect"
  (apl-intersect
    (list 1 2 3 4)
    (list 2 4 6))
  (list 2 4))
 (apl-test
  "without"
  (apl-without
    (list 1 2 3 4)
    (list 2 4))
  (list 1 3))
 ;; ---------------------------------------------------------------------------
 ;; 9. Format
 ;; ---------------------------------------------------------------------------
 (apl-test
  "format vec"
  (apl-format (list 1 2 3))
  "1 2 3")
 (apl-test "format scalar" (apl-format 42) "42")
 (apl-test "format empty" (apl-format (list)) "")
 ;; ---------------------------------------------------------------------------
 ;; Summary
 ;; ---------------------------------------------------------------------------
 (list apl-test-pass apl-test-fail)
--- a/lib/common-lisp/clos.sx
+++ b/lib/common-lisp/clos.sx
@@ -1,500 +0,0 @@
 ;; lib/common-lisp/clos.sx — CLOS: classes, instances, generic functions
 ;;
 ;; Class records: {:clos-type "class" :name "NAME" :slots {...} :parents [...] :methods [...]}
 ;; Instance:      {:clos-type "instance" :class "NAME" :slots {slot: val ...}}
 ;; Method:        {:qualifiers [...] :specializers [...] :fn (fn (args next-fn) ...)}
 ;;
 ;; SX primitive notes:
 ;;   dict->list: use (map (fn (k) (list k (get d k))) (keys d))
 ;;   dict-set (pure): use assoc
 ;;   fn?/callable?: use callable?
 ;; ── dict helpers ───────────────────────────────────────────────────────────
 (define
  clos-dict->list
  (fn (d) (map (fn (k) (list k (get d k))) (keys d))))
 ;; ── class registry ─────────────────────────────────────────────────────────
 (define
  clos-class-registry
  (dict
    "t"
    {:parents (list) :clos-type "class" :slots (dict) :methods (list) :name "t"}
    "null"
    {:parents (list "t") :clos-type "class" :slots (dict) :methods (list) :name "null"}
    "integer"
    {:parents (list "t") :clos-type "class" :slots (dict) :methods (list) :name "integer"}
    "float"
    {:parents (list "t") :clos-type "class" :slots (dict) :methods (list) :name "float"}
    "string"
    {:parents (list "t") :clos-type "class" :slots (dict) :methods (list) :name "string"}
    "symbol"
    {:parents (list "t") :clos-type "class" :slots (dict) :methods (list) :name "symbol"}
    "cons"
    {:parents (list "t") :clos-type "class" :slots (dict) :methods (list) :name "cons"}
    "list"
    {:parents (list "t") :clos-type "class" :slots (dict) :methods (list) :name "list"}))
 ;; ── clos-generic-registry ─────────────────────────────────────────────────
 (define clos-generic-registry (dict))
 ;; ── class-of ──────────────────────────────────────────────────────────────
 (define
  clos-class-of
  (fn
    (x)
    (cond
      ((nil? x) "null")
      ((integer? x) "integer")
      ((float? x) "float")
      ((string? x) "string")
      ((symbol? x) "symbol")
      ((and (list? x) (> (len x) 0)) "cons")
      ((and (list? x) (= (len x) 0)) "null")
      ((and (dict? x) (= (get x "clos-type") "instance")) (get x "class"))
      (:else "t"))))
 ;; ── subclass-of? ──────────────────────────────────────────────────────────
 ;;
 ;; Captures clos-class-registry at define time to avoid free-variable issues.
 (define
  clos-subclass-of?
  (let
    ((registry clos-class-registry))
    (fn
      (class-name super-name)
      (if
        (= class-name super-name)
        true
        (let
          ((rec (get registry class-name)))
          (if
            (nil? rec)
            false
            (some
              (fn (p) (clos-subclass-of? p super-name))
              (get rec "parents"))))))))
 ;; ── instance-of? ──────────────────────────────────────────────────────────
 (define
  clos-instance-of?
  (fn (obj class-name) (clos-subclass-of? (clos-class-of obj) class-name)))
 ;; ── defclass ──────────────────────────────────────────────────────────────
 ;;
 ;; slot-specs: list of dicts with keys: name initarg initform accessor reader writer
 ;; Each missing key defaults to nil.
 (define clos-slot-spec (fn (spec) (if (string? spec) {:initform nil :initarg nil :reader nil :writer nil :accessor nil :name spec} spec)))
 (define
  clos-defclass
  (fn
    (name parents slot-specs)
    (let
      ((slots (dict)))
      (for-each
        (fn
          (pname)
          (let
            ((prec (get clos-class-registry pname)))
            (when
              (not (nil? prec))
              (for-each
                (fn
                  (k)
                  (when
                    (nil? (get slots k))
                    (dict-set! slots k (get (get prec "slots") k))))
                (keys (get prec "slots"))))))
        parents)
      (for-each
        (fn
          (s)
          (let
            ((spec (clos-slot-spec s)))
            (dict-set! slots (get spec "name") spec)))
        slot-specs)
      (let
        ((class-rec {:parents parents :clos-type "class" :slots slots :methods (list) :name name}))
        (dict-set! clos-class-registry name class-rec)
        (clos-install-accessors-for name slots)
        name))))
 ;; ── accessor installation (forward-declared, defined after defmethod) ──────
 (define
  clos-install-accessors-for
  (fn
    (class-name slots)
    (for-each
      (fn
        (k)
        (let
          ((spec (get slots k)))
          (let
            ((reader (get spec "reader")))
            (when
              (not (nil? reader))
              (clos-add-reader-method reader class-name k)))
          (let
            ((accessor (get spec "accessor")))
            (when
              (not (nil? accessor))
              (clos-add-reader-method accessor class-name k)))))
      (keys slots))))
 ;; placeholder — real impl filled in after defmethod is defined
 (define clos-add-reader-method (fn (method-name class-name slot-name) nil))
 ;; ── make-instance ─────────────────────────────────────────────────────────
 (define
  clos-make-instance
  (fn
    (class-name &rest initargs)
    (let
      ((class-rec (get clos-class-registry class-name)))
      (if
        (nil? class-rec)
        (error (str "No class named: " class-name))
        (let
          ((slots (dict)))
          (for-each
            (fn
              (k)
              (let
                ((spec (get (get class-rec "slots") k)))
                (let
                  ((initform (get spec "initform")))
                  (when
                    (not (nil? initform))
                    (dict-set!
                      slots
                      k
                      (if (callable? initform) (initform) initform))))))
            (keys (get class-rec "slots")))
          (define
            apply-args
            (fn
              (args)
              (when
                (>= (len args) 2)
                (let
                  ((key (str (first args))) (val (first (rest args))))
                  (let
                    ((skey (if (= (slice key 0 1) ":") (slice key 1 (len key)) key)))
                    (let
                      ((matched false))
                      (for-each
                        (fn
                          (sk)
                          (let
                            ((spec (get (get class-rec "slots") sk)))
                            (let
                              ((ia (get spec "initarg")))
                              (when
                                (or
                                  (= ia key)
                                  (= ia (str ":" skey))
                                  (= sk skey))
                                (dict-set! slots sk val)
                                (set! matched true)))))
                        (keys (get class-rec "slots")))))
                  (apply-args (rest (rest args)))))))
          (apply-args initargs)
          {:clos-type "instance" :slots slots :class class-name})))))
 ;; ── slot-value ────────────────────────────────────────────────────────────
 (define
  clos-slot-value
  (fn
    (instance slot-name)
    (if
      (and (dict? instance) (= (get instance "clos-type") "instance"))
      (get (get instance "slots") slot-name)
      (error (str "Not a CLOS instance: " (inspect instance))))))
 (define
  clos-set-slot-value!
  (fn
    (instance slot-name value)
    (if
      (and (dict? instance) (= (get instance "clos-type") "instance"))
      (dict-set! (get instance "slots") slot-name value)
      (error (str "Not a CLOS instance: " (inspect instance))))))
 (define
  clos-slot-boundp
  (fn
    (instance slot-name)
    (and
      (dict? instance)
      (= (get instance "clos-type") "instance")
      (not (nil? (get (get instance "slots") slot-name))))))
 ;; ── find-class / change-class ─────────────────────────────────────────────
 (define clos-find-class (fn (name) (get clos-class-registry name)))
 (define
  clos-change-class!
  (fn
    (instance new-class-name)
    (if
      (and (dict? instance) (= (get instance "clos-type") "instance"))
      (dict-set! instance "class" new-class-name)
      (error (str "Not a CLOS instance: " (inspect instance))))))
 ;; ── defgeneric ────────────────────────────────────────────────────────────
 (define
  clos-defgeneric
  (fn
    (name options)
    (let
      ((combination (or (get options "method-combination") "standard")))
      (when
        (nil? (get clos-generic-registry name))
        (dict-set! clos-generic-registry name {:methods (list) :combination combination :name name}))
      name)))
 ;; ── defmethod ─────────────────────────────────────────────────────────────
 ;;
 ;; method-fn: (fn (args next-fn) body)
 ;;   args = list of all call arguments
 ;;   next-fn = (fn () next-method-result) or nil
 (define
  clos-defmethod
  (fn
    (generic-name qualifiers specializers method-fn)
    (when
      (nil? (get clos-generic-registry generic-name))
      (clos-defgeneric generic-name {}))
    (let
      ((grec (get clos-generic-registry generic-name))
        (new-method {:fn method-fn :qualifiers qualifiers :specializers specializers}))
      (let
        ((kept (filter (fn (m) (not (and (= (get m "qualifiers") qualifiers) (= (get m "specializers") specializers)))) (get grec "methods"))))
        (dict-set!
          clos-generic-registry
          generic-name
          (assoc grec "methods" (append kept (list new-method))))
        generic-name))))
 ;; Now install the real accessor-method installer
 (set!
  clos-add-reader-method
  (fn
    (method-name class-name slot-name)
    (clos-defmethod
      method-name
      (list)
      (list class-name)
      (fn (args next-fn) (clos-slot-value (first args) slot-name)))))
 ;; ── method specificity ─────────────────────────────────────────────────────
 (define
  clos-method-matches?
  (fn
    (method args)
    (let
      ((specs (get method "specializers")))
      (if
        (> (len specs) (len args))
        false
        (define
          check-all
          (fn
            (i)
            (if
              (>= i (len specs))
              true
              (let
                ((spec (nth specs i)) (arg (nth args i)))
                (if
                  (= spec "t")
                  (check-all (+ i 1))
                  (if
                    (clos-instance-of? arg spec)
                    (check-all (+ i 1))
                    false))))))
        (check-all 0)))))
 ;; Precedence distance: how far class-name is from spec-name up the hierarchy.
 (define
  clos-specificity
  (let
    ((registry clos-class-registry))
    (fn
      (class-name spec-name)
      (define
        walk
        (fn
          (cn depth)
          (if
            (= cn spec-name)
            depth
            (let
              ((rec (get registry cn)))
              (if
                (nil? rec)
                nil
                (let
                  ((results (map (fn (p) (walk p (+ depth 1))) (get rec "parents"))))
                  (let
                    ((non-nil (filter (fn (x) (not (nil? x))) results)))
                    (if
                      (empty? non-nil)
                      nil
                      (reduce
                        (fn (a b) (if (< a b) a b))
                        (first non-nil)
                        (rest non-nil))))))))))
      (walk class-name 0))))
 (define
  clos-method-more-specific?
  (fn
    (m1 m2 args)
    (let
      ((s1 (get m1 "specializers")) (s2 (get m2 "specializers")))
      (define
        cmp
        (fn
          (i)
          (if
            (>= i (len s1))
            false
            (let
              ((c1 (clos-specificity (clos-class-of (nth args i)) (nth s1 i)))
                (c2
                  (clos-specificity (clos-class-of (nth args i)) (nth s2 i))))
              (cond
                ((and (nil? c1) (nil? c2)) (cmp (+ i 1)))
                ((nil? c1) false)
                ((nil? c2) true)
                ((< c1 c2) true)
                ((> c1 c2) false)
                (:else (cmp (+ i 1))))))))
      (cmp 0))))
 (define
  clos-sort-methods
  (fn
    (methods args)
    (define
      insert
      (fn
        (m sorted)
        (if
          (empty? sorted)
          (list m)
          (if
            (clos-method-more-specific? m (first sorted) args)
            (cons m sorted)
            (cons (first sorted) (insert m (rest sorted)))))))
    (reduce (fn (acc m) (insert m acc)) (list) methods)))
 ;; ── call-generic (standard method combination) ─────────────────────────────
 (define
  clos-call-generic
  (fn
    (generic-name args)
    (let
      ((grec (get clos-generic-registry generic-name)))
      (if
        (nil? grec)
        (error (str "No generic function: " generic-name))
        (let
          ((applicable (filter (fn (m) (clos-method-matches? m args)) (get grec "methods"))))
          (if
            (empty? applicable)
            (error
              (str
                "No applicable method for "
                generic-name
                " with classes "
                (inspect (map clos-class-of args))))
            (let
              ((primary (filter (fn (m) (empty? (get m "qualifiers"))) applicable))
                (before
                  (filter
                    (fn (m) (= (get m "qualifiers") (list "before")))
                    applicable))
                (after
                  (filter
                    (fn (m) (= (get m "qualifiers") (list "after")))
                    applicable))
                (around
                  (filter
                    (fn (m) (= (get m "qualifiers") (list "around")))
                    applicable)))
              (let
                ((sp (clos-sort-methods primary args))
                  (sb (clos-sort-methods before args))
                  (sa (clos-sort-methods after args))
                  (sw (clos-sort-methods around args)))
                (define
                  make-primary-chain
                  (fn
                    (methods)
                    (if
                      (empty? methods)
                      (fn
                        ()
                        (error (str "No next primary method: " generic-name)))
                      (fn
                        ()
                        ((get (first methods) "fn")
                          args
                          (make-primary-chain (rest methods)))))))
                (define
                  make-around-chain
                  (fn
                    (around-methods inner-thunk)
                    (if
                      (empty? around-methods)
                      inner-thunk
                      (fn
                        ()
                        ((get (first around-methods) "fn")
                          args
                          (make-around-chain
                            (rest around-methods)
                            inner-thunk))))))
                (for-each (fn (m) ((get m "fn") args (fn () nil))) sb)
                (let
                  ((primary-thunk (make-primary-chain sp)))
                  (let
                    ((result (if (empty? sw) (primary-thunk) ((make-around-chain sw primary-thunk)))))
                    (for-each
                      (fn (m) ((get m "fn") args (fn () nil)))
                      (reverse sa))
                    result))))))))))
 ;; ── call-next-method / next-method-p ──────────────────────────────────────
 (define clos-call-next-method (fn (next-fn) (next-fn)))
 (define clos-next-method-p (fn (next-fn) (not (nil? next-fn))))
 ;; ── with-slots ────────────────────────────────────────────────────────────
 (define
  clos-with-slots
  (fn
    (instance slot-names body-fn)
    (let
      ((vals (map (fn (s) (clos-slot-value instance s)) slot-names)))
      (apply body-fn vals))))
--- a/lib/common-lisp/conformance.sh
+++ b/lib/common-lisp/conformance.sh
@@ -1,161 +0,0 @@
 #!/usr/bin/env bash
 # lib/common-lisp/conformance.sh — CL-on-SX conformance test runner
 #
 # Runs all Common Lisp test suites and writes scoreboard.json + scoreboard.md.
 #
 # Usage:
 #   bash lib/common-lisp/conformance.sh
 #   bash lib/common-lisp/conformance.sh -v
 set -uo pipefail
 cd "$(git rev-parse --show-toplevel)"
 SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
 if [ ! -x "$SX_SERVER" ]; then
  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
 fi
 if [ ! -x "$SX_SERVER" ]; then
  echo "ERROR: sx_server.exe not found."
  exit 1
 fi
 VERBOSE="${1:-}"
 TOTAL_PASS=0; TOTAL_FAIL=0
 SUITE_NAMES=()
 SUITE_PASS=()
 SUITE_FAIL=()
 # run_suite NAME "file1 file2 ..." PASS_VAR FAIL_VAR FAILURES_VAR
 run_suite() {
  local name="$1" load_files="$2" pass_var="$3" fail_var="$4" failures_var="$5"
  local TMP; TMP=$(mktemp)
  {
    printf '(epoch 1)\n(load "spec/stdlib.sx")\n(load "lib/guest/prefix.sx")\n'
    local i=2
    for f in $load_files; do
      printf '(epoch %d)\n(load "%s")\n' "$i" "$f"
      i=$((i+1))
    done
    printf '(epoch 100)\n(eval "%s")\n' "$pass_var"
    printf '(epoch 101)\n(eval "%s")\n' "$fail_var"
  } > "$TMP"
  local OUT; OUT=$(timeout 30 "$SX_SERVER" < "$TMP" 2>/dev/null)
  rm -f "$TMP"
  local P F
  P=$(echo "$OUT" | grep -A1 "^(ok-len 100 " | tail -1 | tr -d ' ()' || true)
  F=$(echo "$OUT" | grep -A1 "^(ok-len 101 " | tail -1 | tr -d ' ()' || true)
  # Also try plain (ok 100 N) format
  [ -z "$P" ] && P=$(echo "$OUT" | grep "^(ok 100 " | awk '{print $3}' | tr -d ')' || true)
  [ -z "$F" ] && F=$(echo "$OUT" | grep "^(ok 101 " | awk '{print $3}' | tr -d ')' || true)
  [ -z "$P" ] && P=0; [ -z "$F" ] && F=0
  SUITE_NAMES+=("$name")
  SUITE_PASS+=("$P")
  SUITE_FAIL+=("$F")
  TOTAL_PASS=$((TOTAL_PASS + P))
  TOTAL_FAIL=$((TOTAL_FAIL + F))
  if [ "$F" = "0" ] && [ "${P:-0}" -gt 0 ] 2>/dev/null; then
    echo "  PASS  $name ($P tests)"
  else
    echo "  FAIL  $name ($P passed, $F failed)"
  fi
 }
 echo "=== Common Lisp on SX — Conformance Run ==="
 echo ""
 run_suite "Phase 1: tokenizer/reader" \
  "lib/common-lisp/reader.sx lib/common-lisp/tests/read.sx" \
  "cl-test-pass" "cl-test-fail" "cl-test-fails"
 run_suite "Phase 1: parser/lambda-lists" \
  "lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/tests/lambda.sx" \
  "cl-test-pass" "cl-test-fail" "cl-test-fails"
 run_suite "Phase 2: evaluator" \
  "lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx lib/common-lisp/tests/eval.sx" \
  "cl-test-pass" "cl-test-fail" "cl-test-fails"
 run_suite "Phase 3: condition system" \
  "lib/common-lisp/runtime.sx lib/common-lisp/tests/conditions.sx" \
  "passed" "failed" "failures"
 run_suite "Phase 3: restart-demo" \
  "lib/common-lisp/runtime.sx lib/common-lisp/tests/programs/restart-demo.sx" \
  "demo-passed" "demo-failed" "demo-failures"
 run_suite "Phase 3: parse-recover" \
  "lib/common-lisp/runtime.sx lib/common-lisp/tests/programs/parse-recover.sx" \
  "parse-passed" "parse-failed" "parse-failures"
 run_suite "Phase 3: interactive-debugger" \
  "lib/common-lisp/runtime.sx lib/common-lisp/tests/programs/interactive-debugger.sx" \
  "debugger-passed" "debugger-failed" "debugger-failures"
 run_suite "Phase 4: CLOS" \
  "lib/common-lisp/runtime.sx lib/common-lisp/clos.sx lib/common-lisp/tests/clos.sx" \
  "passed" "failed" "failures"
 run_suite "Phase 4: geometry" \
  "lib/common-lisp/runtime.sx lib/common-lisp/clos.sx lib/common-lisp/tests/programs/geometry.sx" \
  "geo-passed" "geo-failed" "geo-failures"
 run_suite "Phase 4: mop-trace" \
  "lib/common-lisp/runtime.sx lib/common-lisp/clos.sx lib/common-lisp/tests/programs/mop-trace.sx" \
  "mop-passed" "mop-failed" "mop-failures"
 run_suite "Phase 5: macros+LOOP" \
  "lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx lib/common-lisp/loop.sx lib/common-lisp/tests/macros.sx" \
  "macro-passed" "macro-failed" "macro-failures"
 run_suite "Phase 6: stdlib" \
  "lib/common-lisp/reader.sx lib/common-lisp/parser.sx lib/common-lisp/eval.sx lib/common-lisp/tests/stdlib.sx" \
  "stdlib-passed" "stdlib-failed" "stdlib-failures"
 echo ""
 echo "=== Total: $TOTAL_PASS passed, $TOTAL_FAIL failed ==="
 # ── write scoreboard.json ─────────────────────────────────────────────────
 SCORE_DIR="lib/common-lisp"
 JSON="$SCORE_DIR/scoreboard.json"
 {
  printf '{\n'
  printf '  "generated": "%s",\n' "$(date -u +%Y-%m-%dT%H:%M:%SZ)"
  printf '  "total_pass": %d,\n' "$TOTAL_PASS"
  printf '  "total_fail": %d,\n' "$TOTAL_FAIL"
  printf '  "suites": [\n'
  first=true
  for i in "${!SUITE_NAMES[@]}"; do
    if [ "$first" = "true" ]; then first=false; else printf ',\n'; fi
    printf '    {"name": "%s", "pass": %d, "fail": %d}' \
      "${SUITE_NAMES[$i]}" "${SUITE_PASS[$i]}" "${SUITE_FAIL[$i]}"
  done
  printf '\n  ]\n'
  printf '}\n'
 } > "$JSON"
 # ── write scoreboard.md ───────────────────────────────────────────────────
 MD="$SCORE_DIR/scoreboard.md"
 {
  printf '# Common Lisp on SX — Scoreboard\n\n'
  printf '_Generated: %s_\n\n' "$(date -u '+%Y-%m-%d %H:%M UTC')"
  printf '| Suite | Pass | Fail | Status |\n'
  printf '|-------|------|------|--------|\n'
  for i in "${!SUITE_NAMES[@]}"; do
    p="${SUITE_PASS[$i]}" f="${SUITE_FAIL[$i]}"
    status=""
    if [ "$f" = "0" ] && [ "${p:-0}" -gt 0 ] 2>/dev/null; then
      status="pass"
    else
      status="FAIL"
    fi
    printf '| %s | %s | %s | %s |\n' "${SUITE_NAMES[$i]}" "$p" "$f" "$status"
  done
  printf '\n**Total: %d passed, %d failed**\n' "$TOTAL_PASS" "$TOTAL_FAIL"
 } > "$MD"
 echo ""
 echo "Scoreboard written to $JSON and $MD"
 [ "$TOTAL_FAIL" -eq 0 ]
--- a/lib/common-lisp/eval.sx
+++ b/lib/common-lisp/eval.sx
--- a/lib/common-lisp/loop.sx
+++ b/lib/common-lisp/loop.sx
@@ -1,623 +0,0 @@
 ;; lib/common-lisp/loop.sx — The LOOP macro for CL-on-SX
 ;;
 ;; Supported clauses:
 ;;   for VAR in LIST             — iterate over list
 ;;   for VAR across VECTOR       — alias for 'in'
 ;;   for VAR from N              — numeric iteration (to/upto/below/downto/above/by)
 ;;   for VAR = EXPR [then EXPR]  — general iteration
 ;;   while COND                  — stop when false
 ;;   until COND                  — stop when true
 ;;   repeat N                    — repeat N times
 ;;   collect EXPR [into VAR]
 ;;   append EXPR [into VAR]
 ;;   nconc EXPR [into VAR]
 ;;   sum EXPR [into VAR]
 ;;   count EXPR [into VAR]
 ;;   maximize EXPR [into VAR]
 ;;   minimize EXPR [into VAR]
 ;;   do FORM...
 ;;   when/if COND clause...
 ;;   unless COND clause...
 ;;   finally FORM...
 ;;   always COND
 ;;   never COND
 ;;   thereis COND
 ;;   named BLOCK-NAME
 ;;
 ;; Depends on: lib/common-lisp/runtime.sx, lib/common-lisp/eval.sx already loaded.
 ;; Uses defmacro in the CL evaluator.
 ;; ── LOOP expansion driver ─────────────────────────────────────────────────
 ;; cl-loop-parse: analyse the flat LOOP clause list and build a Lisp form.
 ;; Returns a (block NAME (let (...) (tagbody ...))) form.
 (define
  cl-loop-parse
  (fn
    (clauses)
    (define block-name nil)
    (define with-bindings (list))
    (define for-bindings (list))
    (define test-forms (list))
    (define repeat-var nil)
    (define repeat-count nil)
    (define body-forms (list))
    (define accum-vars (dict))
    (define accum-clauses (dict))
    (define result-var nil)
    (define finally-forms (list))
    (define return-expr nil)
    (define termination nil)
    (define idx 0)
    (define (lp-peek) (if (< idx (len clauses)) (nth clauses idx) nil))
    (define
      (next!)
      (let ((v (lp-peek))) (do (set! idx (+ idx 1)) v)))
    (define
      (skip-if pred)
      (if (and (not (nil? (lp-peek))) (pred (lp-peek))) (next!) nil))
    (define (upcase-str s) (if (string? s) (upcase s) s))
    (define (kw? s k) (= (upcase-str s) k))
    (define
      (make-accum-var!)
      (if
        (nil? result-var)
        (do (set! result-var "#LOOP-RESULT") result-var)
        result-var))
    (define
      (add-accum! type expr into-var)
      (let
        ((v (if (nil? into-var) (make-accum-var!) into-var)))
        (if
          (not (has-key? accum-vars v))
          (do
            (set!
              accum-vars
              (assoc
                accum-vars
                v
                (cond
                  ((= type ":sum") 0)
                  ((= type ":count") 0)
                  ((= type ":maximize") nil)
                  ((= type ":minimize") nil)
                  (:else (list)))))
            (set! accum-clauses (assoc accum-clauses v type))))
        (let
          ((update (cond ((= type ":collect") (list "SETQ" v (list "APPEND" v (list "LIST" expr)))) ((= type ":append") (list "SETQ" v (list "APPEND" v expr))) ((= type ":nconc") (list "SETQ" v (list "NCONC" v expr))) ((= type ":sum") (list "SETQ" v (list "+" v expr))) ((= type ":count") (list "SETQ" v (list "+" v (list "IF" expr 1 0)))) ((= type ":maximize") (list "SETQ" v (list "IF" (list "OR" (list "NULL" v) (list ">" expr v)) expr v))) ((= type ":minimize") (list "SETQ" v (list "IF" (list "OR" (list "NULL" v) (list "<" expr v)) expr v))) (:else (list "SETQ" v (list "APPEND" v (list "LIST" expr)))))))
          (set! body-forms (append body-forms (list update))))))
    (define
      (parse-clause!)
      (let
        ((tok (lp-peek)))
        (if
          (nil? tok)
          nil
          (do
            (let
              ((u (upcase-str tok)))
              (cond
                ((= u "NAMED")
                  (do (next!) (set! block-name (next!)) (parse-clause!)))
                ((= u "WITH")
                  (do
                    (next!)
                    (let
                      ((var (next!)))
                      (skip-if (fn (s) (kw? s "=")))
                      (let
                        ((init (next!)))
                        (set!
                          with-bindings
                          (append with-bindings (list (list var init))))
                        (parse-clause!)))))
                ((= u "FOR")
                  (do
                    (next!)
                    (let
                      ((var (next!)))
                      (let
                        ((kw2 (upcase-str (lp-peek))))
                        (cond
                          ((or (= kw2 "IN") (= kw2 "ACROSS"))
                            (do
                              (next!)
                              (let
                                ((lst-expr (next!))
                                  (tail-var (str "#TAIL-" var)))
                                (set!
                                  for-bindings
                                  (append for-bindings (list {:list lst-expr :tail tail-var :type ":list" :var var})))
                                (parse-clause!))))
                          ((= kw2 "=")
                            (do
                              (next!)
                              (let
                                ((init-expr (next!)))
                                (let
                                  ((then-expr (if (kw? (lp-peek) "THEN") (do (next!) (next!)) init-expr)))
                                  (set!
                                    for-bindings
                                    (append for-bindings (list {:type ":general" :then then-expr :init init-expr :var var})))
                                  (parse-clause!)))))
                          ((or (= kw2 "FROM") (= kw2 "DOWNFROM") (= kw2 "UPFROM"))
                            (do
                              (next!)
                              (let
                                ((from-expr (next!))
                                  (dir (if (= kw2 "DOWNFROM") ":down" ":up"))
                                  (limit-expr nil)
                                  (limit-type nil)
                                  (step-expr 1))
                                (let
                                  ((lkw (upcase-str (lp-peek))))
                                  (when
                                    (or
                                      (= lkw "TO")
                                      (= lkw "UPTO")
                                      (= lkw "BELOW")
                                      (= lkw "DOWNTO")
                                      (= lkw "ABOVE"))
                                    (do
                                      (next!)
                                      (set! limit-type lkw)
                                      (set! limit-expr (next!)))))
                                (when
                                  (kw? (lp-peek) "BY")
                                  (do (next!) (set! step-expr (next!))))
                                (set!
                                  for-bindings
                                  (append for-bindings (list {:dir dir :step step-expr :from from-expr :type ":numeric" :limit-type limit-type :var var :limit limit-expr})))
                                (parse-clause!))))
                          ((or (= kw2 "TO") (= kw2 "UPTO") (= kw2 "BELOW"))
                            (do
                              (next!)
                              (let
                                ((limit-expr (next!))
                                  (step-expr 1))
                                (when
                                  (kw? (lp-peek) "BY")
                                  (do (next!) (set! step-expr (next!))))
                                (set!
                                  for-bindings
                                  (append for-bindings (list {:dir ":up" :step step-expr :from 0 :type ":numeric" :limit-type kw2 :var var :limit limit-expr})))
                                (parse-clause!))))
                          (:else (do (parse-clause!))))))))
                ((= u "WHILE")
                  (do
                    (next!)
                    (set! test-forms (append test-forms (list {:expr (next!) :type ":while"})))
                    (parse-clause!)))
                ((= u "UNTIL")
                  (do
                    (next!)
                    (set! test-forms (append test-forms (list {:expr (next!) :type ":until"})))
                    (parse-clause!)))
                ((= u "REPEAT")
                  (do
                    (next!)
                    (set! repeat-count (next!))
                    (set! repeat-var "#REPEAT-COUNT")
                    (parse-clause!)))
                ((or (= u "COLLECT") (= u "COLLECTING"))
                  (do
                    (next!)
                    (let
                      ((expr (next!)) (into-var nil))
                      (when
                        (kw? (lp-peek) "INTO")
                        (do (next!) (set! into-var (next!))))
                      (add-accum! ":collect" expr into-var)
                      (parse-clause!))))
                ((or (= u "APPEND") (= u "APPENDING"))
                  (do
                    (next!)
                    (let
                      ((expr (next!)) (into-var nil))
                      (when
                        (kw? (lp-peek) "INTO")
                        (do (next!) (set! into-var (next!))))
                      (add-accum! ":append" expr into-var)
                      (parse-clause!))))
                ((or (= u "NCONC") (= u "NCONCING"))
                  (do
                    (next!)
                    (let
                      ((expr (next!)) (into-var nil))
                      (when
                        (kw? (lp-peek) "INTO")
                        (do (next!) (set! into-var (next!))))
                      (add-accum! ":nconc" expr into-var)
                      (parse-clause!))))
                ((or (= u "SUM") (= u "SUMMING"))
                  (do
                    (next!)
                    (let
                      ((expr (next!)) (into-var nil))
                      (when
                        (kw? (lp-peek) "INTO")
                        (do (next!) (set! into-var (next!))))
                      (add-accum! ":sum" expr into-var)
                      (parse-clause!))))
                ((or (= u "COUNT") (= u "COUNTING"))
                  (do
                    (next!)
                    (let
                      ((expr (next!)) (into-var nil))
                      (when
                        (kw? (lp-peek) "INTO")
                        (do (next!) (set! into-var (next!))))
                      (add-accum! ":count" expr into-var)
                      (parse-clause!))))
                ((or (= u "MAXIMIZE") (= u "MAXIMIZING"))
                  (do
                    (next!)
                    (let
                      ((expr (next!)) (into-var nil))
                      (when
                        (kw? (lp-peek) "INTO")
                        (do (next!) (set! into-var (next!))))
                      (add-accum! ":maximize" expr into-var)
                      (parse-clause!))))
                ((or (= u "MINIMIZE") (= u "MINIMIZING"))
                  (do
                    (next!)
                    (let
                      ((expr (next!)) (into-var nil))
                      (when
                        (kw? (lp-peek) "INTO")
                        (do (next!) (set! into-var (next!))))
                      (add-accum! ":minimize" expr into-var)
                      (parse-clause!))))
                ((= u "DO")
                  (do
                    (next!)
                    (define
                      (loop-kw? s)
                      (let
                        ((us (upcase-str s)))
                        (some
                          (fn (k) (= us k))
                          (list
                            "FOR"
                            "WITH"
                            "WHILE"
                            "UNTIL"
                            "REPEAT"
                            "COLLECT"
                            "COLLECTING"
                            "APPEND"
                            "APPENDING"
                            "NCONC"
                            "NCONCING"
                            "SUM"
                            "SUMMING"
                            "COUNT"
                            "COUNTING"
                            "MAXIMIZE"
                            "MAXIMIZING"
                            "MINIMIZE"
                            "MINIMIZING"
                            "DO"
                            "WHEN"
                            "IF"
                            "UNLESS"
                            "FINALLY"
                            "ALWAYS"
                            "NEVER"
                            "THEREIS"
                            "RETURN"
                            "NAMED"))))
                    (define
                      (collect-do-forms!)
                      (if
                        (or (nil? (lp-peek)) (loop-kw? (lp-peek)))
                        nil
                        (do
                          (set!
                            body-forms
                            (append body-forms (list (next!))))
                          (collect-do-forms!))))
                    (collect-do-forms!)
                    (parse-clause!)))
                ((or (= u "WHEN") (= u "IF"))
                  (do
                    (next!)
                    (let
                      ((cond-expr (next!))
                       (body-start (len body-forms)))
                      (parse-clause!)
                      ;; wrap forms added since body-start in (WHEN cond ...)
                      (when (> (len body-forms) body-start)
                        (let ((added (list (nth body-forms body-start))))
                          (set! body-forms
                            (append
                              (if (> body-start 0)
                                (list (nth body-forms (- body-start 1)))
                                (list))
                              (list (list "WHEN" cond-expr (first added)))))
                          nil)))))
                ((= u "UNLESS")
                  (do
                    (next!)
                    (let
                      ((cond-expr (next!))
                       (body-start (len body-forms)))
                      (parse-clause!)
                      (when (> (len body-forms) body-start)
                        (let ((added (list (nth body-forms body-start))))
                          (set! body-forms
                            (append
                              (if (> body-start 0)
                                (list (nth body-forms (- body-start 1)))
                                (list))
                              (list (list "UNLESS" cond-expr (first added)))))
                          nil)))))
                ((= u "ALWAYS")
                  (do (next!) (set! termination {:expr (next!) :type ":always"}) (parse-clause!)))
                ((= u "NEVER")
                  (do (next!) (set! termination {:expr (next!) :type ":never"}) (parse-clause!)))
                ((= u "THEREIS")
                  (do (next!) (set! termination {:expr (next!) :type ":thereis"}) (parse-clause!)))
                ((= u "RETURN")
                  (do (next!) (set! return-expr (next!)) (parse-clause!)))
                ((= u "FINALLY")
                  (do
                    (next!)
                    (define
                      (collect-finally!)
                      (if
                        (nil? (lp-peek))
                        nil
                        (do
                          (set!
                            finally-forms
                            (append finally-forms (list (next!))))
                          (collect-finally!))))
                    (collect-finally!)
                    (parse-clause!)))
                (:else
                  (do
                    (set! body-forms (append body-forms (list (next!))))
                    (parse-clause!)))))))))
    (parse-clause!)
    (define let-bindings (list))
    (for-each
      (fn (wb) (set! let-bindings (append let-bindings (list wb))))
      with-bindings)
    (for-each
      (fn
        (v)
        (set!
          let-bindings
          (append let-bindings (list (list v (get accum-vars v))))))
      (keys accum-vars))
    (when
      (not (nil? repeat-var))
      (set!
        let-bindings
        (append let-bindings (list (list repeat-var repeat-count)))))
    (for-each
      (fn
        (fb)
        (let
          ((type (get fb "type")))
          (cond
            ((= type ":list")
              (do
                (set!
                  let-bindings
                  (append
                    let-bindings
                    (list (list (get fb "tail") (get fb "list")))
                    (list
                      (list
                        (get fb "var")
                        (list
                          "IF"
                          (list "CONSP" (get fb "tail"))
                          (list "CAR" (get fb "tail"))
                          nil)))))
                nil))
            ((= type ":numeric")
              (set!
                let-bindings
                (append
                  let-bindings
                  (list (list (get fb "var") (get fb "from"))))))
            ((= type ":general")
              (set!
                let-bindings
                (append
                  let-bindings
                  (list (list (get fb "var") (get fb "init"))))))
            (:else nil))))
      for-bindings)
    (define all-tests (list))
    (when
      (not (nil? repeat-var))
      (set!
        all-tests
        (append
          all-tests
          (list
            (list
              "WHEN"
              (list "<=" repeat-var 0)
              (list "RETURN-FROM" block-name (if (nil? result-var) nil result-var))))))
      (set!
        body-forms
        (append
          (list (list "SETQ" repeat-var (list "-" repeat-var 1)))
          body-forms)))
    (for-each
      (fn
        (fb)
        (when
          (= (get fb "type") ":list")
          (let
            ((tvar (get fb "tail")) (var (get fb "var")))
            (set!
              all-tests
              (append
                all-tests
                (list
                  (list
                    "WHEN"
                    (list "NULL" tvar)
                    (list
                      "RETURN-FROM"
                      block-name
                      (if (nil? result-var) nil result-var))))))
            (set!
              body-forms
              (append
                body-forms
                (list
                  (list "SETQ" tvar (list "CDR" tvar))
                  (list
                    "SETQ"
                    var
                    (list "IF" (list "CONSP" tvar) (list "CAR" tvar) nil))))))))
      for-bindings)
    (for-each
      (fn
        (fb)
        (when
          (= (get fb "type") ":numeric")
          (let
            ((var (get fb "var"))
              (dir (get fb "dir"))
              (lim (get fb "limit"))
              (ltype (get fb "limit-type"))
              (step (get fb "step")))
            (when
              (not (nil? lim))
              (let
                ((test-op (cond ((or (= ltype "BELOW") (= ltype "ABOVE")) (if (= dir ":up") ">=" "<=")) ((or (= ltype "TO") (= ltype "UPTO")) ">") ((= ltype "DOWNTO") "<") (:else (if (= dir ":up") ">" "<")))))
                (set!
                  all-tests
                  (append
                    all-tests
                    (list
                      (list
                        "WHEN"
                        (list test-op var lim)
                        (list
                          "RETURN-FROM"
                          block-name
                          (if (nil? result-var) nil result-var))))))))
            (let
              ((step-op (if (or (= dir ":down") (= ltype "DOWNTO") (= ltype "ABOVE")) "-" "+")))
              (set!
                body-forms
                (append
                  body-forms
                  (list (list "SETQ" var (list step-op var step)))))))))
      for-bindings)
    (for-each
      (fn
        (fb)
        (when
          (= (get fb "type") ":general")
          (set!
            body-forms
            (append
              body-forms
              (list (list "SETQ" (get fb "var") (get fb "then")))))))
      for-bindings)
    (for-each
      (fn
        (t)
        (let
          ((type (get t "type")) (expr (get t "expr")))
          (if
            (= type ":while")
            (set!
              all-tests
              (append
                all-tests
                (list
                  (list
                    "WHEN"
                    (list "NOT" expr)
                    (list
                      "RETURN-FROM"
                      block-name
                      (if (nil? result-var) nil result-var))))))
            (set!
              all-tests
              (append
                all-tests
                (list
                  (list
                    "WHEN"
                    expr
                    (list
                      "RETURN-FROM"
                      block-name
                      (if (nil? result-var) nil result-var)))))))))
      test-forms)
    (when
      (not (nil? termination))
      (let
        ((type (get termination "type")) (expr (get termination "expr")))
        (cond
          ((= type ":always")
            (set!
              body-forms
              (append
                body-forms
                (list
                  (list "UNLESS" expr (list "RETURN-FROM" block-name false)))))
            (set! return-expr true))
          ((= type ":never")
            (set!
              body-forms
              (append
                body-forms
                (list
                  (list "WHEN" expr (list "RETURN-FROM" block-name false)))))
            (set! return-expr true))
          ((= type ":thereis")
            (set!
              body-forms
              (append
                body-forms
                (list
                  (list "WHEN" expr (list "RETURN-FROM" block-name expr)))))))))
    (define tag "#LOOP-START")
    (define
      inner-body
      (append (list tag) all-tests body-forms (list (list "GO" tag))))
    (define
      result-form
      (cond
        ((not (nil? return-expr)) return-expr)
        ((not (nil? result-var)) result-var)
        (:else nil)))
    (define
      full-body
      (if
        (= (len let-bindings) 0)
        (append
          (list "PROGN")
          (list (append (list "TAGBODY") inner-body))
          finally-forms
          (list result-form))
        (list
          "LET*"
          let-bindings
          (append (list "TAGBODY") inner-body)
          (append (list "PROGN") finally-forms (list result-form)))))
    (list "BLOCK" block-name full-body)))
 ;; ── Install LOOP as a CL macro ────────────────────────────────────────────
 ;;
 ;; (loop ...) — the form arrives with head "LOOP" and rest = clauses.
 ;; The macro fn receives the full form.
 (dict-set!
  cl-macro-registry
  "LOOP"
  (fn (form env) (cl-loop-parse (rest form))))
--- a/lib/common-lisp/parser.sx
+++ b/lib/common-lisp/parser.sx
@@ -1,377 +0,0 @@
 ;; Common Lisp reader — converts token stream to CL AST forms.
 ;;
 ;; Depends on: lib/common-lisp/reader.sx  (cl-tokenize)
 ;;
 ;; AST representation:
 ;;   integer/float         → SX number (or {:cl-type "float"/:ratio ...})
 ;;   string "hello"        → {:cl-type "string" :value "hello"}
 ;;   symbol FOO            → SX string "FOO"  (upcase)
 ;;   symbol NIL            → nil
 ;;   symbol T              → true
 ;;   :keyword              → {:cl-type "keyword" :name "FOO"}
 ;;   #\char                → {:cl-type "char"    :value "a"}
 ;;   #:uninterned          → {:cl-type "uninterned" :name "FOO"}
 ;;   ratio 1/3             → {:cl-type "ratio"   :value "1/3"}
 ;;   float 3.14            → {:cl-type "float"   :value "3.14"}
 ;;   proper list (a b c)   → SX list (a b c)
 ;;   dotted pair (a . b)   → {:cl-type "cons" :car a :cdr b}
 ;;   vector #(a b)         → {:cl-type "vector" :elements (list a b)}
 ;;   'x                    → ("QUOTE" x)
 ;;   `x                    → ("QUASIQUOTE" x)
 ;;   ,x                    → ("UNQUOTE" x)
 ;;   ,@x                   → ("UNQUOTE-SPLICING" x)
 ;;   #'x                   → ("FUNCTION" x)
 ;;
 ;; Public API:
 ;;   (cl-read src)         — parse first form from string, return form
 ;;   (cl-read-all src)     — parse all top-level forms, return list
 ;; ── number conversion ─────────────────────────────────────────────
 (define
  cl-hex-val
  (fn
    (c)
    (let
      ((o (cl-ord c)))
      (cond
        ((and (>= o 48) (<= o 57)) (- o 48))
        ((and (>= o 65) (<= o 70)) (+ 10 (- o 65)))
        ((and (>= o 97) (<= o 102)) (+ 10 (- o 97)))
        (:else 0)))))
 (define
  cl-parse-radix-str
  (fn
    (s radix start)
    (let
      ((n (string-length s)) (i start) (acc 0))
      (define
        loop
        (fn
          ()
          (when
            (< i n)
            (do
              (set! acc (+ (* acc radix) (cl-hex-val (substring s i (+ i 1)))))
              (set! i (+ i 1))
              (loop)))))
      (loop)
      acc)))
 (define
  cl-convert-integer
  (fn
    (s)
    (let
      ((n (string-length s)) (neg false))
      (cond
        ((and (> n 2) (= (substring s 0 1) "#"))
          (let
            ((letter (downcase (substring s 1 2))))
            (cond
              ((= letter "x") (cl-parse-radix-str s 16 2))
              ((= letter "b") (cl-parse-radix-str s 2 2))
              ((= letter "o") (cl-parse-radix-str s 8 2))
              (:else (parse-int s 0)))))
        (:else (parse-int s 0))))))
 ;; ── reader ────────────────────────────────────────────────────────
 ;; Read one form from token list.
 ;; Returns {:form F :rest remaining-toks} or {:form nil :rest toks :eof true}
 (define
  cl-read-form
  (fn
    (toks)
    (if
      (not toks)
      {:form nil :rest toks :eof true}
      (let
        ((tok (nth toks 0)) (nxt (rest toks)))
        (let
          ((type (get tok "type")) (val (get tok "value")))
          (cond
            ((= type "eof") {:form nil :rest toks :eof true})
            ((= type "integer") {:form (cl-convert-integer val) :rest nxt})
            ((= type "float") {:form {:cl-type "float" :value val} :rest nxt})
            ((= type "ratio") {:form {:cl-type "ratio" :value val} :rest nxt})
            ((= type "string") {:form {:cl-type "string" :value val} :rest nxt})
            ((= type "char") {:form {:cl-type "char" :value val} :rest nxt})
            ((= type "keyword") {:form {:cl-type "keyword" :name val} :rest nxt})
            ((= type "uninterned") {:form {:cl-type "uninterned" :name val} :rest nxt})
            ((= type "symbol")
              (cond
                ((= val "NIL") {:form nil :rest nxt})
                ((= val "T") {:form true :rest nxt})
                (:else {:form val :rest nxt})))
            ;; list forms
            ((= type "lparen") (cl-read-list nxt))
            ((= type "hash-paren") (cl-read-vector nxt))
            ;; reader macros that wrap the next form
            ((= type "quote") (cl-read-wrap "QUOTE" nxt))
            ((= type "backquote") (cl-read-wrap "QUASIQUOTE" nxt))
            ((= type "comma") (cl-read-wrap "UNQUOTE" nxt))
            ((= type "comma-at") (cl-read-wrap "UNQUOTE-SPLICING" nxt))
            ((= type "hash-quote") (cl-read-wrap "FUNCTION" nxt))
            ;; skip unrecognised tokens
            (:else (cl-read-form nxt))))))))
 ;; Wrap next form in a list: (name form)
 (define
  cl-read-wrap
  (fn
    (name toks)
    (let
      ((inner (cl-read-form toks)))
      {:form (list name (get inner "form")) :rest (get inner "rest")})))
 ;; Read list forms until ')'; handles dotted pair (a . b)
 ;; Called after consuming '('
 (define
  cl-read-list
  (fn
    (toks)
    (let
      ((result (cl-read-list-items toks (list))))
      {:form (get result "items") :rest (get result "rest")})))
 (define
  cl-read-list-items
  (fn
    (toks acc)
    (if
      (not toks)
      {:items acc :rest toks}
      (let
        ((tok (nth toks 0)))
        (let
          ((type (get tok "type")))
          (cond
            ((= type "eof") {:items acc :rest toks})
            ((= type "rparen") {:items acc :rest (rest toks)})
            ;; dotted pair: read one more form then expect ')'
            ((= type "dot")
              (let
                ((cdr-result (cl-read-form (rest toks))))
                (let
                  ((cdr-form (get cdr-result "form"))
                    (after-cdr (get cdr-result "rest")))
                  ;; skip the closing ')'
                  (let
                    ((close (if after-cdr (nth after-cdr 0) nil)))
                    (let
                      ((remaining
                          (if
                            (and close (= (get close "type") "rparen"))
                            (rest after-cdr)
                            after-cdr)))
                      ;; build dotted structure
                      (let
                        ((dotted (cl-build-dotted acc cdr-form)))
                        {:items dotted :rest remaining}))))))
            (:else
              (let
                ((item (cl-read-form toks)))
                (cl-read-list-items
                  (get item "rest")
                  (concat acc (list (get item "form"))))))))))))
 ;; Build dotted form: (a b . c) → ((DOTTED a b) . c) style
 ;; In CL (a b c . d) means a proper dotted structure.
 ;; We represent it as {:cl-type "cons" :car a :cdr (list->dotted b c d)}
 (define
  cl-build-dotted
  (fn
    (head-items tail)
    (if
      (= (len head-items) 0)
      tail
      (if
        (= (len head-items) 1)
        {:cl-type "cons" :car (nth head-items 0) :cdr tail}
        (let
          ((last-item (nth head-items (- (len head-items) 1)))
            (but-last (slice head-items 0 (- (len head-items) 1))))
          {:cl-type "cons"
            :car (cl-build-dotted but-last (list last-item))
            :cdr tail})))))
 ;; Read vector #(…) elements until ')'
 (define
  cl-read-vector
  (fn
    (toks)
    (let
      ((result (cl-read-vector-items toks (list))))
      {:form {:cl-type "vector" :elements (get result "items")} :rest (get result "rest")})))
 (define
  cl-read-vector-items
  (fn
    (toks acc)
    (if
      (not toks)
      {:items acc :rest toks}
      (let
        ((tok (nth toks 0)))
        (let
          ((type (get tok "type")))
          (cond
            ((= type "eof") {:items acc :rest toks})
            ((= type "rparen") {:items acc :rest (rest toks)})
            (:else
              (let
                ((item (cl-read-form toks)))
                (cl-read-vector-items
                  (get item "rest")
                  (concat acc (list (get item "form"))))))))))))
 ;; ── lambda-list parser ───────────────────────────────────────────
 ;;
 ;; (cl-parse-lambda-list forms) — parse a list of CL forms (already read)
 ;; into a structured dict:
 ;;   {:required (list sym ...)
 ;;    :optional (list {:name N :default D :supplied S} ...)
 ;;    :rest     nil | "SYM"
 ;;    :key      (list {:name N :keyword K :default D :supplied S} ...)
 ;;    :allow-other-keys false | true
 ;;    :aux      (list {:name N :init I} ...)}
 ;;
 ;; Symbols arrive as SX strings (upcase). &-markers are strings like "&OPTIONAL".
 ;; Key params: keyword is the upcase name string; caller uses it as :keyword.
 ;; Supplied-p: nil when absent.
 (define
  cl-parse-opt-spec
  (fn
    (spec)
    (if
      (list? spec)
      {:name (nth spec 0)
        :default (if (> (len spec) 1) (nth spec 1) nil)
        :supplied (if (> (len spec) 2) (nth spec 2) nil)}
      {:name spec :default nil :supplied nil})))
 (define
  cl-parse-key-spec
  (fn
    (spec)
    (if
      (list? spec)
      (let
        ((first (nth spec 0)))
        (if
          (list? first)
          ;; ((:keyword var) default supplied-p)
          {:name (nth first 1)
            :keyword (get first "name")
            :default (if (> (len spec) 1) (nth spec 1) nil)
            :supplied (if (> (len spec) 2) (nth spec 2) nil)}
          ;; (var default supplied-p)
          {:name first
            :keyword first
            :default (if (> (len spec) 1) (nth spec 1) nil)
            :supplied (if (> (len spec) 2) (nth spec 2) nil)}))
      {:name spec :keyword spec :default nil :supplied nil})))
 (define
  cl-parse-aux-spec
  (fn
    (spec)
    (if
      (list? spec)
      {:name (nth spec 0) :init (if (> (len spec) 1) (nth spec 1) nil)}
      {:name spec :init nil})))
 (define
  cl-parse-lambda-list
  (fn
    (forms)
    (let
      ((state "required")
        (required (list))
        (optional (list))
        (rest-name nil)
        (key (list))
        (allow-other-keys false)
        (aux (list)))
      (define
        scan
        (fn
          (items)
          (when
            (> (len items) 0)
            (let
              ((item (nth items 0)) (tail (rest items)))
              (cond
                ((= item "&OPTIONAL")
                  (do (set! state "optional") (scan tail)))
                ((= item "&REST")
                  (do (set! state "rest") (scan tail)))
                ((= item "&BODY")
                  (do (set! state "rest") (scan tail)))
                ((= item "&KEY")
                  (do (set! state "key") (scan tail)))
                ((= item "&AUX")
                  (do (set! state "aux") (scan tail)))
                ((= item "&ALLOW-OTHER-KEYS")
                  (do (set! allow-other-keys true) (scan tail)))
                ((= state "required")
                  (do (append! required item) (scan tail)))
                ((= state "optional")
                  (do (append! optional (cl-parse-opt-spec item)) (scan tail)))
                ((= state "rest")
                  (do (set! rest-name item) (set! state "done") (scan tail)))
                ((= state "key")
                  (do (append! key (cl-parse-key-spec item)) (scan tail)))
                ((= state "aux")
                  (do (append! aux (cl-parse-aux-spec item)) (scan tail)))
                (:else (scan tail)))))))
      (scan forms)
      {:required required
        :optional optional
        :rest rest-name
        :key key
        :allow-other-keys allow-other-keys
        :aux aux})))
 ;; Convenience: parse lambda list from a CL source string
 (define
  cl-parse-lambda-list-str
  (fn
    (src)
    (cl-parse-lambda-list (cl-read src))))
 ;; ── public API ────────────────────────────────────────────────────
 (define
  cl-read
  (fn
    (src)
    (let
      ((toks (cl-tokenize src)))
      (get (cl-read-form toks) "form"))))
 (define
  cl-read-all
  (fn
    (src)
    (let
      ((toks (cl-tokenize src)))
      (define
        loop
        (fn
          (toks acc)
          (if
            (or (not toks) (= (get (nth toks 0) "type") "eof"))
            acc
            (let
              ((result (cl-read-form toks)))
              (if
                (get result "eof")
                acc
                (loop (get result "rest") (concat acc (list (get result "form")))))))))
      (loop toks (list)))))
--- a/lib/common-lisp/reader.sx
+++ b/lib/common-lisp/reader.sx
@@ -1,381 +0,0 @@
 ;; Common Lisp tokenizer
 ;;
 ;; Tokens: {:type T :value V :pos P}
 ;;
 ;; Types:
 ;;   "symbol"      — FOO, PKG:SYM, PKG::SYM, T, NIL (upcase)
 ;;   "keyword"     — :foo (value is upcase name without colon)
 ;;   "integer"     — 42, -5, #xFF, #b1010, #o17 (string)
 ;;   "float"       — 3.14, 1.0e10 (string)
 ;;   "ratio"       — 1/3 (string "N/D")
 ;;   "string"      — unescaped content
 ;;   "char"        — single-character string
 ;;   "lparen"  "rparen"  "quote"  "backquote"  "comma"  "comma-at"
 ;;   "hash-quote"  — #'
 ;;   "hash-paren"  — #(
 ;;   "uninterned"  — #:foo (upcase name)
 ;;   "dot"         — standalone . (dotted pair separator)
 ;;   "eof"
 (define cl-make-tok (fn (type value pos) {:type type :value value :pos pos}))
 ;; ── char ordinal table ────────────────────────────────────────────
 (define
  cl-ord-table
  (let
    ((t (dict)) (i 0))
    (define
      cl-fill
      (fn
        ()
        (when
          (< i 128)
          (do
            (dict-set! t (char-from-code i) i)
            (set! i (+ i 1))
            (cl-fill)))))
    (cl-fill)
    t))
 (define cl-ord (fn (c) (or (get cl-ord-table c) 0)))
 ;; ── character predicates ──────────────────────────────────────────
 (define cl-digit? (fn (c) (and (>= (cl-ord c) 48) (<= (cl-ord c) 57))))
 (define
  cl-hex?
  (fn
    (c)
    (or
      (cl-digit? c)
      (and (>= (cl-ord c) 65) (<= (cl-ord c) 70))
      (and (>= (cl-ord c) 97) (<= (cl-ord c) 102)))))
 (define cl-octal? (fn (c) (and (>= (cl-ord c) 48) (<= (cl-ord c) 55))))
 (define cl-binary? (fn (c) (or (= c "0") (= c "1"))))
 (define cl-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
 (define
  cl-alpha?
  (fn
    (c)
    (or
      (and (>= (cl-ord c) 65) (<= (cl-ord c) 90))
      (and (>= (cl-ord c) 97) (<= (cl-ord c) 122)))))
 ;; Characters that end a token (whitespace + terminating macro chars)
 (define
  cl-terminating?
  (fn
    (c)
    (or
      (cl-ws? c)
      (= c "(")
      (= c ")")
      (= c "\"")
      (= c ";")
      (= c "`")
      (= c ","))))
 ;; Symbol constituent: not terminating, not reader-special
 (define
  cl-sym-char?
  (fn
    (c)
    (not
      (or
        (cl-terminating? c)
        (= c "#")
        (= c "|")
        (= c "\\")
        (= c "'")))))
 ;; ── named character table ─────────────────────────────────────────
 (define
  cl-named-chars
  {:space " "
    :newline "\n"
    :tab "\t"
    :return "\r"
    :backspace (char-from-code 8)
    :rubout (char-from-code 127)
    :delete (char-from-code 127)
    :escape (char-from-code 27)
    :altmode (char-from-code 27)
    :null (char-from-code 0)
    :nul (char-from-code 0)
    :page (char-from-code 12)
    :formfeed (char-from-code 12)})
 ;; ── main tokenizer ────────────────────────────────────────────────
 (define
  cl-tokenize
  (fn
    (src)
    (let
      ((pos 0) (n (string-length src)) (toks (list)))
      (define at (fn () (if (< pos n) (substring src pos (+ pos 1)) nil)))
      (define peek1 (fn () (if (< (+ pos 1) n) (substring src (+ pos 1) (+ pos 2)) nil)))
      (define adv (fn () (set! pos (+ pos 1))))
      ;; Advance while predicate holds; return substring from start to end
      (define
        read-while
        (fn
          (pred)
          (let
            ((start pos))
            (define
              rw-loop
              (fn
                ()
                (when
                  (and (at) (pred (at)))
                  (do (adv) (rw-loop)))))
            (rw-loop)
            (substring src start pos))))
      (define
        skip-line
        (fn
          ()
          (when
            (and (at) (not (= (at) "\n")))
            (do (adv) (skip-line)))))
      (define
        skip-block
        (fn
          (depth)
          (when
            (at)
            (cond
              ((and (= (at) "#") (= (peek1) "|"))
                (do (adv) (adv) (skip-block (+ depth 1))))
              ((and (= (at) "|") (= (peek1) "#"))
                (do
                  (adv)
                  (adv)
                  (when (> depth 1) (skip-block (- depth 1)))))
              (:else (do (adv) (skip-block depth)))))))
      ;; Read string literal — called with pos just past opening "
      (define
        read-str
        (fn
          (acc)
          (if
            (not (at))
            acc
            (cond
              ((= (at) "\"") (do (adv) acc))
              ((= (at) "\\")
                (do
                  (adv)
                  (let
                    ((e (at)))
                    (adv)
                    (read-str
                      (str
                        acc
                        (cond
                          ((= e "n") "\n")
                          ((= e "t") "\t")
                          ((= e "r") "\r")
                          ((= e "\"") "\"")
                          ((= e "\\") "\\")
                          (:else e)))))))
              (:else
                (let
                  ((c (at)))
                  (adv)
                  (read-str (str acc c))))))))
      ;; Read #\ char literal — called with pos just past the backslash
      (define
        read-char-lit
        (fn
          ()
          (let
            ((first (at)))
            (adv)
            (let
              ((rest (if (and (at) (cl-alpha? (at))) (read-while cl-alpha?) "")))
              (if
                (= rest "")
                first
                (let
                  ((name (downcase (str first rest))))
                  (or (get cl-named-chars name) first)))))))
      ;; Number scanner — called with pos just past first digit(s).
      ;; acc holds what was already consumed (first digit or sign+digit).
      (define
        scan-num
        (fn
          (p acc)
          (let
            ((more (read-while cl-digit?)))
            (set! acc (str acc more))
            (cond
              ;; ratio N/D
              ((and (at) (= (at) "/") (peek1) (cl-digit? (peek1)))
                (do
                  (adv)
                  (let
                    ((denom (read-while cl-digit?)))
                    {:type "ratio" :value (str acc "/" denom) :pos p})))
              ;; float: decimal point N.M[eE]
              ((and (at) (= (at) ".") (peek1) (cl-digit? (peek1)))
                (do
                  (adv)
                  (let
                    ((frac (read-while cl-digit?)))
                    (set! acc (str acc "." frac))
                    (when
                      (and (at) (or (= (at) "e") (= (at) "E")))
                      (do
                        (set! acc (str acc (at)))
                        (adv)
                        (when
                          (and (at) (or (= (at) "+") (= (at) "-")))
                          (do (set! acc (str acc (at))) (adv)))
                        (set! acc (str acc (read-while cl-digit?)))))
                    {:type "float" :value acc :pos p})))
              ;; float: exponent only NeE
              ((and (at) (or (= (at) "e") (= (at) "E")))
                (do
                  (set! acc (str acc (at)))
                  (adv)
                  (when
                    (and (at) (or (= (at) "+") (= (at) "-")))
                    (do (set! acc (str acc (at))) (adv)))
                  (set! acc (str acc (read-while cl-digit?)))
                  {:type "float" :value acc :pos p}))
              (:else {:type "integer" :value acc :pos p})))))
      (define
        read-radix
        (fn
          (letter p)
          (let
            ((pred
                (cond
                  ((or (= letter "x") (= letter "X")) cl-hex?)
                  ((or (= letter "b") (= letter "B")) cl-binary?)
                  ((or (= letter "o") (= letter "O")) cl-octal?)
                  (:else cl-digit?))))
            {:type "integer"
              :value (str "#" letter (read-while pred))
              :pos p})))
      (define emit (fn (tok) (append! toks tok)))
      (define
        scan
        (fn
          ()
          (when
            (< pos n)
            (let
              ((c (at)) (p pos))
              (cond
                ((cl-ws? c) (do (adv) (scan)))
                ((= c ";") (do (adv) (skip-line) (scan)))
                ((= c "(") (do (adv) (emit (cl-make-tok "lparen" "(" p)) (scan)))
                ((= c ")") (do (adv) (emit (cl-make-tok "rparen" ")" p)) (scan)))
                ((= c "'") (do (adv) (emit (cl-make-tok "quote" "'" p)) (scan)))
                ((= c "`") (do (adv) (emit (cl-make-tok "backquote" "`" p)) (scan)))
                ((= c ",")
                  (do
                    (adv)
                    (if
                      (= (at) "@")
                      (do (adv) (emit (cl-make-tok "comma-at" ",@" p)))
                      (emit (cl-make-tok "comma" "," p)))
                    (scan)))
                ((= c "\"")
                  (do
                    (adv)
                    (emit (cl-make-tok "string" (read-str "") p))
                    (scan)))
                ;; :keyword
                ((= c ":")
                  (do
                    (adv)
                    (emit (cl-make-tok "keyword" (upcase (read-while cl-sym-char?)) p))
                    (scan)))
                ;; dispatch macro #
                ((= c "#")
                  (do
                    (adv)
                    (let
                      ((d (at)))
                      (cond
                        ((= d "'") (do (adv) (emit (cl-make-tok "hash-quote" "#'" p)) (scan)))
                        ((= d "(") (do (adv) (emit (cl-make-tok "hash-paren" "#(" p)) (scan)))
                        ((= d ":")
                          (do
                            (adv)
                            (emit
                              (cl-make-tok "uninterned" (upcase (read-while cl-sym-char?)) p))
                            (scan)))
                        ((= d "|") (do (adv) (skip-block 1) (scan)))
                        ((= d "\\")
                          (do (adv) (emit (cl-make-tok "char" (read-char-lit) p)) (scan)))
                        ((or (= d "x") (= d "X"))
                          (do (adv) (emit (read-radix d p)) (scan)))
                        ((or (= d "b") (= d "B"))
                          (do (adv) (emit (read-radix d p)) (scan)))
                        ((or (= d "o") (= d "O"))
                          (do (adv) (emit (read-radix d p)) (scan)))
                        (:else (scan))))))
                ;; standalone dot, float .5, or symbol starting with dots
                ((= c ".")
                  (do
                    (adv)
                    (cond
                      ((or (not (at)) (cl-terminating? (at)))
                        (do (emit (cl-make-tok "dot" "." p)) (scan)))
                      ((cl-digit? (at))
                        (do
                          (emit
                            (cl-make-tok "float" (str "0." (read-while cl-digit?)) p))
                          (scan)))
                      (:else
                        (do
                          (emit
                            (cl-make-tok "symbol" (upcase (str "." (read-while cl-sym-char?))) p))
                          (scan))))))
                ;; sign followed by digit → number
                ((and (or (= c "+") (= c "-")) (peek1) (cl-digit? (peek1)))
                  (do
                    (adv)
                    (let
                      ((first-d (at)))
                      (adv)
                      (emit (scan-num p (str c first-d))))
                    (scan)))
                ;; decimal digit → number
                ((cl-digit? c)
                  (do
                    (adv)
                    (emit (scan-num p c))
                    (scan)))
                ;; symbol constituent (includes bare +, -, etc.)
                ((cl-sym-char? c)
                  (do
                    (emit (cl-make-tok "symbol" (upcase (read-while cl-sym-char?)) p))
                    (scan)))
                (:else (do (adv) (scan))))))))
      (scan)
      (append! toks (cl-make-tok "eof" nil n))
      toks)))
--- a/lib/common-lisp/runtime.sx
+++ b/lib/common-lisp/runtime.sx
@@ -1,760 +0,0 @@
 ;; lib/common-lisp/runtime.sx — CL built-ins + condition system on SX
 ;;
 ;; Section 1-9:  Type predicates, arithmetic, characters, strings, gensym,
 ;;               multiple values, sets, radix formatting, list utilities.
 ;; Section 10:   Condition system (define-condition, signal/error/warn,
 ;;               handler-bind, handler-case, restart-case, invoke-restart).
 ;;
 ;; Primitives used from spec:
 ;;   char/char->integer/integer->char/char-upcase/char-downcase
 ;;   format   gensym   rational/rational?   make-set/set-member?/etc
 ;;   modulo/remainder/quotient/gcd/lcm/expt   number->string
 ;; ---------------------------------------------------------------------------
 ;; 1.  Type predicates
 ;; ---------------------------------------------------------------------------
 (define (cl-null? x) (= x nil))
 (define (cl-consp? x) (and (list? x) (not (cl-empty? x))))
 (define (cl-listp? x) (or (cl-empty? x) (list? x)))
 (define (cl-atom? x) (not (cl-consp? x)))
 (define
  (cl-numberp? x)
  (let ((t (type-of x))) (or (= t "number") (= t "rational"))))
 (prefix-rename "cl-"
  '(
    (integerp? integer?)
    (floatp? float?)
    (rationalp? rational?)
    ))
 (define (cl-realp? x) (or (integer? x) (float? x) (rational? x)))
 (prefix-rename "cl-"
  '(
    (characterp? char?)
    ))
 (define cl-stringp? (fn (x) (= (type-of x) "string")))
 (define cl-symbolp? (fn (x) (= (type-of x) "symbol")))
 (define cl-keywordp? (fn (x) (= (type-of x) "keyword")))
 (define
  (cl-functionp? x)
  (let
    ((t (type-of x)))
    (or
      (= t "function")
      (= t "lambda")
      (= t "native-fn")
      (= t "component"))))
 (prefix-rename "cl-"
  '(
    (vectorp? vector?)
    (arrayp? vector?)
    ))
 ;; sx_server: (rest (list x)) returns () not nil — cl-empty? handles both
 (define
  (cl-empty? x)
  (or (nil? x) (and (list? x) (= (len x) 0))))
 ;; ---------------------------------------------------------------------------
 ;; 2.  Arithmetic — thin aliases to spec primitives
 ;; ---------------------------------------------------------------------------
 (prefix-rename "cl-"
  '(
    (mod modulo)
    (rem remainder)
    gcd
    lcm
    expt
    floor
    (ceiling ceil)
    truncate
    round
    ))
 (define cl-abs (fn (x) (if (< x 0) (- 0 x) x)))
 (define cl-min (fn (a b) (if (< a b) a b)))
 (define cl-max (fn (a b) (if (> a b) a b)))
 (prefix-rename "cl-"
  '(
    quotient
    ))
 (define
  (cl-signum x)
  (cond
    ((> x 0) 1)
    ((< x 0) -1)
    (else 0)))
 (define (cl-evenp? n) (= (modulo n 2) 0))
 (define (cl-oddp? n) (= (modulo n 2) 1))
 (define (cl-zerop? n) (= n 0))
 (define (cl-plusp? n) (> n 0))
 (define (cl-minusp? n) (< n 0))
 ;; ---------------------------------------------------------------------------
 ;; 3.  Character functions — alias spec char primitives + CL name mapping
 ;; ---------------------------------------------------------------------------
 (prefix-rename "cl-"
  '(
    char->integer
    integer->char
    char-upcase
    char-downcase
    (char-code char->integer)
    (code-char integer->char)
    ))
 (prefix-rename "cl-"
  '(
    char=?
    char<?
    char>?
    char<=?
    char>=?
    char-ci=?
    char-ci<?
    char-ci>?
    ))
 ;; Inline predicates — char-alphabetic?/char-numeric? unreliable in sx_server
 (define
  (cl-alpha-char-p c)
  (let
    ((n (char->integer c)))
    (or
      (and (>= n 65) (<= n 90))
      (and (>= n 97) (<= n 122)))))
 (define
  (cl-digit-char-p c)
  (let ((n (char->integer c))) (and (>= n 48) (<= n 57))))
 (define
  (cl-alphanumericp c)
  (let
    ((n (char->integer c)))
    (or
      (and (>= n 48) (<= n 57))
      (and (>= n 65) (<= n 90))
      (and (>= n 97) (<= n 122)))))
 (define
  (cl-upper-case-p c)
  (let ((n (char->integer c))) (and (>= n 65) (<= n 90))))
 (define
  (cl-lower-case-p c)
  (let ((n (char->integer c))) (and (>= n 97) (<= n 122))))
 ;; Named character constants
 (define cl-char-space (integer->char 32))
 (define cl-char-newline (integer->char 10))
 (define cl-char-tab (integer->char 9))
 (define cl-char-backspace (integer->char 8))
 (define cl-char-return (integer->char 13))
 (define cl-char-null (integer->char 0))
 (define cl-char-escape (integer->char 27))
 (define cl-char-delete (integer->char 127))
 ;; ---------------------------------------------------------------------------
 ;; 4.  String + IO — use spec format and ports
 ;; ---------------------------------------------------------------------------
 ;; CL format: (cl-format nil "~a ~a" x y) — nil destination means return string
 (define
  (cl-format dest template &rest args)
  (let ((s (apply format (cons template args)))) (if (= dest nil) s s)))
 (prefix-rename "cl-"
  '(
    write-to-string
    (princ-to-string display-to-string)
    ))
 ;; CL read-from-string: parse value from a string using SX port
 (define
  (cl-read-from-string s)
  (let ((p (open-input-string s))) (read p)))
 ;; String stream (output)
 (prefix-rename "cl-"
  '(
    (make-string-output-stream open-output-string)
    (get-output-stream-string get-output-string)
    ))
 ;; String stream (input)
 (prefix-rename "cl-"
  '(
    (make-string-input-stream open-input-string)
    ))
 ;; ---------------------------------------------------------------------------
 ;; 5.  Gensym
 ;; ---------------------------------------------------------------------------
 (prefix-rename "cl-"
  '(
    gensym
    (gentemp gensym)
    ))
 ;; ---------------------------------------------------------------------------
 ;; 6.  Multiple values (CL: values / nth-value)
 ;; ---------------------------------------------------------------------------
 (define (cl-values &rest args) {:_values true :_list args})
 (define
  (cl-call-with-values producer consumer)
  (let
    ((mv (producer)))
    (if
      (and (dict? mv) (get mv :_values))
      (apply consumer (get mv :_list))
      (consumer mv))))
 (define
  (cl-nth-value n mv)
  (cond
    ((and (dict? mv) (get mv :_values))
      (let
        ((lst (get mv :_list)))
        (if (>= n (len lst)) nil (nth lst n))))
    ((= n 0) mv)
    (else nil)))
 ;; ---------------------------------------------------------------------------
 ;; 7.  Sets (CL: adjoin / member / union / intersection / set-difference)
 ;; ---------------------------------------------------------------------------
 (prefix-rename "cl-"
  '(
    make-set
    set?
    (set-add set-add!)
    (set-memberp set-member?)
    (set-remove set-remove!)
    set-union
    (set-intersect set-intersection)
    set-difference
    list->set
    set->list
    ))
 ;; CL: (member item list) — returns tail starting at item, or nil
 (define
  (cl-member item lst)
  (cond
    ((cl-empty? lst) nil)
    ((equal? item (first lst)) lst)
    (else (cl-member item (rest lst)))))
 ;; CL: (adjoin item list) — cons only if not already present
 (define (cl-adjoin item lst) (if (cl-member item lst) lst (cons item lst)))
 ;; ---------------------------------------------------------------------------
 ;; 8.  Radix formatting  (CL: (write-to-string n :base radix))
 ;; ---------------------------------------------------------------------------
 (define (cl-integer-to-string n radix) (number->string n radix))
 (define (cl-string-to-integer s radix) (string->number s radix))
 ;; CL ~R directive helpers
 (define (cl-format-binary n) (number->string n 2))
 (define (cl-format-octal n) (number->string n 8))
 (define (cl-format-hex n) (number->string n 16))
 (define (cl-format-decimal n) (number->string n 10))
 ;; ---------------------------------------------------------------------------
 ;; 9.  List utilities — cl-empty? guards against () from rest
 ;; ---------------------------------------------------------------------------
 (define
  (cl-last lst)
  (cond
    ((cl-empty? lst) nil)
    ((cl-empty? (rest lst)) lst)
    (else (cl-last (rest lst)))))
 (define
  (cl-butlast lst)
  (if
    (or (cl-empty? lst) (cl-empty? (rest lst)))
    nil
    (cons (first lst) (cl-butlast (rest lst)))))
 (define
  (cl-nthcdr n lst)
  (if (= n 0) lst (cl-nthcdr (- n 1) (rest lst))))
 (define (cl-nth n lst) (first (cl-nthcdr n lst)))
 (define (cl-list-length lst) (len lst))
 (define
  (cl-copy-list lst)
  (if (cl-empty? lst) nil (cons (first lst) (cl-copy-list (rest lst)))))
 (define
  (cl-flatten lst)
  (cond
    ((cl-empty? lst) nil)
    ((list? (first lst))
      (append (cl-flatten (first lst)) (cl-flatten (rest lst))))
    (else (cons (first lst) (cl-flatten (rest lst))))))
 ;; CL: (assoc key alist) — returns matching pair or nil
 (define
  (cl-assoc key alist)
  (cond
    ((cl-empty? alist) nil)
    ((equal? key (first (first alist))) (first alist))
    (else (cl-assoc key (rest alist)))))
 ;; CL: (rassoc val alist) — reverse assoc (match on second element)
 (define
  (cl-rassoc val alist)
  (cond
    ((cl-empty? alist) nil)
    ((equal? val (first (rest (first alist)))) (first alist))
    (else (cl-rassoc val (rest alist)))))
 ;; CL: (getf plist key) — property list lookup
 (define
  (cl-getf plist key)
  (cond
    ((or (cl-empty? plist) (cl-empty? (rest plist))) nil)
    ((equal? (first plist) key) (first (rest plist)))
    (else (cl-getf (rest (rest plist)) key))))
 ;; ---------------------------------------------------------------------------
 ;; 10.  Condition system (Phase 3)
 ;;
 ;; Condition objects:
 ;;   {:cl-type "cl-condition" :class "NAME" :slots {slot-name val ...}}
 ;;
 ;; The built-in handler-bind / restart-case expect LITERAL handler specs in
 ;; source (they operate on the raw AST), so we implement our own handler and
 ;; restart stacks as mutable SX globals.
 ;; ---------------------------------------------------------------------------
 ;; ── condition class registry ───────────────────────────────────────────────
 ;;
 ;; Populated at load time with all ANSI standard condition types.
 ;; Also mutated by cl-define-condition.
 (define
  cl-condition-classes
  (dict
    "condition"
    {:parents (list) :slots (list) :name "condition"}
    "serious-condition"
    {:parents (list "condition") :slots (list) :name "serious-condition"}
    "error"
    {:parents (list "serious-condition") :slots (list) :name "error"}
    "warning"
    {:parents (list "condition") :slots (list) :name "warning"}
    "simple-condition"
    {:parents (list "condition") :slots (list "format-control" "format-arguments") :name "simple-condition"}
    "simple-error"
    {:parents (list "error" "simple-condition") :slots (list "format-control" "format-arguments") :name "simple-error"}
    "simple-warning"
    {:parents (list "warning" "simple-condition") :slots (list "format-control" "format-arguments") :name "simple-warning"}
    "type-error"
    {:parents (list "error") :slots (list "datum" "expected-type") :name "type-error"}
    "arithmetic-error"
    {:parents (list "error") :slots (list "operation" "operands") :name "arithmetic-error"}
    "division-by-zero"
    {:parents (list "arithmetic-error") :slots (list) :name "division-by-zero"}
    "cell-error"
    {:parents (list "error") :slots (list "name") :name "cell-error"}
    "unbound-variable"
    {:parents (list "cell-error") :slots (list) :name "unbound-variable"}
    "undefined-function"
    {:parents (list "cell-error") :slots (list) :name "undefined-function"}
    "program-error"
    {:parents (list "error") :slots (list) :name "program-error"}
    "storage-condition"
    {:parents (list "serious-condition") :slots (list) :name "storage-condition"}))
 ;; ── condition predicates ───────────────────────────────────────────────────
 (define
  cl-condition?
  (fn (x) (and (dict? x) (= (get x "cl-type") "cl-condition"))))
 ;; cl-condition-of-type? walks the class hierarchy.
 ;; We capture cl-condition-classes at define time via let to avoid
 ;; free-variable scoping issues at call time.
 (define
  cl-condition-of-type?
  (let
    ((classes cl-condition-classes))
    (fn
      (c type-name)
      (if
        (not (cl-condition? c))
        false
        (let
          ((class-name (get c "class")))
          (define
            check
            (fn
              (n)
              (if
                (= n type-name)
                true
                (let
                  ((entry (get classes n)))
                  (if
                    (nil? entry)
                    false
                    (some (fn (p) (check p)) (get entry "parents")))))))
          (check class-name))))))
 ;; ── condition constructors ─────────────────────────────────────────────────
 ;; cl-define-condition registers a new condition class.
 ;; name:       string (condition class name)
 ;; parents:    list of strings (parent class names)
 ;; slot-names: list of strings
 (define
  cl-define-condition
  (fn
    (name parents slot-names)
    (begin (dict-set! cl-condition-classes name {:parents parents :slots slot-names :name name}) name)))
 ;; cl-make-condition constructs a condition object.
 ;; Keyword args (alternating slot-name/value pairs) populate the slots dict.
 (define
  cl-make-condition
  (fn
    (name &rest kw-args)
    (let
      ((slots (dict)))
      (define
        fill
        (fn
          (args)
          (when
            (>= (len args) 2)
            (begin
              (dict-set! slots (first args) (first (rest args)))
              (fill (rest (rest args)))))))
      (fill kw-args)
      {:cl-type "cl-condition" :slots slots :class name})))
 ;; ── condition accessors ────────────────────────────────────────────────────
 (define
  cl-condition-slot
  (fn
    (c slot-name)
    (if (cl-condition? c) (get (get c "slots") slot-name) nil)))
 (define
  cl-condition-message
  (fn
    (c)
    (if
      (not (cl-condition? c))
      (str c)
      (let
        ((slots (get c "slots")))
        (or
          (get slots "message")
          (get slots "format-control")
          (str "Condition: " (get c "class")))))))
 (define
  cl-simple-condition-format-control
  (fn (c) (cl-condition-slot c "format-control")))
 (define
  cl-simple-condition-format-arguments
  (fn (c) (cl-condition-slot c "format-arguments")))
 (define cl-type-error-datum (fn (c) (cl-condition-slot c "datum")))
 (define
  cl-type-error-expected-type
  (fn (c) (cl-condition-slot c "expected-type")))
 (define
  cl-arithmetic-error-operation
  (fn (c) (cl-condition-slot c "operation")))
 (define
  cl-arithmetic-error-operands
  (fn (c) (cl-condition-slot c "operands")))
 ;; ── mutable handler + restart stacks ──────────────────────────────────────
 ;;
 ;; Handler entry: {:type "type-name" :fn (fn (condition) result)}
 ;; Restart entry: {:name "restart-name" :fn (fn (&optional arg) result) :escape k}
 ;;
 ;; New handlers are prepended (checked first = most recent handler wins).
 (define cl-handler-stack (list))
 (define cl-restart-stack (list))
 (define
  cl-push-handlers
  (fn (entries) (set! cl-handler-stack (append entries cl-handler-stack))))
 (define
  cl-pop-handlers
  (fn
    (n)
    (set! cl-handler-stack (slice cl-handler-stack n (len cl-handler-stack)))))
 (define
  cl-push-restarts
  (fn (entries) (set! cl-restart-stack (append entries cl-restart-stack))))
 (define
  cl-pop-restarts
  (fn
    (n)
    (set! cl-restart-stack (slice cl-restart-stack n (len cl-restart-stack)))))
 ;; ── *debugger-hook* + invoke-debugger ────────────────────────────────────
 ;;
 ;; cl-debugger-hook: called when an error propagates with no handler.
 ;; Signature: (fn (condition hook) result). The hook arg is itself
 ;; (so the hook can rebind it to nil to prevent recursion).
 ;; nil = use default (re-raise as host error).
 (define cl-debugger-hook nil)
 (define cl-invoke-debugger
  (fn (c)
    (if (nil? cl-debugger-hook)
      (error (str "Debugger: " (cl-condition-message c)))
      (let ((hook cl-debugger-hook))
        (set! cl-debugger-hook nil)
        (let ((result (hook c hook)))
          (set! cl-debugger-hook hook)
          result)))))
 ;; ── *break-on-signals* ────────────────────────────────────────────────────
 ;;
 ;; When set to a type name string, cl-signal invokes the debugger hook
 ;; before walking handlers if the condition is of that type.
 ;; nil = disabled (ANSI default).
 (define cl-break-on-signals nil)
 ;; ── invoke-restart-interactively ──────────────────────────────────────────
 ;;
 ;; Like invoke-restart but calls the restart's fn with no arguments
 ;; (real CL would prompt the user for each arg via :interactive).
 (define cl-invoke-restart-interactively
  (fn (name)
    (let ((entry (cl-find-restart-entry name cl-restart-stack)))
      (if (nil? entry)
        (error (str "No active restart: " name))
        (let ((restart-fn (get entry "fn"))
              (escape     (get entry "escape")))
          (escape (restart-fn)))))))
 ;; ── cl-signal (non-unwinding) ─────────────────────────────────────────────
 ;;
 ;; Walks cl-handler-stack; for each matching entry, calls the handler fn.
 ;; Handlers return normally — signal continues to the next matching handler.
 (define
  cl-signal-obj
  (fn
    (obj stack)
    (if
      (empty? stack)
      nil
      (let
        ((entry (first stack)))
        (if
          (cl-condition-of-type? obj (get entry "type"))
          (begin ((get entry "fn") obj) (cl-signal-obj obj (rest stack)))
          (cl-signal-obj obj (rest stack)))))))
 (define cl-signal
  (fn (c)
    (let ((obj (if (cl-condition? c)
                 c
                 (cl-make-condition "simple-condition"
                   "format-control" (str c)))))
      ;; *break-on-signals*: invoke debugger hook when type matches
      (when (and (not (nil? cl-break-on-signals))
                 (cl-condition-of-type? obj cl-break-on-signals))
        (cl-invoke-debugger obj))
      (cl-signal-obj obj cl-handler-stack))))
 ;; ── cl-error ───────────────────────────────────────────────────────────────
 ;;
 ;; Signals an error. If no handler catches it, raises a host-level error.
 (define
  cl-error
  (fn
    (c &rest args)
    (let
      ((obj (cond ((cl-condition? c) c) ((string? c) (cl-make-condition "simple-error" "format-control" c "format-arguments" args)) (:else (cl-make-condition "simple-error" "format-control" (str c))))))
      (cl-signal-obj obj cl-handler-stack)
      (cl-invoke-debugger obj))))
 ;; ── cl-warn ────────────────────────────────────────────────────────────────
 (define
  cl-warn
  (fn
    (c &rest args)
    (let
      ((obj (cond ((cl-condition? c) c) ((string? c) (cl-make-condition "simple-warning" "format-control" c "format-arguments" args)) (:else (cl-make-condition "simple-warning" "format-control" (str c))))))
      (cl-signal-obj obj cl-handler-stack))))
 ;; ── cl-handler-bind (non-unwinding) ───────────────────────────────────────
 ;;
 ;; bindings: list of (type-name handler-fn) pairs
 ;; thunk:    (fn () body)
 (define
  cl-handler-bind
  (fn
    (bindings thunk)
    (let
      ((entries (map (fn (b) {:fn (first (rest b)) :type (first b)}) bindings)))
      (begin
        (cl-push-handlers entries)
        (let
          ((result (thunk)))
          (begin (cl-pop-handlers (len entries)) result))))))
 ;; ── cl-handler-case (unwinding) ───────────────────────────────────────────
 ;;
 ;; thunk: (fn () body)
 ;; cases: list of (type-name handler-fn) pairs
 ;;
 ;; Uses call/cc for the escape continuation.
 (define
  cl-handler-case
  (fn
    (thunk &rest cases)
    (call/cc
      (fn
        (escape)
        (let
          ((entries (map (fn (c) {:fn (fn (x) (escape ((first (rest c)) x))) :type (first c)}) cases)))
          (begin
            (cl-push-handlers entries)
            (let
              ((result (thunk)))
              (begin (cl-pop-handlers (len entries)) result))))))))
 ;; ── cl-restart-case ────────────────────────────────────────────────────────
 ;;
 ;; thunk:    (fn () body)
 ;; restarts: list of (name params body-fn) triples
 ;;   body-fn is (fn () val) or (fn (arg) val)
 (define
  cl-restart-case
  (fn
    (thunk &rest restarts)
    (call/cc
      (fn
        (escape)
        (let
          ((entries (map (fn (r) {:fn (first (rest (rest r))) :escape escape :name (first r)}) restarts)))
          (begin
            (cl-push-restarts entries)
            (let
              ((result (thunk)))
              (begin (cl-pop-restarts (len entries)) result))))))))
 ;; ── cl-with-simple-restart ─────────────────────────────────────────────────
 (define
  cl-with-simple-restart
  (fn
    (name description thunk)
    (cl-restart-case thunk (list name (list) (fn () nil)))))
 ;; ── find-restart / invoke-restart / compute-restarts ──────────────────────
 (define
  cl-find-restart-entry
  (fn
    (name stack)
    (if
      (empty? stack)
      nil
      (let
        ((entry (first stack)))
        (if
          (= (get entry "name") name)
          entry
          (cl-find-restart-entry name (rest stack)))))))
 (define
  cl-find-restart
  (fn (name) (cl-find-restart-entry name cl-restart-stack)))
 (define
  cl-invoke-restart
  (fn
    (name &rest args)
    (let
      ((entry (cl-find-restart-entry name cl-restart-stack)))
      (if
        (nil? entry)
        (error (str "No active restart: " name))
        (let
          ((restart-fn (get entry "fn")) (escape (get entry "escape")))
          (escape
            (if (empty? args) (restart-fn) (restart-fn (first args)))))))))
 (define
  cl-compute-restarts
  (fn () (map (fn (e) (get e "name")) cl-restart-stack)))
 ;; ── with-condition-restarts (stub — association is advisory) ──────────────
 (define cl-with-condition-restarts (fn (c restarts thunk) (thunk)))
 ;; ── cl-cerror ──────────────────────────────────────────────────────────────
 ;;
 ;; Signals a continuable error. The "continue" restart is established;
 ;; invoke-restart "continue" to proceed past the error.
 ;; ── cl-cerror ──────────────────────────────────────────────────────────────
 ;;
 ;; Signals a continuable error. The "continue" restart is established;
 ;; invoke-restart "continue" to proceed past the error.
 (define cl-cerror
  (fn (continue-string c &rest args)
    (let ((obj (if (cl-condition? c)
                 c
                 (cl-make-condition "simple-error"
                   "format-control" (str c)
                   "format-arguments" args))))
      (cl-restart-case
        (fn () (cl-signal-obj obj cl-handler-stack))
        (list "continue" (list) (fn () nil))))))
--- a/lib/common-lisp/scoreboard.json
+++ b/lib/common-lisp/scoreboard.json
@@ -1,19 +0,0 @@
 {
  "generated": "2026-05-06T22:55:42Z",
  "total_pass": 518,
  "total_fail": 0,
  "suites": [
    {"name": "Phase 1: tokenizer/reader", "pass": 79, "fail": 0},
    {"name": "Phase 1: parser/lambda-lists", "pass": 31, "fail": 0},
    {"name": "Phase 2: evaluator", "pass": 182, "fail": 0},
    {"name": "Phase 3: condition system", "pass": 59, "fail": 0},
    {"name": "Phase 3: restart-demo", "pass": 7, "fail": 0},
    {"name": "Phase 3: parse-recover", "pass": 6, "fail": 0},
    {"name": "Phase 3: interactive-debugger", "pass": 7, "fail": 0},
    {"name": "Phase 4: CLOS", "pass": 41, "fail": 0},
    {"name": "Phase 4: geometry", "pass": 12, "fail": 0},
    {"name": "Phase 4: mop-trace", "pass": 13, "fail": 0},
    {"name": "Phase 5: macros+LOOP", "pass": 27, "fail": 0},
    {"name": "Phase 6: stdlib", "pass": 54, "fail": 0}
  ]
 }
--- a/lib/common-lisp/scoreboard.md
+++ b/lib/common-lisp/scoreboard.md
@@ -1,20 +0,0 @@
 # Common Lisp on SX — Scoreboard
 _Generated: 2026-05-06 22:55 UTC_
 | Suite | Pass | Fail | Status |
 |-------|------|------|--------|
 | Phase 1: tokenizer/reader | 79 | 0 | pass |
 | Phase 1: parser/lambda-lists | 31 | 0 | pass |
 | Phase 2: evaluator | 182 | 0 | pass |
 | Phase 3: condition system | 59 | 0 | pass |
 | Phase 3: restart-demo | 7 | 0 | pass |
 | Phase 3: parse-recover | 6 | 0 | pass |
 | Phase 3: interactive-debugger | 7 | 0 | pass |
 | Phase 4: CLOS | 41 | 0 | pass |
 | Phase 4: geometry | 12 | 0 | pass |
 | Phase 4: mop-trace | 13 | 0 | pass |
 | Phase 5: macros+LOOP | 27 | 0 | pass |
 | Phase 6: stdlib | 54 | 0 | pass |
 **Total: 518 passed, 0 failed**
--- a/lib/common-lisp/test.sh
+++ b/lib/common-lisp/test.sh
@@ -1,443 +0,0 @@
 #!/usr/bin/env bash
 # lib/common-lisp/test.sh — quick smoke-test the CL runtime layer.
 # Uses sx_server.exe epoch protocol (same as lib/lua/test.sh).
 #
 # Usage:
 #   bash lib/common-lisp/test.sh
 #   bash lib/common-lisp/test.sh -v
 set -uo pipefail
 cd "$(git rev-parse --show-toplevel)"
 SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
 if [ ! -x "$SX_SERVER" ]; then
  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
 fi
 if [ ! -x "$SX_SERVER" ]; then
  echo "ERROR: sx_server.exe not found. Run: cd hosts/ocaml && dune build"
  exit 1
 fi
 VERBOSE="${1:-}"
 PASS=0; FAIL=0; ERRORS=""
 TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
 cat > "$TMPFILE" << 'EPOCHS'
 (epoch 1)
 (load "spec/stdlib.sx")
 (load "lib/common-lisp/runtime.sx")
 ;; --- Type predicates ---
 (epoch 10)
 (eval "(cl-null? nil)")
 (epoch 11)
 (eval "(cl-null? false)")
 (epoch 12)
 (eval "(cl-consp? (list 1 2))")
 (epoch 13)
 (eval "(cl-consp? nil)")
 (epoch 14)
 (eval "(cl-listp? nil)")
 (epoch 15)
 (eval "(cl-listp? (list 1))")
 (epoch 16)
 (eval "(cl-atom? nil)")
 (epoch 17)
 (eval "(cl-atom? (list 1))")
 (epoch 18)
 (eval "(cl-integerp? 42)")
 (epoch 19)
 (eval "(cl-floatp? 3.14)")
 (epoch 20)
 (eval "(cl-characterp? (integer->char 65))")
 (epoch 21)
 (eval "(cl-stringp? \"hello\")")
 ;; --- Arithmetic ---
 (epoch 30)
 (eval "(cl-mod 10 3)")
 (epoch 31)
 (eval "(cl-rem 10 3)")
 (epoch 32)
 (eval "(cl-quotient 10 3)")
 (epoch 33)
 (eval "(cl-gcd 12 8)")
 (epoch 34)
 (eval "(cl-lcm 4 6)")
 (epoch 35)
 (eval "(cl-abs -5)")
 (epoch 36)
 (eval "(cl-abs 5)")
 (epoch 37)
 (eval "(cl-min 2 7)")
 (epoch 38)
 (eval "(cl-max 2 7)")
 (epoch 39)
 (eval "(cl-evenp? 4)")
 (epoch 40)
 (eval "(cl-evenp? 3)")
 (epoch 41)
 (eval "(cl-oddp? 7)")
 (epoch 42)
 (eval "(cl-zerop? 0)")
 (epoch 43)
 (eval "(cl-plusp? 1)")
 (epoch 44)
 (eval "(cl-minusp? -1)")
 (epoch 45)
 (eval "(cl-signum 42)")
 (epoch 46)
 (eval "(cl-signum -7)")
 (epoch 47)
 (eval "(cl-signum 0)")
 ;; --- Characters ---
 (epoch 50)
 (eval "(cl-char-code (integer->char 65))")
 (epoch 51)
 (eval "(char? (cl-code-char 65))")
 (epoch 52)
 (eval "(cl-char=? (integer->char 65) (integer->char 65))")
 (epoch 53)
 (eval "(cl-char<? (integer->char 65) (integer->char 90))")
 (epoch 54)
 (eval "(cl-char-code cl-char-space)")
 (epoch 55)
 (eval "(cl-char-code cl-char-newline)")
 (epoch 56)
 (eval "(cl-alpha-char-p (integer->char 65))")
 (epoch 57)
 (eval "(cl-digit-char-p (integer->char 48))")
 ;; --- Format ---
 (epoch 60)
 (eval "(cl-format nil \"hello\")")
 (epoch 61)
 (eval "(cl-format nil \"~a\" \"world\")")
 (epoch 62)
 (eval "(cl-format nil \"~d\" 42)")
 (epoch 63)
 (eval "(cl-format nil \"~x\" 255)")
 (epoch 64)
 (eval "(cl-format nil \"x=~d y=~d\" 3 4)")
 ;; --- Gensym ---
 (epoch 70)
 (eval "(= (type-of (cl-gensym)) \"symbol\")")
 (epoch 71)
 (eval "(not (= (cl-gensym) (cl-gensym)))")
 ;; --- Sets ---
 (epoch 80)
 (eval "(cl-set? (cl-make-set))")
 (epoch 81)
 (eval "(let ((s (cl-make-set))) (do (cl-set-add s 1) (cl-set-memberp s 1)))")
 (epoch 82)
 (eval "(cl-set-memberp (cl-make-set) 42)")
 (epoch 83)
 (eval "(cl-set-memberp (cl-list->set (list 1 2 3)) 2)")
 ;; --- Lists ---
 (epoch 90)
 (eval "(cl-nth 0 (list 1 2 3))")
 (epoch 91)
 (eval "(cl-nth 2 (list 1 2 3))")
 (epoch 92)
 (eval "(cl-last (list 1 2 3))")
 (epoch 93)
 (eval "(cl-butlast (list 1 2 3))")
 (epoch 94)
 (eval "(cl-nthcdr 1 (list 1 2 3))")
 (epoch 95)
 (eval "(cl-assoc \"b\" (list (list \"a\" 1) (list \"b\" 2)))")
 (epoch 96)
 (eval "(cl-assoc \"z\" (list (list \"a\" 1)))")
 (epoch 97)
 (eval "(cl-getf (list \"x\" 42 \"y\" 99) \"x\")")
 (epoch 98)
 (eval "(cl-adjoin 0 (list 1 2))")
 (epoch 99)
 (eval "(cl-adjoin 1 (list 1 2))")
 (epoch 100)
 (eval "(cl-member 2 (list 1 2 3))")
 (epoch 101)
 (eval "(cl-member 9 (list 1 2 3))")
 (epoch 102)
 (eval "(cl-flatten (list 1 (list 2 3) 4))")
 ;; --- Radix ---
 (epoch 110)
 (eval "(cl-format-binary 10)")
 (epoch 111)
 (eval "(cl-format-octal 15)")
 (epoch 112)
 (eval "(cl-format-hex 255)")
 (epoch 113)
 (eval "(cl-format-decimal 42)")
 (epoch 114)
 (eval "(cl-integer-to-string 31 16)")
 (epoch 115)
 (eval "(cl-string-to-integer \"1f\" 16)")
 EPOCHS
 OUTPUT=$(timeout 30 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
 check() {
  local epoch="$1" desc="$2" expected="$3"
  local actual
  # ok-len format: value appears on the line AFTER "(ok-len N length)"
  actual=$(echo "$OUTPUT" | grep -A1 "^(ok-len $epoch " | tail -1 || true)
  # strip any leading "(ok-len ...)" if grep -A1 returned it instead
  if echo "$actual" | grep -q "^(ok-len"; then actual=""; fi
  if [ -z "$actual" ]; then
    actual=$(echo "$OUTPUT" | grep "^(ok $epoch " | head -1 || true)
  fi
  if [ -z "$actual" ]; then
    actual=$(echo "$OUTPUT" | grep "^(error $epoch " | head -1 || true)
  fi
  [ -z "$actual" ] && actual="<no output for epoch $epoch>"
  if echo "$actual" | grep -qF -- "$expected"; then
    PASS=$((PASS+1))
    [ "$VERBOSE" = "-v" ] && echo "  ok $desc"
  else
    FAIL=$((FAIL+1))
    ERRORS+="  FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
 "
  fi
 }
 # Type predicates
 check 10  "cl-null? nil"           "true"
 check 11  "cl-null? false"         "false"
 check 12  "cl-consp? pair"         "true"
 check 13  "cl-consp? nil"          "false"
 check 14  "cl-listp? nil"          "true"
 check 15  "cl-listp? list"         "true"
 check 16  "cl-atom? nil"           "true"
 check 17  "cl-atom? pair"          "false"
 check 18  "cl-integerp?"           "true"
 check 19  "cl-floatp?"             "true"
 check 20  "cl-characterp?"         "true"
 check 21  "cl-stringp?"            "true"
 # Arithmetic
 check 30  "cl-mod 10 3"            "1"
 check 31  "cl-rem 10 3"            "1"
 check 32  "cl-quotient 10 3"       "3"
 check 33  "cl-gcd 12 8"            "4"
 check 34  "cl-lcm 4 6"             "12"
 check 35  "cl-abs -5"              "5"
 check 36  "cl-abs 5"               "5"
 check 37  "cl-min 2 7"             "2"
 check 38  "cl-max 2 7"             "7"
 check 39  "cl-evenp? 4"            "true"
 check 40  "cl-evenp? 3"            "false"
 check 41  "cl-oddp? 7"             "true"
 check 42  "cl-zerop? 0"            "true"
 check 43  "cl-plusp? 1"            "true"
 check 44  "cl-minusp? -1"          "true"
 check 45  "cl-signum pos"          "1"
 check 46  "cl-signum neg"          "-1"
 check 47  "cl-signum zero"         "0"
 # Characters
 check 50  "cl-char-code"           "65"
 check 51  "code-char returns char" "true"
 check 52  "cl-char=?"              "true"
 check 53  "cl-char<?"              "true"
 check 54  "cl-char-space code"     "32"
 check 55  "cl-char-newline code"   "10"
 check 56  "cl-alpha-char-p A"      "true"
 check 57  "cl-digit-char-p 0"      "true"
 # Format
 check 60  "cl-format plain"        '"hello"'
 check 61  "cl-format ~a"           '"world"'
 check 62  "cl-format ~d"           '"42"'
 check 63  "cl-format ~x"           '"ff"'
 check 64  "cl-format multi"        '"x=3 y=4"'
 # Gensym
 check 70  "gensym returns symbol"  "true"
 check 71  "gensyms are unique"     "true"
 # Sets
 check 80  "make-set is set?"       "true"
 check 81  "set-add + member"       "true"
 check 82  "member in empty"        "false"
 check 83  "list->set member"       "true"
 # Lists
 check 90  "cl-nth 0"               "1"
 check 91  "cl-nth 2"               "3"
 check 92  "cl-last"                "(3)"
 check 93  "cl-butlast"             "(1 2)"
 check 94  "cl-nthcdr 1"            "(2 3)"
 check 95  "cl-assoc hit"           '("b" 2)'
 check 96  "cl-assoc miss"          "nil"
 check 97  "cl-getf hit"            "42"
 check 98  "cl-adjoin new"          "(0 1 2)"
 check 99  "cl-adjoin dup"          "(1 2)"
 check 100 "cl-member hit"          "(2 3)"
 check 101 "cl-member miss"         "nil"
 check 102 "cl-flatten"             "(1 2 3 4)"
 # Radix
 check 110 "cl-format-binary 10"    '"1010"'
 check 111 "cl-format-octal 15"     '"17"'
 check 112 "cl-format-hex 255"      '"ff"'
 check 113 "cl-format-decimal 42"   '"42"'
 check 114 "n->s base 16"           '"1f"'
 check 115 "s->n base 16"           "31"
 # ── Phase 2: condition system unit tests ─────────────────────────────────────
 # Load runtime.sx then conditions.sx; query the passed/failed/failures globals.
 UNIT_FILE=$(mktemp); trap "rm -f $UNIT_FILE" EXIT
 cat > "$UNIT_FILE" << 'UNIT'
 (epoch 1)
 (load "spec/stdlib.sx")
 (epoch 2)
 (load "lib/common-lisp/runtime.sx")
 (epoch 3)
 (load "lib/common-lisp/tests/conditions.sx")
 (epoch 4)
 (eval "passed")
 (epoch 5)
 (eval "failed")
 (epoch 6)
 (eval "failures")
 UNIT
 UNIT_OUT=$(timeout 30 "$SX_SERVER" < "$UNIT_FILE" 2>/dev/null)
 # extract passed/failed counts from ok-len lines
 UNIT_PASSED=$(echo "$UNIT_OUT" | grep -A1 "^(ok-len 4 " | tail -1 || true)
 UNIT_FAILED=$(echo "$UNIT_OUT" | grep -A1 "^(ok-len 5 " | tail -1 || true)
 UNIT_ERRS=$(echo "$UNIT_OUT" | grep -A1 "^(ok-len 6 " | tail -1 || true)
 # fallback: try plain ok lines
 [ -z "$UNIT_PASSED" ] && UNIT_PASSED=$(echo "$UNIT_OUT" | grep "^(ok 4 " | awk '{print $3}' | tr -d ')' || true)
 [ -z "$UNIT_FAILED" ] && UNIT_FAILED=$(echo "$UNIT_OUT" | grep "^(ok 5 " | awk '{print $3}' | tr -d ')' || true)
 [ -z "$UNIT_PASSED" ] && UNIT_PASSED=0
 [ -z "$UNIT_FAILED" ] && UNIT_FAILED=0
 if [ "$UNIT_FAILED" = "0" ] && [ "$UNIT_PASSED" -gt 0 ] 2>/dev/null; then
  PASS=$((PASS + UNIT_PASSED))
  [ "$VERBOSE" = "-v" ] && echo "  ok condition tests ($UNIT_PASSED)"
 else
  FAIL=$((FAIL + 1))
  ERRORS+="  FAIL [condition tests] (${UNIT_PASSED} passed, ${UNIT_FAILED} failed) ${UNIT_ERRS}
 "
 fi
 # ── Phase 3: classic program tests ───────────────────────────────────────────
 run_program_suite() {
  local prog="$1" pass_var="$2" fail_var="$3" failures_var="$4"
  local PROG_FILE=$(mktemp)
  printf '(epoch 1)\n(load "spec/stdlib.sx")\n(epoch 2)\n(load "lib/common-lisp/runtime.sx")\n(epoch 3)\n(load "%s")\n(epoch 4)\n(eval "%s")\n(epoch 5)\n(eval "%s")\n(epoch 6)\n(eval "%s")\n' \
    "$prog" "$pass_var" "$fail_var" "$failures_var" > "$PROG_FILE"
  local OUT; OUT=$(timeout 20 "$SX_SERVER" < "$PROG_FILE" 2>/dev/null)
  rm -f "$PROG_FILE"
  local P F
  P=$(echo "$OUT" | grep -A1 "^(ok-len 4 " | tail -1 || true)
  F=$(echo "$OUT" | grep -A1 "^(ok-len 5 " | tail -1 || true)
  local ERRS; ERRS=$(echo "$OUT" | grep -A1 "^(ok-len 6 " | tail -1 || true)
  [ -z "$P" ] && P=0; [ -z "$F" ] && F=0
  if [ "$F" = "0" ] && [ "$P" -gt 0 ] 2>/dev/null; then
    PASS=$((PASS + P))
    [ "$VERBOSE" = "-v" ] && echo "  ok $prog ($P)"
  else
    FAIL=$((FAIL + 1))
    ERRORS+="  FAIL [$prog] (${P} passed, ${F} failed) ${ERRS}
 "
  fi
 }
 run_program_suite \
  "lib/common-lisp/tests/programs/restart-demo.sx" \
  "demo-passed" "demo-failed" "demo-failures"
 run_program_suite \
  "lib/common-lisp/tests/programs/parse-recover.sx" \
  "parse-passed" "parse-failed" "parse-failures"
 run_program_suite \
  "lib/common-lisp/tests/programs/interactive-debugger.sx" \
  "debugger-passed" "debugger-failed" "debugger-failures"
 # ── Phase 4: CLOS unit tests ─────────────────────────────────────────────────
 CLOS_FILE=$(mktemp); trap "rm -f $CLOS_FILE" EXIT
 printf '(epoch 1)\n(load "spec/stdlib.sx")\n(epoch 2)\n(load "lib/common-lisp/runtime.sx")\n(epoch 3)\n(load "lib/common-lisp/clos.sx")\n(epoch 4)\n(load "lib/common-lisp/tests/clos.sx")\n(epoch 5)\n(eval "passed")\n(epoch 6)\n(eval "failed")\n(epoch 7)\n(eval "failures")\n' > "$CLOS_FILE"
 CLOS_OUT=$(timeout 30 "$SX_SERVER" < "$CLOS_FILE" 2>/dev/null)
 rm -f "$CLOS_FILE"
 CLOS_PASSED=$(echo "$CLOS_OUT" | grep -A1 "^(ok-len 5 " | tail -1 || true)
 CLOS_FAILED=$(echo "$CLOS_OUT" | grep -A1 "^(ok-len 6 " | tail -1 || true)
 [ -z "$CLOS_PASSED" ] && CLOS_PASSED=$(echo "$CLOS_OUT" | grep "^(ok 5 " | awk '{print $3}' | tr -d ')' || true)
 [ -z "$CLOS_FAILED" ] && CLOS_FAILED=$(echo "$CLOS_OUT" | grep "^(ok 6 " | awk '{print $3}' | tr -d ')' || true)
 [ -z "$CLOS_PASSED" ] && CLOS_PASSED=0; [ -z "$CLOS_FAILED" ] && CLOS_FAILED=0
 if [ "$CLOS_FAILED" = "0" ] && [ "$CLOS_PASSED" -gt 0 ] 2>/dev/null; then
  PASS=$((PASS + CLOS_PASSED))
  [ "$VERBOSE" = "-v" ] && echo "  ok CLOS unit tests ($CLOS_PASSED)"
 else
  FAIL=$((FAIL + 1))
  ERRORS+="  FAIL [CLOS unit tests] (${CLOS_PASSED} passed, ${CLOS_FAILED} failed)
 "
 fi
 # ── Phase 4: CLOS classic programs ───────────────────────────────────────────
 run_clos_suite() {
  local prog="$1" pass_var="$2" fail_var="$3" failures_var="$4"
  local PROG_FILE=$(mktemp)
  printf '(epoch 1)\n(load "spec/stdlib.sx")\n(epoch 2)\n(load "lib/common-lisp/runtime.sx")\n(epoch 3)\n(load "lib/common-lisp/clos.sx")\n(epoch 4)\n(load "%s")\n(epoch 5)\n(eval "%s")\n(epoch 6)\n(eval "%s")\n(epoch 7)\n(eval "%s")\n' \
    "$prog" "$pass_var" "$fail_var" "$failures_var" > "$PROG_FILE"
  local OUT; OUT=$(timeout 20 "$SX_SERVER" < "$PROG_FILE" 2>/dev/null)
  rm -f "$PROG_FILE"
  local P F
  P=$(echo "$OUT" | grep -A1 "^(ok-len 5 " | tail -1 || true)
  F=$(echo "$OUT" | grep -A1 "^(ok-len 6 " | tail -1 || true)
  local ERRS; ERRS=$(echo "$OUT" | grep -A1 "^(ok-len 7 " | tail -1 || true)
  [ -z "$P" ] && P=0; [ -z "$F" ] && F=0
  if [ "$F" = "0" ] && [ "$P" -gt 0 ] 2>/dev/null; then
    PASS=$((PASS + P))
    [ "$VERBOSE" = "-v" ] && echo "  ok $prog ($P)"
  else
    FAIL=$((FAIL + 1))
    ERRORS+="  FAIL [$prog] (${P} passed, ${F} failed) ${ERRS}
 "
  fi
 }
 run_clos_suite \
  "lib/common-lisp/tests/programs/geometry.sx" \
  "geo-passed" "geo-failed" "geo-failures"
 run_clos_suite \
  "lib/common-lisp/tests/programs/mop-trace.sx" \
  "mop-passed" "mop-failed" "mop-failures"
 # ── Phase 5: macros + LOOP ───────────────────────────────────────────────────
 MACRO_FILE=$(mktemp); trap "rm -f $MACRO_FILE" EXIT
 printf '(epoch 1)\n(load "spec/stdlib.sx")\n(epoch 2)\n(load "lib/common-lisp/reader.sx")\n(epoch 3)\n(load "lib/common-lisp/parser.sx")\n(epoch 4)\n(load "lib/common-lisp/eval.sx")\n(epoch 5)\n(load "lib/common-lisp/loop.sx")\n(epoch 6)\n(load "lib/common-lisp/tests/macros.sx")\n(epoch 7)\n(eval "macro-passed")\n(epoch 8)\n(eval "macro-failed")\n(epoch 9)\n(eval "macro-failures")\n' > "$MACRO_FILE"
 MACRO_OUT=$(timeout 60 "$SX_SERVER" < "$MACRO_FILE" 2>/dev/null)
 rm -f "$MACRO_FILE"
 MACRO_PASSED=$(echo "$MACRO_OUT" | grep -A1 "^(ok-len 7 " | tail -1 || true)
 MACRO_FAILED=$(echo "$MACRO_OUT" | grep -A1 "^(ok-len 8 " | tail -1 || true)
 [ -z "$MACRO_PASSED" ] && MACRO_PASSED=0; [ -z "$MACRO_FAILED" ] && MACRO_FAILED=0
 if [ "$MACRO_FAILED" = "0" ] && [ "$MACRO_PASSED" -gt 0 ] 2>/dev/null; then
  PASS=$((PASS + MACRO_PASSED))
  [ "$VERBOSE" = "-v" ] && echo "  ok Phase 5 macros+LOOP ($MACRO_PASSED)"
 else
  FAIL=$((FAIL + 1))
  ERRORS+="  FAIL [Phase 5 macros+LOOP] (${MACRO_PASSED} passed, ${MACRO_FAILED} failed)
 "
 fi
 TOTAL=$((PASS+FAIL))
 if [ $FAIL -eq 0 ]; then
  echo "ok $PASS/$TOTAL lib/common-lisp tests passed"
 else
  echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
  echo "$ERRORS"
 fi
 [ $FAIL -eq 0 ]
--- a/lib/common-lisp/tests/clos.sx
+++ b/lib/common-lisp/tests/clos.sx
@@ -1,334 +0,0 @@
 ;; lib/common-lisp/tests/clos.sx — CLOS test suite
 ;;
 ;; Loaded after: spec/stdlib.sx, lib/common-lisp/runtime.sx, lib/common-lisp/clos.sx
 (define passed 0)
 (define failed 0)
 (define failures (list))
 (define
  assert-equal
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))
 (define
  assert-true
  (fn
    (label got)
    (if
      got
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str "FAIL [" label "]: expected true, got " (inspect got)))))))))
 (define
  assert-nil
  (fn
    (label got)
    (if
      (nil? got)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list (str "FAIL [" label "]: expected nil, got " (inspect got)))))))))
 ;; ── 1. class-of for built-in types ────────────────────────────────────────
 (assert-equal "class-of integer" (clos-class-of 42) "integer")
 (assert-equal "class-of float" (clos-class-of 3.14) "float")
 (assert-equal "class-of string" (clos-class-of "hi") "string")
 (assert-equal "class-of nil" (clos-class-of nil) "null")
 (assert-equal "class-of list" (clos-class-of (list 1)) "cons")
 (assert-equal "class-of empty" (clos-class-of (list)) "null")
 ;; ── 2. subclass-of? ───────────────────────────────────────────────────────
 (assert-true "integer subclass-of t" (clos-subclass-of? "integer" "t"))
 (assert-true "float subclass-of t" (clos-subclass-of? "float" "t"))
 (assert-true "t subclass-of t" (clos-subclass-of? "t" "t"))
 (assert-equal
  "integer not subclass-of float"
  (clos-subclass-of? "integer" "float")
  false)
 ;; ── 3. defclass + make-instance ───────────────────────────────────────────
 (clos-defclass "point" (list "t") (list {:initform 0 :initarg ":x" :reader nil :writer nil :accessor "point-x" :name "x"} {:initform 0 :initarg ":y" :reader nil :writer nil :accessor "point-y" :name "y"}))
 (let
  ((p (clos-make-instance "point" ":x" 3 ":y" 4)))
  (begin
    (assert-equal "make-instance slot x" (clos-slot-value p "x") 3)
    (assert-equal "make-instance slot y" (clos-slot-value p "y") 4)
    (assert-equal "class-of instance" (clos-class-of p) "point")
    (assert-true "instance-of? point" (clos-instance-of? p "point"))
    (assert-true "instance-of? t" (clos-instance-of? p "t"))
    (assert-equal "instance-of? string" (clos-instance-of? p "string") false)))
 ;; initform defaults
 (let
  ((p0 (clos-make-instance "point")))
  (begin
    (assert-equal "initform default x=0" (clos-slot-value p0 "x") 0)
    (assert-equal "initform default y=0" (clos-slot-value p0 "y") 0)))
 ;; ── 4. slot-value / set-slot-value! ──────────────────────────────────────
 (let
  ((p (clos-make-instance "point" ":x" 10 ":y" 20)))
  (begin
    (clos-set-slot-value! p "x" 99)
    (assert-equal "set-slot-value! x" (clos-slot-value p "x") 99)
    (assert-equal "slot-value y unchanged" (clos-slot-value p "y") 20)))
 ;; ── 5. slot-boundp ────────────────────────────────────────────────────────
 (let
  ((p (clos-make-instance "point" ":x" 5)))
  (begin
    (assert-true "slot-boundp x" (clos-slot-boundp p "x"))
    (assert-true "slot-boundp y (initform 0)" (clos-slot-boundp p "y"))))
 ;; ── 6. find-class ─────────────────────────────────────────────────────────
 (assert-equal
  "find-class point"
  (get (clos-find-class "point") "name")
  "point")
 (assert-nil "find-class missing" (clos-find-class "no-such-class"))
 ;; ── 7. inheritance ────────────────────────────────────────────────────────
 (clos-defclass "colored-point" (list "point") (list {:initform "white" :initarg ":color" :reader nil :writer nil :accessor nil :name "color"}))
 (let
  ((cp (clos-make-instance "colored-point" ":x" 1 ":y" 2 ":color" "red")))
  (begin
    (assert-equal "inherited slot x" (clos-slot-value cp "x") 1)
    (assert-equal "inherited slot y" (clos-slot-value cp "y") 2)
    (assert-equal "own slot color" (clos-slot-value cp "color") "red")
    (assert-true
      "instance-of? colored-point"
      (clos-instance-of? cp "colored-point"))
    (assert-true "instance-of? point (parent)" (clos-instance-of? cp "point"))
    (assert-true "instance-of? t (root)" (clos-instance-of? cp "t"))))
 ;; ── 8. defgeneric + primary method ───────────────────────────────────────
 (clos-defgeneric "describe-obj" {})
 (clos-defmethod
  "describe-obj"
  (list)
  (list "point")
  (fn
    (args next-fn)
    (let
      ((p (first args)))
      (str "(" (clos-slot-value p "x") "," (clos-slot-value p "y") ")"))))
 (clos-defmethod
  "describe-obj"
  (list)
  (list "t")
  (fn (args next-fn) (str "object:" (inspect (first args)))))
 (let
  ((p (clos-make-instance "point" ":x" 3 ":y" 4)))
  (begin
    (assert-equal
      "primary method for point"
      (clos-call-generic "describe-obj" (list p))
      "(3,4)")
    (assert-equal
      "fallback t method"
      (clos-call-generic "describe-obj" (list 42))
      "object:42")))
 ;; ── 9. method inheritance + specificity ───────────────────────────────────
 (clos-defmethod
  "describe-obj"
  (list)
  (list "colored-point")
  (fn
    (args next-fn)
    (let
      ((cp (first args)))
      (str
        (clos-slot-value cp "color")
        "@("
        (clos-slot-value cp "x")
        ","
        (clos-slot-value cp "y")
        ")"))))
 (let
  ((cp (clos-make-instance "colored-point" ":x" 5 ":y" 6 ":color" "blue")))
  (assert-equal
    "most specific method wins"
    (clos-call-generic "describe-obj" (list cp))
    "blue@(5,6)"))
 ;; ── 10. :before / :after / :around qualifiers ─────────────────────────────
 (clos-defgeneric "logged-action" {})
 (clos-defmethod
  "logged-action"
  (list "before")
  (list "t")
  (fn (args next-fn) (set! action-log (append action-log (list "before")))))
 (clos-defmethod
  "logged-action"
  (list)
  (list "t")
  (fn
    (args next-fn)
    (set! action-log (append action-log (list "primary")))
    "result"))
 (clos-defmethod
  "logged-action"
  (list "after")
  (list "t")
  (fn (args next-fn) (set! action-log (append action-log (list "after")))))
 (define action-log (list))
 (clos-call-generic "logged-action" (list 1))
 (assert-equal
  ":before/:after order"
  action-log
  (list "before" "primary" "after"))
 ;; :around
 (define around-log (list))
 (clos-defgeneric "wrapped-action" {})
 (clos-defmethod
  "wrapped-action"
  (list "around")
  (list "t")
  (fn
    (args next-fn)
    (set! around-log (append around-log (list "around-enter")))
    (let
      ((r (next-fn)))
      (set! around-log (append around-log (list "around-exit")))
      r)))
 (clos-defmethod
  "wrapped-action"
  (list)
  (list "t")
  (fn
    (args next-fn)
    (set! around-log (append around-log (list "primary")))
    42))
 (let
  ((r (clos-call-generic "wrapped-action" (list nil))))
  (begin
    (assert-equal ":around result" r 42)
    (assert-equal
      ":around log"
      around-log
      (list "around-enter" "primary" "around-exit"))))
 ;; ── 11. call-next-method ─────────────────────────────────────────────────
 (clos-defgeneric "chain-test" {})
 (clos-defmethod
  "chain-test"
  (list)
  (list "colored-point")
  (fn (args next-fn) (str "colored:" (clos-call-next-method next-fn))))
 (clos-defmethod
  "chain-test"
  (list)
  (list "point")
  (fn (args next-fn) "point-base"))
 (let
  ((cp (clos-make-instance "colored-point" ":x" 0 ":y" 0 ":color" "green")))
  (assert-equal
    "call-next-method chains"
    (clos-call-generic "chain-test" (list cp))
    "colored:point-base"))
 ;; ── 12. accessor methods ──────────────────────────────────────────────────
 (let
  ((p (clos-make-instance "point" ":x" 7 ":y" 8)))
  (begin
    (assert-equal
      "accessor point-x"
      (clos-call-generic "point-x" (list p))
      7)
    (assert-equal
      "accessor point-y"
      (clos-call-generic "point-y" (list p))
      8)))
 ;; ── 13. with-slots ────────────────────────────────────────────────────────
 (let
  ((p (clos-make-instance "point" ":x" 3 ":y" 4)))
  (assert-equal
    "with-slots"
    (clos-with-slots p (list "x" "y") (fn (x y) (* x y)))
    12))
 ;; ── 14. change-class ─────────────────────────────────────────────────────
 (clos-defclass "special-point" (list "point") (list {:initform "" :initarg ":label" :reader nil :writer nil :accessor nil :name "label"}))
 (let
  ((p (clos-make-instance "point" ":x" 1 ":y" 2)))
  (begin
    (clos-change-class! p "special-point")
    (assert-equal
      "change-class updates class"
      (clos-class-of p)
      "special-point")))
 ;; ── summary ────────────────────────────────────────────────────────────────
 (if
  (= failed 0)
  (print (str "ok " passed "/" (+ passed failed) " CLOS tests passed"))
  (begin
    (for-each (fn (f) (print f)) failures)
    (print
      (str "FAIL " passed "/" (+ passed failed) " passed, " failed " failed"))))
--- a/lib/common-lisp/tests/conditions.sx
+++ b/lib/common-lisp/tests/conditions.sx
@@ -1,478 +0,0 @@
 ;; lib/common-lisp/tests/conditions.sx — Phase 3 condition system tests
 ;;
 ;; Loaded by lib/common-lisp/test.sh after:
 ;;   (load "spec/stdlib.sx")
 ;;   (load "lib/common-lisp/runtime.sx")
 ;;
 ;; Each test resets the handler/restart stacks to ensure isolation.
 (define
  reset-stacks!
  (fn () (set! cl-handler-stack (list)) (set! cl-restart-stack (list))))
 ;; ── helpers ────────────────────────────────────────────────────────────────
 (define passed 0)
 (define failed 0)
 (define failures (list))
 (define
  assert-equal
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))
 (define
  assert-true
  (fn
    (label got)
    (if
      got
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str "FAIL [" label "]: expected true, got " (inspect got)))))))))
 (define
  assert-nil
  (fn
    (label got)
    (if
      (nil? got)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list (str "FAIL [" label "]: expected nil, got " (inspect got)))))))))
 ;; ── 1. condition predicates ────────────────────────────────────────────────
 (reset-stacks!)
 (let
  ((c (cl-make-condition "simple-error" "format-control" "oops")))
  (begin
    (assert-true "cl-condition? on condition" (cl-condition? c))
    (assert-equal "cl-condition? on string" (cl-condition? "hello") false)
    (assert-equal "cl-condition? on number" (cl-condition? 42) false)
    (assert-equal "cl-condition? on nil" (cl-condition? nil) false)))
 ;; ── 2. cl-make-condition + slot access ────────────────────────────────────
 (reset-stacks!)
 (let
  ((c (cl-make-condition "simple-error" "format-control" "msg" "format-arguments" (list 1 2))))
  (begin
    (assert-equal "class field" (get c "class") "simple-error")
    (assert-equal "cl-type field" (get c "cl-type") "cl-condition")
    (assert-equal
      "format-control slot"
      (cl-condition-slot c "format-control")
      "msg")
    (assert-equal
      "format-arguments slot"
      (cl-condition-slot c "format-arguments")
      (list 1 2))
    (assert-nil "missing slot is nil" (cl-condition-slot c "no-such-slot"))
    (assert-equal "condition-message" (cl-condition-message c) "msg")))
 ;; ── 3. cl-condition-of-type? — hierarchy walking ─────────────────────────
 (reset-stacks!)
 (let
  ((se (cl-make-condition "simple-error" "format-control" "x"))
    (w (cl-make-condition "simple-warning" "format-control" "y"))
    (te
      (cl-make-condition
        "type-error"
        "datum"
        5
        "expected-type"
        "string"))
    (dz (cl-make-condition "division-by-zero")))
  (begin
    (assert-true
      "se isa simple-error"
      (cl-condition-of-type? se "simple-error"))
    (assert-true "se isa error" (cl-condition-of-type? se "error"))
    (assert-true
      "se isa serious-condition"
      (cl-condition-of-type? se "serious-condition"))
    (assert-true "se isa condition" (cl-condition-of-type? se "condition"))
    (assert-equal
      "se not isa warning"
      (cl-condition-of-type? se "warning")
      false)
    (assert-true
      "w isa simple-warning"
      (cl-condition-of-type? w "simple-warning"))
    (assert-true "w isa warning" (cl-condition-of-type? w "warning"))
    (assert-true "w isa condition" (cl-condition-of-type? w "condition"))
    (assert-equal "w not isa error" (cl-condition-of-type? w "error") false)
    (assert-true "te isa type-error" (cl-condition-of-type? te "type-error"))
    (assert-true "te isa error" (cl-condition-of-type? te "error"))
    (assert-true
      "dz isa division-by-zero"
      (cl-condition-of-type? dz "division-by-zero"))
    (assert-true
      "dz isa arithmetic-error"
      (cl-condition-of-type? dz "arithmetic-error"))
    (assert-true "dz isa error" (cl-condition-of-type? dz "error"))
    (assert-equal
      "non-condition not isa anything"
      (cl-condition-of-type? 42 "error")
      false)))
 ;; ── 4. cl-define-condition ────────────────────────────────────────────────
 (reset-stacks!)
 (begin
  (cl-define-condition "my-app-error" (list "error") (list "code" "detail"))
  (let
    ((c (cl-make-condition "my-app-error" "code" 404 "detail" "not found")))
    (begin
      (assert-true "user condition: cl-condition?" (cl-condition? c))
      (assert-true
        "user condition isa my-app-error"
        (cl-condition-of-type? c "my-app-error"))
      (assert-true
        "user condition isa error"
        (cl-condition-of-type? c "error"))
      (assert-true
        "user condition isa condition"
        (cl-condition-of-type? c "condition"))
      (assert-equal
        "user condition slot code"
        (cl-condition-slot c "code")
        404)
      (assert-equal
        "user condition slot detail"
        (cl-condition-slot c "detail")
        "not found"))))
 ;; ── 5. cl-handler-bind (non-unwinding) ───────────────────────────────────
 (reset-stacks!)
 (let
  ((log (list)))
  (begin
    (cl-handler-bind
      (list
        (list
          "error"
          (fn (c) (set! log (append log (list (cl-condition-message c)))))))
      (fn
        ()
        (cl-signal (cl-make-condition "simple-error" "format-control" "oops"))))
    (assert-equal "handler-bind: handler fired" log (list "oops"))))
 (reset-stacks!)
 ;; Non-unwinding: body continues after signal
 (let
  ((body-ran false))
  (begin
    (cl-handler-bind
      (list (list "error" (fn (c) nil)))
      (fn
        ()
        (cl-signal (cl-make-condition "simple-error" "format-control" "x"))
        (set! body-ran true)))
    (assert-true "handler-bind: body continues after signal" body-ran)))
 (reset-stacks!)
 ;; Type filtering: warning handler does not fire for error
 (let
  ((w-fired false))
  (begin
    (cl-handler-bind
      (list (list "warning" (fn (c) (set! w-fired true))))
      (fn
        ()
        (cl-signal (cl-make-condition "simple-error" "format-control" "e"))))
    (assert-equal
      "handler-bind: type filter (warning ignores error)"
      w-fired
      false)))
 (reset-stacks!)
 ;; Multiple handlers: both matching handlers fire
 (let
  ((log (list)))
  (begin
    (cl-handler-bind
      (list
        (list "error" (fn (c) (set! log (append log (list "e1")))))
        (list "condition" (fn (c) (set! log (append log (list "e2"))))))
      (fn
        ()
        (cl-signal (cl-make-condition "simple-error" "format-control" "x"))))
    (assert-equal "handler-bind: both handlers fire" log (list "e1" "e2"))))
 (reset-stacks!)
 ;; ── 6. cl-handler-case (unwinding) ───────────────────────────────────────
 ;; Catches error, returns handler result
 (let
  ((result (cl-handler-case (fn () (cl-error "boom") 99) (list "error" (fn (c) (str "caught: " (cl-condition-message c)))))))
  (assert-equal "handler-case: catches error" result "caught: boom"))
 (reset-stacks!)
 ;; Returns body result when no signal
 (let
  ((result (cl-handler-case (fn () 42) (list "error" (fn (c) -1)))))
  (assert-equal "handler-case: body result" result 42))
 (reset-stacks!)
 ;; Only first matching handler runs (unwinding)
 (let
  ((result (cl-handler-case (fn () (cl-error "x")) (list "simple-error" (fn (c) "simple")) (list "error" (fn (c) "error")))))
  (assert-equal "handler-case: most specific wins" result "simple"))
 (reset-stacks!)
 ;; ── 7. cl-warn ────────────────────────────────────────────────────────────
 (let
  ((warned false))
  (begin
    (cl-handler-bind
      (list (list "warning" (fn (c) (set! warned true))))
      (fn () (cl-warn "be careful")))
    (assert-true "cl-warn: fires warning handler" warned)))
 (reset-stacks!)
 ;; Warn with condition object
 (let
  ((msg ""))
  (begin
    (cl-handler-bind
      (list (list "warning" (fn (c) (set! msg (cl-condition-message c)))))
      (fn
        ()
        (cl-warn
          (cl-make-condition "simple-warning" "format-control" "take care"))))
    (assert-equal "cl-warn: condition object" msg "take care")))
 (reset-stacks!)
 ;; ── 8. cl-restart-case + cl-invoke-restart ───────────────────────────────
 ;; Basic restart invocation
 (let
  ((result (cl-restart-case (fn () (cl-invoke-restart "use-zero")) (list "use-zero" (list) (fn () 0)))))
  (assert-equal "restart-case: invoke-restart use-zero" result 0))
 (reset-stacks!)
 ;; Restart with argument
 (let
  ((result (cl-restart-case (fn () (cl-invoke-restart "use-value" 77)) (list "use-value" (list "v") (fn (v) v)))))
  (assert-equal "restart-case: invoke-restart with arg" result 77))
 (reset-stacks!)
 ;; Body returns normally when restart not invoked
 (let
  ((result (cl-restart-case (fn () 42) (list "never-used" (list) (fn () -1)))))
  (assert-equal "restart-case: body result" result 42))
 (reset-stacks!)
 ;; ── 9. cl-with-simple-restart ─────────────────────────────────────────────
 (let
  ((result (cl-with-simple-restart "skip" "Skip this step" (fn () (cl-invoke-restart "skip") 99))))
  (assert-nil "with-simple-restart: invoke returns nil" result))
 (reset-stacks!)
 ;; ── 10. cl-find-restart ───────────────────────────────────────────────────
 (let
  ((found (cl-restart-case (fn () (cl-find-restart "retry")) (list "retry" (list) (fn () nil)))))
  (assert-true "find-restart: finds active restart" (not (nil? found))))
 (reset-stacks!)
 (let
  ((not-found (cl-restart-case (fn () (cl-find-restart "nonexistent")) (list "retry" (list) (fn () nil)))))
  (assert-nil "find-restart: nil for inactive restart" not-found))
 (reset-stacks!)
 ;; ── 11. cl-compute-restarts ───────────────────────────────────────────────
 (let
  ((names (cl-restart-case (fn () (cl-restart-case (fn () (cl-compute-restarts)) (list "inner" (list) (fn () nil)))) (list "outer" (list) (fn () nil)))))
  (assert-equal
    "compute-restarts: both restarts"
    names
    (list "inner" "outer")))
 (reset-stacks!)
 ;; ── 12. handler-bind + restart-case interop ───────────────────────────────
 ;; Classic CL pattern: error handler invokes a restart
 (let
  ((result (cl-restart-case (fn () (cl-handler-bind (list (list "error" (fn (c) (cl-invoke-restart "use-zero")))) (fn () (cl-error "divide by zero")))) (list "use-zero" (list) (fn () 0)))))
  (assert-equal "interop: handler invokes restart" result 0))
 (reset-stacks!)
 ;; ── 13. cl-cerror ─────────────────────────────────────────────────────────
 ;; When "continue" restart is invoked, cerror returns nil
 (let
  ((result (cl-restart-case (fn () (cl-cerror "continue anyway" "something bad") 42) (list "continue" (list) (fn () "resumed")))))
  (assert-true
    "cerror: returns"
    (or (nil? result) (= result 42) (= result "resumed"))))
 (reset-stacks!)
 ;; ── 14. slot accessor helpers ─────────────────────────────────────────────
 (let
  ((c (cl-make-condition "simple-error" "format-control" "msg" "format-arguments" (list 1 2))))
  (begin
    (assert-equal
      "simple-condition-format-control"
      (cl-simple-condition-format-control c)
      "msg")
    (assert-equal
      "simple-condition-format-arguments"
      (cl-simple-condition-format-arguments c)
      (list 1 2))))
 (let
  ((c (cl-make-condition "type-error" "datum" 42 "expected-type" "string")))
  (begin
    (assert-equal "type-error-datum" (cl-type-error-datum c) 42)
    (assert-equal
      "type-error-expected-type"
      (cl-type-error-expected-type c)
      "string")))
 (let
  ((c (cl-make-condition "arithmetic-error" "operation" "/" "operands" (list 1 0))))
  (begin
    (assert-equal
      "arithmetic-error-operation"
      (cl-arithmetic-error-operation c)
      "/")
    (assert-equal
      "arithmetic-error-operands"
      (cl-arithmetic-error-operands c)
      (list 1 0))))
 ;; ── 15. *debugger-hook* ───────────────────────────────────────────────────
 (reset-stacks!)
 (let ((received nil))
  (begin
    (set! cl-debugger-hook
      (fn (c h)
        (set! received (cl-condition-message c))
        (cl-invoke-restart "escape")))
    (cl-restart-case
      (fn () (cl-error "debugger test"))
      (list "escape" (list) (fn () nil)))
    (set! cl-debugger-hook nil)
    (assert-equal "debugger-hook receives condition"  received  "debugger test")))
 (reset-stacks!)
 ;; ── 16. *break-on-signals* ────────────────────────────────────────────────
 (reset-stacks!)
 (let ((triggered false))
  (begin
    (set! cl-break-on-signals "error")
    (set! cl-debugger-hook
      (fn (c h)
        (set! triggered true)
        (cl-invoke-restart "abort")))
    (cl-restart-case
      (fn ()
        (cl-signal (cl-make-condition "simple-error" "format-control" "x")))
      (list "abort" (list) (fn () nil)))
    (set! cl-break-on-signals nil)
    (set! cl-debugger-hook nil)
    (assert-true "break-on-signals fires hook"  triggered)))
 (reset-stacks!)
 ;; break-on-signals: non-matching type does NOT fire hook
 (let ((triggered false))
  (begin
    (set! cl-break-on-signals "error")
    (set! cl-debugger-hook
      (fn (c h) (set! triggered true) nil))
    (cl-handler-bind
      (list (list "warning" (fn (c) nil)))
      (fn ()
        (cl-signal (cl-make-condition "simple-warning" "format-control" "w"))))
    (set! cl-break-on-signals nil)
    (set! cl-debugger-hook nil)
    (assert-equal "break-on-signals: type mismatch not triggered"  triggered  false)))
 (reset-stacks!)
 ;; ── 17. cl-invoke-restart-interactively ──────────────────────────────────
 (let ((result
        (cl-restart-case
          (fn () (cl-invoke-restart-interactively "use-default"))
          (list "use-default" (list) (fn () 99)))))
  (assert-equal "invoke-restart-interactively: returns restart value"  result  99))
 (reset-stacks!)
 ;; ── summary ────────────────────────────────────────────────────────────────
 (if
  (= failed 0)
  (print (str "ok " passed "/" (+ passed failed) " condition tests passed"))
  (begin
    (for-each (fn (f) (print f)) failures)
    (print
      (str "FAIL " passed "/" (+ passed failed) " passed, " failed " failed"))))
--- a/lib/common-lisp/tests/eval.sx
+++ b/lib/common-lisp/tests/eval.sx
@@ -1,466 +0,0 @@
 ;; CL evaluator tests
 (define cl-test-pass 0)
 (define cl-test-fail 0)
 (define cl-test-fails (list))
 (define
  cl-deep=
  (fn
    (a b)
    (cond
      ((= a b) true)
      ((and (dict? a) (dict? b))
        (let
          ((ak (keys a)) (bk (keys b)))
          (if
            (not (= (len ak) (len bk)))
            false
            (every?
              (fn (k) (and (has-key? b k) (cl-deep= (get a k) (get b k))))
              ak))))
      ((and (list? a) (list? b))
        (if
          (not (= (len a) (len b)))
          false
          (let
            ((i 0) (ok true))
            (define
              chk
              (fn
                ()
                (when
                  (and ok (< i (len a)))
                  (do
                    (when
                      (not (cl-deep= (nth a i) (nth b i)))
                      (set! ok false))
                    (set! i (+ i 1))
                    (chk)))))
            (chk)
            ok)))
      (:else false))))
 (define
  cl-test
  (fn
    (name actual expected)
    (if
      (cl-deep= actual expected)
      (set! cl-test-pass (+ cl-test-pass 1))
      (do
        (set! cl-test-fail (+ cl-test-fail 1))
        (append! cl-test-fails {:name name :expected expected :actual actual})))))
 ;; Convenience: evaluate CL string with fresh env each time
 (define ev (fn (src) (cl-eval-str src (cl-make-env))))
 (define evall (fn (src) (cl-eval-all-str src (cl-make-env))))
 ;; ── self-evaluating literals ──────────────────────────────────────
 (cl-test "lit: nil" (ev "nil") nil)
 (cl-test "lit: t" (ev "t") true)
 (cl-test "lit: integer" (ev "42") 42)
 (cl-test "lit: negative" (ev "-7") -7)
 (cl-test "lit: zero" (ev "0") 0)
 (cl-test "lit: string" (ev "\"hello\"") "hello")
 (cl-test "lit: empty string" (ev "\"\"") "")
 (cl-test "lit: keyword type" (get (ev ":foo") "cl-type") "keyword")
 (cl-test "lit: keyword name" (get (ev ":foo") "name") "FOO")
 (cl-test "lit: float type" (get (ev "3.14") "cl-type") "float")
 ;; ── QUOTE ─────────────────────────────────────────────────────────
 (cl-test "quote: symbol" (ev "'x") "X")
 (cl-test "quote: list" (ev "'(a b c)") (list "A" "B" "C"))
 (cl-test "quote: nil" (ev "'nil") nil)
 (cl-test "quote: integer" (ev "'42") 42)
 (cl-test "quote: nested" (ev "'(a (b c))") (list "A" (list "B" "C")))
 ;; ── IF ────────────────────────────────────────────────────────────
 (cl-test "if: true branch" (ev "(if t 1 2)") 1)
 (cl-test "if: false branch" (ev "(if nil 1 2)") 2)
 (cl-test "if: no else nil" (ev "(if nil 99)") nil)
 (cl-test "if: number truthy" (ev "(if 0 'yes 'no)") "YES")
 (cl-test "if: empty string truthy" (ev "(if \"\" 'yes 'no)") "YES")
 (cl-test "if: nested" (ev "(if t (if nil 1 2) 3)") 2)
 ;; ── PROGN ────────────────────────────────────────────────────────
 (cl-test "progn: single" (ev "(progn 42)") 42)
 (cl-test "progn: multiple" (ev "(progn 1 2 3)") 3)
 (cl-test "progn: nil last" (ev "(progn 1 nil)") nil)
 ;; ── AND / OR ─────────────────────────────────────────────────────
 (cl-test "and: empty" (ev "(and)") true)
 (cl-test "and: all true" (ev "(and 1 2 3)") 3)
 (cl-test "and: short-circuit" (ev "(and nil 99)") nil)
 (cl-test "and: returns last" (ev "(and 1 2)") 2)
 (cl-test "or: empty" (ev "(or)") nil)
 (cl-test "or: first truthy" (ev "(or 1 2)") 1)
 (cl-test "or: all nil" (ev "(or nil nil)") nil)
 (cl-test "or: short-circuit" (ev "(or nil 42)") 42)
 ;; ── COND ─────────────────────────────────────────────────────────
 (cl-test "cond: first match" (ev "(cond (t 1) (t 2))") 1)
 (cl-test "cond: second match" (ev "(cond (nil 1) (t 2))") 2)
 (cl-test "cond: no match" (ev "(cond (nil 1) (nil 2))") nil)
 (cl-test "cond: returns test value" (ev "(cond (42))") 42)
 ;; ── WHEN / UNLESS ─────────────────────────────────────────────────
 (cl-test "when: true" (ev "(when t 1 2 3)") 3)
 (cl-test "when: nil" (ev "(when nil 99)") nil)
 (cl-test "unless: nil runs" (ev "(unless nil 42)") 42)
 (cl-test "unless: true skips" (ev "(unless t 99)") nil)
 ;; ── LET ──────────────────────────────────────────────────────────
 (cl-test "let: empty bindings" (ev "(let () 42)") 42)
 (cl-test "let: single binding" (ev "(let ((x 5)) x)") 5)
 (cl-test "let: two bindings" (ev "(let ((x 3) (y 4)) (+ x y))") 7)
 (cl-test "let: parallel" (ev "(let ((x 1)) (let ((x 2) (y x)) y))") 1)
 (cl-test "let: nested" (ev "(let ((x 1)) (let ((y 2)) (+ x y)))") 3)
 (cl-test "let: progn body" (ev "(let ((x 5)) (+ x 1) (* x 2))") 10)
 (cl-test "let: bare name nil" (ev "(let (x) x)") nil)
 ;; ── LET* ─────────────────────────────────────────────────────────
 (cl-test "let*: sequential" (ev "(let* ((x 1) (y (+ x 1))) y)") 2)
 (cl-test "let*: chain" (ev "(let* ((a 2) (b (* a 3)) (c (+ b 1))) c)") 7)
 (cl-test "let*: shadow" (ev "(let ((x 1)) (let* ((x 2) (y x)) y))") 2)
 ;; ── SETQ / SETF ──────────────────────────────────────────────────
 (cl-test "setq: basic" (ev "(let ((x 0)) (setq x 5) x)") 5)
 (cl-test "setq: returns value" (ev "(let ((x 0)) (setq x 99))") 99)
 (cl-test "setf: basic" (ev "(let ((x 0)) (setf x 7) x)") 7)
 ;; ── LAMBDA ────────────────────────────────────────────────────────
 (cl-test "lambda: call" (ev "((lambda (x) x) 42)") 42)
 (cl-test "lambda: multi-arg" (ev "((lambda (x y) (+ x y)) 3 4)") 7)
 (cl-test "lambda: closure" (ev "(let ((n 10)) ((lambda (x) (+ x n)) 5))") 15)
 (cl-test "lambda: rest arg"
  (ev "((lambda (x &rest xs) (cons x xs)) 1 2 3)")
  {:cl-type "cons" :car 1 :cdr (list 2 3)})
 (cl-test "lambda: optional no default"
  (ev "((lambda (&optional x) x))")
  nil)
 (cl-test "lambda: optional with arg"
  (ev "((lambda (&optional (x 99)) x) 42)")
  42)
 (cl-test "lambda: optional default used"
  (ev "((lambda (&optional (x 7)) x))")
  7)
 ;; ── FUNCTION ─────────────────────────────────────────────────────
 (cl-test "function: lambda" (get (ev "(function (lambda (x) x))") "cl-type") "function")
 ;; ── DEFUN ────────────────────────────────────────────────────────
 (cl-test "defun: returns name" (evall "(defun sq (x) (* x x))") "SQ")
 (cl-test "defun: call" (evall "(defun sq (x) (* x x)) (sq 5)") 25)
 (cl-test "defun: multi-arg" (evall "(defun add (x y) (+ x y)) (add 3 4)") 7)
 (cl-test "defun: recursive factorial"
  (evall "(defun fact (n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 5)")
  120)
 (cl-test "defun: multiple calls"
  (evall "(defun double (x) (* x 2)) (+ (double 3) (double 5))")
  16)
 ;; ── FLET ─────────────────────────────────────────────────────────
 (cl-test "flet: basic"
  (ev "(flet ((double (x) (* x 2))) (double 5))")
  10)
 (cl-test "flet: sees outer vars"
  (ev "(let ((n 3)) (flet ((add-n (x) (+ x n))) (add-n 7)))")
  10)
 (cl-test "flet: non-recursive"
  (ev "(flet ((f (x) (+ x 1))) (flet ((f (x) (f (f x)))) (f 5)))")
  7)
 ;; ── LABELS ────────────────────────────────────────────────────────
 (cl-test "labels: basic"
  (ev "(labels ((greet (x) x)) (greet 42))")
  42)
 (cl-test "labels: recursive"
  (ev "(labels ((count (n) (if (<= n 0) 0 (+ 1 (count (- n 1)))))) (count 5))")
  5)
 (cl-test "labels: mutual recursion"
  (ev "(labels
         ((even? (n) (if (= n 0) t  (odd? (- n 1))))
          (odd?  (n) (if (= n 0) nil   (even? (- n 1)))))
         (list (even? 4) (odd? 3)))")
  (list true true))
 ;; ── THE / LOCALLY / EVAL-WHEN ────────────────────────────────────
 (cl-test "the: passthrough" (ev "(the integer 42)") 42)
 (cl-test "the: string" (ev "(the string \"hi\")") "hi")
 (cl-test "locally: body" (ev "(locally 1 2 3)") 3)
 (cl-test "eval-when: execute" (ev "(eval-when (:execute) 99)") 99)
 (cl-test "eval-when: no execute" (ev "(eval-when (:compile-toplevel) 99)") nil)
 ;; ── DEFVAR / DEFPARAMETER ────────────────────────────────────────
 (cl-test "defvar: returns name" (evall "(defvar *x* 10)") "*X*")
 (cl-test "defparameter: sets value" (evall "(defparameter *y* 42) *y*") 42)
 (cl-test "defvar: no reinit" (evall "(defvar *z* 1) (defvar *z* 99) *z*") 1)
 ;; ── built-in arithmetic ───────────────────────────────────────────
 (cl-test "arith: +" (ev "(+ 1 2 3)") 6)
 (cl-test "arith: + zero" (ev "(+)") 0)
 (cl-test "arith: -" (ev "(- 10 3 2)") 5)
 (cl-test "arith: - negate" (ev "(- 5)") -5)
 (cl-test "arith: *" (ev "(* 2 3 4)") 24)
 (cl-test "arith: * one" (ev "(*)") 1)
 (cl-test "arith: /" (ev "(/ 12 3)") 4)
 (cl-test "arith: max" (ev "(max 3 1 4 1 5)") 5)
 (cl-test "arith: min" (ev "(min 3 1 4 1 5)") 1)
 (cl-test "arith: abs neg" (ev "(abs -7)") 7)
 (cl-test "arith: abs pos" (ev "(abs 7)") 7)
 ;; ── built-in comparisons ──────────────────────────────────────────
 (cl-test "cmp: = true" (ev "(= 3 3)") true)
 (cl-test "cmp: = false" (ev "(= 3 4)") nil)
 (cl-test "cmp: /=" (ev "(/= 3 4)") true)
 (cl-test "cmp: <" (ev "(< 1 2)") true)
 (cl-test "cmp: > false" (ev "(> 1 2)") nil)
 (cl-test "cmp: <=" (ev "(<= 2 2)") true)
 ;; ── built-in predicates ───────────────────────────────────────────
 (cl-test "pred: null nil" (ev "(null nil)") true)
 (cl-test "pred: null non-nil" (ev "(null 5)") nil)
 (cl-test "pred: not nil" (ev "(not nil)") true)
 (cl-test "pred: not truthy" (ev "(not 5)") nil)
 (cl-test "pred: numberp" (ev "(numberp 5)") true)
 (cl-test "pred: numberp str" (ev "(numberp \"x\")") nil)
 (cl-test "pred: stringp" (ev "(stringp \"hello\")") true)
 (cl-test "pred: listp list" (ev "(listp '(1))") true)
 (cl-test "pred: listp nil" (ev "(listp nil)") true)
 (cl-test "pred: zerop" (ev "(zerop 0)") true)
 (cl-test "pred: plusp" (ev "(plusp 3)") true)
 (cl-test "pred: evenp" (ev "(evenp 4)") true)
 (cl-test "pred: oddp" (ev "(oddp 3)") true)
 ;; ── built-in list ops ─────────────────────────────────────────────
 (cl-test "list: car" (ev "(car '(1 2 3))") 1)
 (cl-test "list: cdr" (ev "(cdr '(1 2 3))") (list 2 3))
 (cl-test "list: cons" (get (ev "(cons 1 2)") "car") 1)
 (cl-test "list: list fn" (ev "(list 1 2 3)") (list 1 2 3))
 (cl-test "list: length" (ev "(length '(a b c))") 3)
 (cl-test "list: length nil" (ev "(length nil)") 0)
 (cl-test "list: append" (ev "(append '(1 2) '(3 4))") (list 1 2 3 4))
 (cl-test "list: first" (ev "(first '(10 20 30))") 10)
 (cl-test "list: second" (ev "(second '(10 20 30))") 20)
 (cl-test "list: third" (ev "(third '(10 20 30))") 30)
 (cl-test "list: rest" (ev "(rest '(1 2 3))") (list 2 3))
 (cl-test "list: nth" (ev "(nth 1 '(a b c))") "B")
 (cl-test "list: reverse" (ev "(reverse '(1 2 3))") (list 3 2 1))
 ;; ── FUNCALL / APPLY / MAPCAR ─────────────────────────────────────
 (cl-test "funcall: lambda"
  (ev "(funcall (lambda (x) (* x x)) 5)")
  25)
 (cl-test "apply: basic"
  (ev "(apply #'+ '(1 2 3))")
  6)
 (cl-test "apply: leading args"
  (ev "(apply #'+ 1 2 '(3 4))")
  10)
 (cl-test "mapcar: basic"
  (ev "(mapcar (lambda (x) (* x 2)) '(1 2 3))")
  (list 2 4 6))
 ;; ── BLOCK / RETURN-FROM / RETURN ─────────────────────────────────
 (cl-test "block: last form value"
  (ev "(block done 1 2 3)")
  3)
 (cl-test "block: empty body"
  (ev "(block done)")
  nil)
 (cl-test "block: single form"
  (ev "(block foo 42)")
  42)
 (cl-test "block: return-from"
  (ev "(block done 1 (return-from done 99) 2)")
  99)
 (cl-test "block: return-from nil block"
  (ev "(block nil 1 (return-from nil 42) 3)")
  42)
 (cl-test "block: return-from no value"
  (ev "(block done (return-from done))")
  nil)
 (cl-test "block: nested inner return stays inner"
  (ev "(block outer (block inner (return-from inner 1) 2) 3)")
  3)
 (cl-test "block: nested outer return"
  (ev "(block outer (block inner 1 2) (return-from outer 99) 3)")
  99)
 (cl-test "return: shorthand for nil block"
  (ev "(block nil (return 77))")
  77)
 (cl-test "return: no value"
  (ev "(block nil 1 (return) 2)")
  nil)
 (cl-test "block: return-from inside let"
  (ev "(block done (let ((x 5)) (when (> x 3) (return-from done x))) 0)")
  5)
 (cl-test "block: return-from inside progn"
  (ev "(block done (progn (return-from done 7) 99))")
  7)
 (cl-test "block: return-from through function"
  (ev "(block done (flet ((f () (return-from done 42))) (f)) nil)")
  42)
 ;; ── TAGBODY / GO ─────────────────────────────────────────────────
 (cl-test "tagbody: empty returns nil"
  (ev "(tagbody)")
  nil)
 (cl-test "tagbody: forms only, returns nil"
  (ev "(let ((x 0)) (tagbody (setq x 1) (setq x 2)) x)")
  2)
 (cl-test "tagbody: tag only, returns nil"
  (ev "(tagbody done)")
  nil)
 (cl-test "tagbody: go skips forms"
  (ev "(let ((x 0)) (tagbody (go done) (setq x 99) done) x)")
  0)
 (cl-test "tagbody: go to later tag"
  (ev "(let ((x 0)) (tagbody start (setq x (+ x 1)) (go done) (setq x 99) done) x)")
  1)
 (cl-test "tagbody: loop with counter"
  (ev "(let ((n 0)) (tagbody loop (when (>= n 3) (go done)) (setq n (+ n 1)) (go loop) done) n)")
  3)
 (cl-test "tagbody: go inside when"
  (ev "(let ((x 0)) (tagbody (setq x 1) (when t (go done)) (setq x 99) done) x)")
  1)
 (cl-test "tagbody: go inside progn"
  (ev "(let ((x 0)) (tagbody (progn (setq x 1) (go done)) (setq x 99) done) x)")
  1)
 (cl-test "tagbody: go inside let"
  (ev "(let ((acc 0)) (tagbody (let ((y 5)) (when (> y 3) (go done))) (setq acc 99) done) acc)")
  0)
 (cl-test "tagbody: integer tags"
  (ev "(let ((x 0)) (tagbody (go 2) 1 (setq x 1) (go 3) 2 (setq x 2) (go 3) 3) x)")
  2)
 (cl-test "tagbody: block-return propagates out"
  (ev "(block done (tagbody (return-from done 42)) nil)")
  42)
 ;; ── UNWIND-PROTECT ───────────────────────────────────────────────
 (cl-test "unwind-protect: normal returns protected"
  (ev "(unwind-protect 42 nil)")
  42)
 (cl-test "unwind-protect: cleanup runs"
  (ev "(let ((x 0)) (unwind-protect 1 (setq x 99)) x)")
  99)
 (cl-test "unwind-protect: cleanup result ignored"
  (ev "(unwind-protect 42 777)")
  42)
 (cl-test "unwind-protect: multiple cleanup forms"
  (ev "(let ((x 0)) (unwind-protect 1 (setq x (+ x 1)) (setq x (+ x 1))) x)")
  2)
 (cl-test "unwind-protect: cleanup on return-from"
  (ev "(let ((x 0)) (block done (unwind-protect (return-from done 7) (setq x 99))) x)")
  99)
 (cl-test "unwind-protect: return-from still propagates"
  (ev "(block done (unwind-protect (return-from done 42) nil))")
  42)
 (cl-test "unwind-protect: cleanup on go"
  (ev "(let ((x 0)) (tagbody (unwind-protect (go done) (setq x 1)) done) x)")
  1)
 (cl-test "unwind-protect: nested, inner cleanup first"
  (ev "(let ((n 0)) (unwind-protect (unwind-protect 1 (setq n (+ n 10))) (setq n (+ n 1))) n)")
  11)
 ;; ── VALUES / MULTIPLE-VALUE-BIND / NTH-VALUE ────────────────────
 (cl-test "values: single returns plain"
  (ev "(values 42)")
  42)
 (cl-test "values: zero returns nil"
  (ev "(values)")
  nil)
 (cl-test "values: multi — primary via funcall"
  (ev "(car (list (values 1 2)))")
  1)
 (cl-test "multiple-value-bind: basic"
  (ev "(multiple-value-bind (a b) (values 1 2) (+ a b))")
  3)
 (cl-test "multiple-value-bind: extra vars get nil"
  (ev "(multiple-value-bind (a b c) (values 10 20) (list a b c))")
  (list 10 20 nil))
 (cl-test "multiple-value-bind: extra values ignored"
  (ev "(multiple-value-bind (a) (values 1 2 3) a)")
  1)
 (cl-test "multiple-value-bind: single value source"
  (ev "(multiple-value-bind (a b) 42 (list a b))")
  (list 42 nil))
 (cl-test "nth-value: 0"
  (ev "(nth-value 0 (values 10 20 30))")
  10)
 (cl-test "nth-value: 1"
  (ev "(nth-value 1 (values 10 20 30))")
  20)
 (cl-test "nth-value: out of range"
  (ev "(nth-value 5 (values 10 20))")
  nil)
 (cl-test "multiple-value-call: basic"
  (ev "(multiple-value-call #'+ (values 1 2) (values 3 4))")
  10)
 (cl-test "multiple-value-prog1: returns first"
  (ev "(multiple-value-prog1 1 2 3)")
  1)
 (cl-test "multiple-value-prog1: side effects run"
  (ev "(let ((x 0)) (multiple-value-prog1 99 (setq x 7)) x)")
  7)
 (cl-test "values: nil primary in if"
  (ev "(if (values nil t) 'yes 'no)")
  "NO")
 (cl-test "values: truthy primary in if"
  (ev "(if (values 42 nil) 'yes 'no)")
  "YES")
 ;; --- Dynamic variables ---
 (cl-test "defvar marks special"
  (do (ev "(defvar *dv* 10)")
    (cl-special? "*DV*"))
  true)
 (cl-test "defvar: let rebinds dynamically"
  (ev "(progn (defvar *x* 1) (defun get-x () *x*) (let ((*x* 99)) (get-x)))")
  99)
 (cl-test "defvar: binding restores after let"
  (ev "(progn (defvar *yrst* 5) (let ((*yrst* 42)) *yrst*) *yrst*)")
  5)
 (cl-test "defparameter marks special"
  (do (ev "(defparameter *dp* 0)")
    (cl-special? "*DP*"))
  true)
 (cl-test "defparameter: let rebinds dynamically"
  (ev "(progn (defparameter *z* 10) (defun get-z () *z*) (let ((*z* 77)) (get-z)))")
  77)
 (cl-test "defparameter: always assigns"
  (ev "(progn (defparameter *p* 1) (defparameter *p* 2) *p*)")
  2)
 (cl-test "dynamic binding: nested lets"
  (ev "(progn (defvar *n* 0) (let ((*n* 1)) (let ((*n* 2)) *n*)))")
  2)
 (cl-test "dynamic binding: restores across nesting"
  (ev "(progn (defvar *m* 10) (let ((*m* 20)) (let ((*m* 30)) nil)) *m*)")
  10)
--- a/lib/common-lisp/tests/lambda.sx
+++ b/lib/common-lisp/tests/lambda.sx
@@ -1,204 +0,0 @@
 ;; Lambda list parser tests
 (define cl-test-pass 0)
 (define cl-test-fail 0)
 (define cl-test-fails (list))
 ;; Deep structural equality for dicts and lists
 (define
  cl-deep=
  (fn
    (a b)
    (cond
      ((= a b) true)
      ((and (dict? a) (dict? b))
        (let
          ((ak (keys a)) (bk (keys b)))
          (if
            (not (= (len ak) (len bk)))
            false
            (every?
              (fn (k) (and (has-key? b k) (cl-deep= (get a k) (get b k))))
              ak))))
      ((and (list? a) (list? b))
        (if
          (not (= (len a) (len b)))
          false
          (let
            ((i 0) (ok true))
            (define
              chk
              (fn
                ()
                (when
                  (and ok (< i (len a)))
                  (do
                    (when
                      (not (cl-deep= (nth a i) (nth b i)))
                      (set! ok false))
                    (set! i (+ i 1))
                    (chk)))))
            (chk)
            ok)))
      (:else false))))
 (define
  cl-test
  (fn
    (name actual expected)
    (if
      (cl-deep= actual expected)
      (set! cl-test-pass (+ cl-test-pass 1))
      (do
        (set! cl-test-fail (+ cl-test-fail 1))
        (append! cl-test-fails {:name name :expected expected :actual actual})))))
 ;; Helper: parse lambda list from string "(x y ...)"
 (define ll (fn (src) (cl-parse-lambda-list-str src)))
 (define ll-req  (fn (src) (get (ll src) "required")))
 (define ll-opt  (fn (src) (get (ll src) "optional")))
 (define ll-rest (fn (src) (get (ll src) "rest")))
 (define ll-key  (fn (src) (get (ll src) "key")))
 (define ll-aok  (fn (src) (get (ll src) "allow-other-keys")))
 (define ll-aux  (fn (src) (get (ll src) "aux")))
 ;; ── required parameters ───────────────────────────────────────────
 (cl-test "required: empty" (ll-req "()") (list))
 (cl-test "required: one" (ll-req "(x)") (list "X"))
 (cl-test "required: two" (ll-req "(x y)") (list "X" "Y"))
 (cl-test "required: three" (ll-req "(a b c)") (list "A" "B" "C"))
 (cl-test "required: upcased" (ll-req "(foo bar)") (list "FOO" "BAR"))
 ;; ── &optional ─────────────────────────────────────────────────────
 (cl-test "optional: none" (ll-opt "(x)") (list))
 (cl-test
  "optional: bare symbol"
  (ll-opt "(x &optional z)")
  (list {:name "Z" :default nil :supplied nil}))
 (cl-test
  "optional: with default"
  (ll-opt "(x &optional (z 0))")
  (list {:name "Z" :default 0 :supplied nil}))
 (cl-test
  "optional: with supplied-p"
  (ll-opt "(x &optional (z 0 z-p))")
  (list {:name "Z" :default 0 :supplied "Z-P"}))
 (cl-test
  "optional: two params"
  (ll-opt "(&optional a (b 1))")
  (list {:name "A" :default nil :supplied nil} {:name "B" :default 1 :supplied nil}))
 (cl-test
  "optional: string default"
  (ll-opt "(&optional (name \"world\"))")
  (list {:name "NAME" :default {:cl-type "string" :value "world"} :supplied nil}))
 ;; ── &rest ─────────────────────────────────────────────────────────
 (cl-test "rest: none" (ll-rest "(x)") nil)
 (cl-test "rest: present" (ll-rest "(x &rest args)") "ARGS")
 (cl-test "rest: with required" (ll-rest "(a b &rest tail)") "TAIL")
 ;; &body is an alias for &rest
 (cl-test "body: alias for rest" (ll-rest "(&body forms)") "FORMS")
 ;; rest doesn't consume required params
 (cl-test "rest: required still there" (ll-req "(a b &rest rest)") (list "A" "B"))
 ;; ── &key ──────────────────────────────────────────────────────────
 (cl-test "key: none" (ll-key "(x)") (list))
 (cl-test
  "key: bare symbol"
  (ll-key "(&key x)")
  (list {:name "X" :keyword "X" :default nil :supplied nil}))
 (cl-test
  "key: with default"
  (ll-key "(&key (x 42))")
  (list {:name "X" :keyword "X" :default 42 :supplied nil}))
 (cl-test
  "key: with supplied-p"
  (ll-key "(&key (x 42 x-p))")
  (list {:name "X" :keyword "X" :default 42 :supplied "X-P"}))
 (cl-test
  "key: two params"
  (ll-key "(&key a b)")
  (list
    {:name "A" :keyword "A" :default nil :supplied nil}
    {:name "B" :keyword "B" :default nil :supplied nil}))
 ;; ── &allow-other-keys ─────────────────────────────────────────────
 (cl-test "aok: absent" (ll-aok "(x)") false)
 (cl-test "aok: present" (ll-aok "(&key x &allow-other-keys)") true)
 ;; ── &aux ──────────────────────────────────────────────────────────
 (cl-test "aux: none" (ll-aux "(x)") (list))
 (cl-test
  "aux: bare symbol"
  (ll-aux "(&aux temp)")
  (list {:name "TEMP" :init nil}))
 (cl-test
  "aux: with init"
  (ll-aux "(&aux (count 0))")
  (list {:name "COUNT" :init 0}))
 (cl-test
  "aux: two vars"
  (ll-aux "(&aux a (b 1))")
  (list {:name "A" :init nil} {:name "B" :init 1}))
 ;; ── combined ──────────────────────────────────────────────────────
 (cl-test
  "combined: full lambda list"
  (let
    ((parsed (ll "(x y &optional (z 0 z-p) &rest args &key a (b nil b-p) &aux temp)")))
    (list
      (get parsed "required")
      (get (nth (get parsed "optional") 0) "name")
      (get (nth (get parsed "optional") 0) "default")
      (get (nth (get parsed "optional") 0) "supplied")
      (get parsed "rest")
      (get (nth (get parsed "key") 0) "name")
      (get (nth (get parsed "key") 1) "supplied")
      (get (nth (get parsed "aux") 0) "name")))
  (list
    (list "X" "Y")
    "Z"
    0
    "Z-P"
    "ARGS"
    "A"
    "B-P"
    "TEMP"))
 (cl-test
  "combined: required only stops before &"
  (ll-req "(a b &optional c)")
  (list "A" "B"))
 (cl-test
  "combined: required only with &key"
  (ll-req "(x &key y)")
  (list "X"))
 (cl-test
  "combined: &rest and &key together"
  (let
    ((parsed (ll "(&rest args &key verbose)")))
    (list (get parsed "rest") (get (nth (get parsed "key") 0) "name")))
  (list "ARGS" "VERBOSE"))
--- a/lib/common-lisp/tests/macros.sx
+++ b/lib/common-lisp/tests/macros.sx
@@ -1,204 +0,0 @@
 ;; lib/common-lisp/tests/macros.sx — Phase 5: defmacro, gensym, LOOP tests
 ;;
 ;; Depends on: runtime.sx, eval.sx, loop.sx already loaded.
 ;; Tests via (ev "...") using the CL evaluator.
 (define ev (fn (src) (cl-eval-str src (cl-make-env))))
 (define evall (fn (src) (cl-eval-all-str src (cl-make-env))))
 (define passed 0)
 (define failed 0)
 (define failures (list))
 (define
  check
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))
 ;; ── defmacro basics ──────────────────────────────────────────────────────────
 (check
  "defmacro returns name"
  (ev "(defmacro my-or (a b) (list 'if a a b))")
  "MY-OR")
 (check
  "defmacro expansion works"
  (ev "(progn (defmacro my-inc (x) (list '+ x 1)) (my-inc 5))")
  6)
 (check
  "defmacro with &rest"
  (ev "(progn (defmacro my-list (&rest xs) (cons 'list xs)) (my-list 1 2 3))")
  (list 1 2 3))
 (check
  "nested macro expansion"
  (ev "(progn (defmacro sq (x) (list '* x x)) (sq 7))")
  49)
 (check
  "macro in conditional"
  (ev
    "(progn (defmacro my-when (c &rest body) (list 'if c (cons 'progn body) nil)) (my-when t 10 20))")
  20)
 (check
  "macro returns nil branch"
  (ev
    "(progn (defmacro my-when (c &rest body) (list 'if c (cons 'progn body) nil)) (my-when nil 42))")
  nil)
 ;; ── macroexpand ───────────────────────────────────────────────────────────────
 (check
  "macroexpand returns expanded form"
  (ev "(progn (defmacro double (x) (list '+ x x)) (macroexpand '(double 5)))")
  (list "+" 5 5))
 ;; ── gensym ────────────────────────────────────────────────────────────────────
 (check "gensym returns string" (ev "(stringp (gensym))") true)
 (check
  "gensym prefix"
  (ev "(let ((g (gensym \"MY\"))) (not (= g nil)))")
  true)
 (check "gensyms are unique" (ev "(not (= (gensym) (gensym)))") true)
 ;; ── swap! macro with gensym ───────────────────────────────────────────────────
 (check
  "swap! macro"
  (evall
    "(defmacro swap! (a b) (let ((tmp (gensym))) (list 'let (list (list tmp a)) (list 'setq a b) (list 'setq b tmp)))) (defvar *a* 10) (defvar *b* 20) (swap! *a* *b*) (list *a* *b*)")
  (list 20 10))
 ;; ── LOOP: basic repeat and collect ────────────────────────────────────────────
 (check
  "loop repeat collect"
  (ev "(loop repeat 3 collect 99)")
  (list 99 99 99))
 (check
  "loop for-in collect"
  (ev "(loop for x in '(1 2 3) collect (* x x))")
  (list 1 4 9))
 (check
  "loop for-from-to collect"
  (ev "(loop for i from 1 to 5 collect i)")
  (list 1 2 3 4 5))
 (check
  "loop for-from-below collect"
  (ev "(loop for i from 0 below 4 collect i)")
  (list 0 1 2 3))
 (check
  "loop for-downto collect"
  (ev "(loop for i from 5 downto 1 collect i)")
  (list 5 4 3 2 1))
 (check
  "loop for-by collect"
  (ev "(loop for i from 0 to 10 by 2 collect i)")
  (list 0 2 4 6 8 10))
 ;; ── LOOP: sum, count, maximize, minimize ─────────────────────────────────────
 (check "loop sum" (ev "(loop for i from 1 to 5 sum i)") 15)
 (check
  "loop count"
  (ev "(loop for x in '(1 2 3 4 5) count (> x 3))")
  2)
 (check
  "loop maximize"
  (ev "(loop for x in '(3 1 4 1 5 9 2 6) maximize x)")
  9)
 (check
  "loop minimize"
  (ev "(loop for x in '(3 1 4 1 5 9 2 6) minimize x)")
  1)
 ;; ── LOOP: while and until ─────────────────────────────────────────────────────
 (check
  "loop while"
  (ev "(loop for i from 1 to 10 while (< i 5) collect i)")
  (list 1 2 3 4))
 (check
  "loop until"
  (ev "(loop for i from 1 to 10 until (= i 5) collect i)")
  (list 1 2 3 4))
 ;; ── LOOP: when / unless ───────────────────────────────────────────────────────
 (check
  "loop when filter"
  (ev "(loop for i from 0 below 8 when (evenp i) collect i)")
  (list 0 2 4 6))
 (check
  "loop unless filter"
  (ev "(loop for i from 0 below 8 unless (evenp i) collect i)")
  (list 1 3 5 7))
 ;; ── LOOP: append ─────────────────────────────────────────────────────────────
 (check
  "loop append"
  (ev "(loop for x in '((1 2) (3 4) (5 6)) append x)")
  (list 1 2 3 4 5 6))
 ;; ── LOOP: always, never, thereis ─────────────────────────────────────────────
 (check
  "loop always true"
  (ev "(loop for x in '(2 4 6) always (evenp x))")
  true)
 (check
  "loop always false"
  (ev "(loop for x in '(2 3 6) always (evenp x))")
  false)
 (check "loop never" (ev "(loop for x in '(1 3 5) never (evenp x))") true)
 (check "loop thereis" (ev "(loop for x in '(1 2 3) thereis (> x 2))") true)
 ;; ── LOOP: for = then (general iteration) ─────────────────────────────────────
 (check
  "loop for = then doubling"
  (ev "(loop repeat 5 for x = 1 then (* x 2) collect x)")
  (list 1 2 4 8 16))
 ;; ── summary ────────────────────────────────────────────────────────────────
 (define macro-passed passed)
 (define macro-failed failed)
 (define macro-failures failures)
--- a/lib/common-lisp/tests/parse.sx
+++ b/lib/common-lisp/tests/parse.sx
@@ -1,160 +0,0 @@
 ;; Common Lisp reader/parser tests
 (define cl-test-pass 0)
 (define cl-test-fail 0)
 (define cl-test-fails (list))
 (define
  cl-deep=
  (fn
    (a b)
    (cond
      ((= a b) true)
      ((and (dict? a) (dict? b))
        (let
          ((ak (keys a)) (bk (keys b)))
          (if
            (not (= (len ak) (len bk)))
            false
            (every?
              (fn (k) (and (has-key? b k) (cl-deep= (get a k) (get b k))))
              ak))))
      ((and (list? a) (list? b))
        (if
          (not (= (len a) (len b)))
          false
          (let
            ((i 0) (ok true))
            (define
              chk
              (fn
                ()
                (when
                  (and ok (< i (len a)))
                  (do
                    (when
                      (not (cl-deep= (nth a i) (nth b i)))
                      (set! ok false))
                    (set! i (+ i 1))
                    (chk)))))
            (chk)
            ok)))
      (:else false))))
 (define
  cl-test
  (fn
    (name actual expected)
    (if
      (cl-deep= actual expected)
      (set! cl-test-pass (+ cl-test-pass 1))
      (do
        (set! cl-test-fail (+ cl-test-fail 1))
        (append! cl-test-fails {:name name :expected expected :actual actual})))))
 ;; ── atoms ─────────────────────────────────────────────────────────
 (cl-test "integer: 42" (cl-read "42") 42)
 (cl-test "integer: 0" (cl-read "0") 0)
 (cl-test "integer: negative" (cl-read "-5") -5)
 (cl-test "integer: positive sign" (cl-read "+3") 3)
 (cl-test "integer: hex #xFF" (cl-read "#xFF") 255)
 (cl-test "integer: hex #xAB" (cl-read "#xAB") 171)
 (cl-test "integer: binary #b1010" (cl-read "#b1010") 10)
 (cl-test "integer: octal #o17" (cl-read "#o17") 15)
 (cl-test "float: type" (get (cl-read "3.14") "cl-type") "float")
 (cl-test "float: value" (get (cl-read "3.14") "value") "3.14")
 (cl-test "float: neg" (get (cl-read "-2.5") "value") "-2.5")
 (cl-test "float: exp" (get (cl-read "1.0e10") "value") "1.0e10")
 (cl-test "ratio: type" (get (cl-read "1/3") "cl-type") "ratio")
 (cl-test "ratio: value" (get (cl-read "1/3") "value") "1/3")
 (cl-test "ratio: 22/7" (get (cl-read "22/7") "value") "22/7")
 (cl-test "string: basic" (cl-read "\"hello\"") {:cl-type "string" :value "hello"})
 (cl-test "string: empty" (cl-read "\"\"") {:cl-type "string" :value ""})
 (cl-test "string: with escape" (cl-read "\"a\\nb\"") {:cl-type "string" :value "a\nb"})
 (cl-test "symbol: foo" (cl-read "foo") "FOO")
 (cl-test "symbol: BAR" (cl-read "BAR") "BAR")
 (cl-test "symbol: pkg:sym" (cl-read "cl:car") "CL:CAR")
 (cl-test "symbol: pkg::sym" (cl-read "pkg::foo") "PKG::FOO")
 (cl-test "nil: symbol" (cl-read "nil") nil)
 (cl-test "nil: uppercase" (cl-read "NIL") nil)
 (cl-test "t: symbol" (cl-read "t") true)
 (cl-test "t: uppercase" (cl-read "T") true)
 (cl-test "keyword: type" (get (cl-read ":foo") "cl-type") "keyword")
 (cl-test "keyword: name" (get (cl-read ":foo") "name") "FOO")
 (cl-test "keyword: :test" (get (cl-read ":test") "name") "TEST")
 (cl-test "char: type" (get (cl-read "#\\a") "cl-type") "char")
 (cl-test "char: value" (get (cl-read "#\\a") "value") "a")
 (cl-test "char: Space" (get (cl-read "#\\Space") "value") " ")
 (cl-test "char: Newline" (get (cl-read "#\\Newline") "value") "\n")
 (cl-test "uninterned: type" (get (cl-read "#:foo") "cl-type") "uninterned")
 (cl-test "uninterned: name" (get (cl-read "#:foo") "name") "FOO")
 ;; ── lists ─────────────────────────────────────────────────────────
 (cl-test "list: empty" (cl-read "()") (list))
 (cl-test "list: one element" (cl-read "(foo)") (list "FOO"))
 (cl-test "list: two elements" (cl-read "(foo bar)") (list "FOO" "BAR"))
 (cl-test "list: nested" (cl-read "((a b) c)") (list (list "A" "B") "C"))
 (cl-test "list: with integer" (cl-read "(+ 1 2)") (list "+" 1 2))
 (cl-test "list: with string" (cl-read "(print \"hi\")") (list "PRINT" {:cl-type "string" :value "hi"}))
 (cl-test "list: nil element" (cl-read "(a nil b)") (list "A" nil "B"))
 (cl-test "list: t element" (cl-read "(a t b)") (list "A" true "B"))
 ;; ── dotted pairs ──────────────────────────────────────────────<E29480><E29480>──
 (cl-test "dotted: type" (get (cl-read "(a . b)") "cl-type") "cons")
 (cl-test "dotted: car" (get (cl-read "(a . b)") "car") "A")
 (cl-test "dotted: cdr" (get (cl-read "(a . b)") "cdr") "B")
 (cl-test "dotted: number cdr" (get (cl-read "(x . 42)") "cdr") 42)
 ;; ── reader macros ────────────────────────────────────────────────<E29480><E29480>
 (cl-test "quote: form" (cl-read "'x") (list "QUOTE" "X"))
 (cl-test "quote: list" (cl-read "'(a b)") (list "QUOTE" (list "A" "B")))
 (cl-test "backquote: form" (cl-read "`x") (list "QUASIQUOTE" "X"))
 (cl-test "unquote: form" (cl-read ",x") (list "UNQUOTE" "X"))
 (cl-test "comma-at: form" (cl-read ",@x") (list "UNQUOTE-SPLICING" "X"))
 (cl-test "function: form" (cl-read "#'foo") (list "FUNCTION" "FOO"))
 ;; ── vector ────────────────────────────────────────────────────────
 (cl-test "vector: type" (get (cl-read "#(1 2 3)") "cl-type") "vector")
 (cl-test "vector: elements" (get (cl-read "#(1 2 3)") "elements") (list 1 2 3))
 (cl-test "vector: empty" (get (cl-read "#()") "elements") (list))
 (cl-test "vector: mixed" (get (cl-read "#(a 1 \"s\")") "elements") (list "A" 1 {:cl-type "string" :value "s"}))
 ;; ── cl-read-all ───────────────────────────────────────────────────
 (cl-test
  "read-all: empty"
  (cl-read-all "")
  (list))
 (cl-test
  "read-all: two forms"
  (cl-read-all "42 foo")
  (list 42 "FOO"))
 (cl-test
  "read-all: three forms"
  (cl-read-all "(+ 1 2) (+ 3 4) hello")
  (list (list "+" 1 2) (list "+" 3 4) "HELLO"))
 (cl-test
  "read-all: with comments"
  (cl-read-all "; this is a comment\n42 ; inline\nfoo")
  (list 42 "FOO"))
 (cl-test
  "read-all: defun form"
  (nth (cl-read-all "(defun square (x) (* x x))") 0)
  (list "DEFUN" "SQUARE" (list "X") (list "*" "X" "X")))
--- a/lib/common-lisp/tests/programs/geometry.sx
+++ b/lib/common-lisp/tests/programs/geometry.sx
@@ -1,291 +0,0 @@
 ;; geometry.sx — Multiple dispatch with CLOS
 ;;
 ;; Demonstrates generic functions dispatching on combinations of
 ;; geometric types: point, line, plane.
 ;;
 ;; Depends on: lib/common-lisp/runtime.sx, lib/common-lisp/clos.sx
 ;; ── geometric classes ──────────────────────────────────────────────────────
 (clos-defclass "geo-point" (list "t") (list {:initform 0 :initarg ":px" :reader nil :writer nil :accessor nil :name "px"} {:initform 0 :initarg ":py" :reader nil :writer nil :accessor nil :name "py"}))
 (clos-defclass "geo-line" (list "t") (list {:initform nil :initarg ":p1" :reader nil :writer nil :accessor nil :name "p1"} {:initform nil :initarg ":p2" :reader nil :writer nil :accessor nil :name "p2"}))
 (clos-defclass "geo-plane" (list "t") (list {:initform nil :initarg ":normal" :reader nil :writer nil :accessor nil :name "normal"} {:initform 0 :initarg ":d" :reader nil :writer nil :accessor nil :name "d"}))
 ;; ── helpers ────────────────────────────────────────────────────────────────
 (define geo-point-x (fn (p) (clos-slot-value p "px")))
 (define geo-point-y (fn (p) (clos-slot-value p "py")))
 (define
  geo-make-point
  (fn (x y) (clos-make-instance "geo-point" ":px" x ":py" y)))
 (define
  geo-make-line
  (fn (p1 p2) (clos-make-instance "geo-line" ":p1" p1 ":p2" p2)))
 (define
  geo-make-plane
  (fn
    (nx ny d)
    (clos-make-instance "geo-plane" ":normal" (list nx ny) ":d" d)))
 ;; ── describe generic ───────────────────────────────────────────────────────
 (clos-defgeneric "geo-describe" {})
 (clos-defmethod
  "geo-describe"
  (list)
  (list "geo-point")
  (fn
    (args next-fn)
    (let
      ((p (first args)))
      (str "P(" (geo-point-x p) "," (geo-point-y p) ")"))))
 (clos-defmethod
  "geo-describe"
  (list)
  (list "geo-line")
  (fn
    (args next-fn)
    (let
      ((l (first args)))
      (str
        "L["
        (clos-call-generic "geo-describe" (list (clos-slot-value l "p1")))
        "-"
        (clos-call-generic "geo-describe" (list (clos-slot-value l "p2")))
        "]"))))
 (clos-defmethod
  "geo-describe"
  (list)
  (list "geo-plane")
  (fn
    (args next-fn)
    (let
      ((pl (first args)))
      (str "Plane(d=" (clos-slot-value pl "d") ")"))))
 ;; ── intersect: multi-dispatch generic ─────────────────────────────────────
 ;;
 ;; Returns a string description of the intersection result.
 (clos-defgeneric "intersect" {})
 ;; point ∩ point: same if coordinates match
 (clos-defmethod
  "intersect"
  (list)
  (list "geo-point" "geo-point")
  (fn
    (args next-fn)
    (let
      ((p1 (first args)) (p2 (first (rest args))))
      (if
        (and
          (= (geo-point-x p1) (geo-point-x p2))
          (= (geo-point-y p1) (geo-point-y p2)))
        "point"
        "empty"))))
 ;; point ∩ line: check if point lies on line (cross product = 0)
 (clos-defmethod
  "intersect"
  (list)
  (list "geo-point" "geo-line")
  (fn
    (args next-fn)
    (let
      ((pt (first args)) (ln (first (rest args))))
      (let
        ((lp1 (clos-slot-value ln "p1")) (lp2 (clos-slot-value ln "p2")))
        (let
          ((dx (- (geo-point-x lp2) (geo-point-x lp1)))
            (dy (- (geo-point-y lp2) (geo-point-y lp1)))
            (ex (- (geo-point-x pt) (geo-point-x lp1)))
            (ey (- (geo-point-y pt) (geo-point-y lp1))))
          (if (= (- (* dx ey) (* dy ex)) 0) "point" "empty"))))))
 ;; line ∩ line: parallel (same slope = empty) or point
 (clos-defmethod
  "intersect"
  (list)
  (list "geo-line" "geo-line")
  (fn
    (args next-fn)
    (let
      ((l1 (first args)) (l2 (first (rest args))))
      (let
        ((p1 (clos-slot-value l1 "p1"))
          (p2 (clos-slot-value l1 "p2"))
          (p3 (clos-slot-value l2 "p1"))
          (p4 (clos-slot-value l2 "p2")))
        (let
          ((dx1 (- (geo-point-x p2) (geo-point-x p1)))
            (dy1 (- (geo-point-y p2) (geo-point-y p1)))
            (dx2 (- (geo-point-x p4) (geo-point-x p3)))
            (dy2 (- (geo-point-y p4) (geo-point-y p3))))
          (let
            ((cross (- (* dx1 dy2) (* dy1 dx2))))
            (if (= cross 0) "parallel" "point")))))))
 ;; line ∩ plane: general case = point (or parallel if line ⊥ normal)
 (clos-defmethod
  "intersect"
  (list)
  (list "geo-line" "geo-plane")
  (fn
    (args next-fn)
    (let
      ((ln (first args)) (pl (first (rest args))))
      (let
        ((p1 (clos-slot-value ln "p1"))
          (p2 (clos-slot-value ln "p2"))
          (n (clos-slot-value pl "normal")))
        (let
          ((dx (- (geo-point-x p2) (geo-point-x p1)))
            (dy (- (geo-point-y p2) (geo-point-y p1)))
            (nx (first n))
            (ny (first (rest n))))
          (let
            ((dot (+ (* dx nx) (* dy ny))))
            (if (= dot 0) "parallel" "point")))))))
 ;; ── tests ─────────────────────────────────────────────────────────────────
 (define passed 0)
 (define failed 0)
 (define failures (list))
 (define
  check
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))
 ;; describe
 (check
  "describe point"
  (clos-call-generic
    "geo-describe"
    (list (geo-make-point 3 4)))
  "P(3,4)")
 (check
  "describe line"
  (clos-call-generic
    "geo-describe"
    (list
      (geo-make-line
        (geo-make-point 0 0)
        (geo-make-point 1 1))))
  "L[P(0,0)-P(1,1)]")
 (check
  "describe plane"
  (clos-call-generic
    "geo-describe"
    (list (geo-make-plane 0 1 5)))
  "Plane(d=5)")
 ;; intersect point×point
 (check
  "P∩P same"
  (clos-call-generic
    "intersect"
    (list
      (geo-make-point 2 3)
      (geo-make-point 2 3)))
  "point")
 (check
  "P∩P diff"
  (clos-call-generic
    "intersect"
    (list
      (geo-make-point 1 2)
      (geo-make-point 3 4)))
  "empty")
 ;; intersect point×line
 (let
  ((origin (geo-make-point 0 0))
    (p10 (geo-make-point 10 0))
    (p55 (geo-make-point 5 5))
    (l-x
      (geo-make-line
        (geo-make-point 0 0)
        (geo-make-point 10 0))))
  (begin
    (check
      "P∩L on line"
      (clos-call-generic "intersect" (list p10 l-x))
      "point")
    (check
      "P∩L on x-axis"
      (clos-call-generic "intersect" (list origin l-x))
      "point")
    (check
      "P∩L off line"
      (clos-call-generic "intersect" (list p55 l-x))
      "empty")))
 ;; intersect line×line
 (let
  ((horiz (geo-make-line (geo-make-point 0 0) (geo-make-point 10 0)))
    (vert
      (geo-make-line
        (geo-make-point 5 -5)
        (geo-make-point 5 5)))
    (horiz2
      (geo-make-line
        (geo-make-point 0 3)
        (geo-make-point 10 3))))
  (begin
    (check
      "L∩L crossing"
      (clos-call-generic "intersect" (list horiz vert))
      "point")
    (check
      "L∩L parallel"
      (clos-call-generic "intersect" (list horiz horiz2))
      "parallel")))
 ;; intersect line×plane
 (let
  ((diag (geo-make-line (geo-make-point 0 0) (geo-make-point 1 1)))
    (vert-plane (geo-make-plane 1 0 5))
    (diag-plane (geo-make-plane -1 1 0)))
  (begin
    (check
      "L∩Plane cross"
      (clos-call-generic "intersect" (list diag vert-plane))
      "point")
    (check
      "L∩Plane parallel"
      (clos-call-generic "intersect" (list diag diag-plane))
      "parallel")))
 ;; ── summary ────────────────────────────────────────────────────────────────
 (define geo-passed passed)
 (define geo-failed failed)
 (define geo-failures failures)
--- a/lib/common-lisp/tests/programs/interactive-debugger.sx
+++ b/lib/common-lisp/tests/programs/interactive-debugger.sx
@@ -1,196 +0,0 @@
 ;; interactive-debugger.sx — Condition debugger using *debugger-hook*
 ;;
 ;; Demonstrates the classic CL debugger pattern:
 ;;   - *debugger-hook* is invoked when an unhandled error reaches the top level
 ;;   - The hook receives the condition and a reference to itself
 ;;   - It can offer restarts interactively (here simulated with a policy fn)
 ;;
 ;; In real CL the debugger reads from the terminal. Here we simulate
 ;; the "user input" via a policy function passed in at call time.
 ;;
 ;; Depends on: lib/common-lisp/runtime.sx already loaded.
 ;; ── *debugger-hook* global ────────────────────────────────────────────────
 ;;
 ;; CL: when error is unhandled, invoke *debugger-hook* with (condition hook).
 ;; A nil hook means use the system default (which we simulate as re-raise).
 (define cl-debugger-hook nil)
 ;; ── invoke-debugger ────────────────────────────────────────────────────────
 ;;
 ;; Called when cl-error finds no handler. Tries cl-debugger-hook first;
 ;; falls back to a simple error report.
 (define
  cl-invoke-debugger
  (fn
    (c)
    (if
      (nil? cl-debugger-hook)
      (error (str "Debugger: " (cl-condition-message c)))
      (begin
        (let
          ((hook cl-debugger-hook))
          (set! cl-debugger-hook nil)
          (let
            ((result (hook c hook)))
            (set! cl-debugger-hook hook)
            result))))))
 ;; ── cl-error/debugger — error that routes through invoke-debugger ─────────
 (define
  cl-error-with-debugger
  (fn
    (c &rest args)
    (let
      ((obj (cond ((cl-condition? c) c) ((string? c) (cl-make-condition "simple-error" "format-control" c "format-arguments" args)) (:else (cl-make-condition "simple-error" "format-control" (str c))))))
      (cl-signal-obj obj cl-handler-stack)
      (cl-invoke-debugger obj))))
 ;; ── simulated debugger session ────────────────────────────────────────────
 ;;
 ;; A debugger hook takes (condition hook) and "reads" user commands.
 ;; We simulate this with a policy function: (fn (c restarts) restart-name)
 ;; that picks a restart given the condition and available restarts.
 (define
  make-policy-debugger
  (fn
    (policy)
    (fn
      (c hook)
      (let
        ((available (cl-compute-restarts)))
        (let
          ((choice (policy c available)))
          (if
            (and choice (not (nil? (cl-find-restart choice))))
            (cl-invoke-restart choice)
            (error
              (str
                "Debugger: no restart chosen for: "
                (cl-condition-message c)))))))))
 ;; ── tests ─────────────────────────────────────────────────────────────────
 (define passed 0)
 (define failed 0)
 (define failures (list))
 (define
  check
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))
 (define
  reset-stacks!
  (fn
    ()
    (set! cl-handler-stack (list))
    (set! cl-restart-stack (list))
    (set! cl-debugger-hook nil)))
 ;; Test 1: debugger hook receives condition
 (reset-stacks!)
 (let
  ((received-msg ""))
  (begin
    (set!
      cl-debugger-hook
      (fn (c hook) (set! received-msg (cl-condition-message c)) nil))
    (cl-restart-case
      (fn () (cl-error-with-debugger "something broke"))
      (list "abort" (list) (fn () nil)))
    (check "debugger hook receives condition" received-msg "something broke")))
 ;; Test 2: policy-driven restart selection (use-zero)
 (reset-stacks!)
 (let
  ((result (begin (set! cl-debugger-hook (make-policy-debugger (fn (c restarts) "use-zero"))) (cl-restart-case (fn () (cl-error-with-debugger (cl-make-condition "division-by-zero")) 999) (list "use-zero" (list) (fn () 0))))))
  (check "policy debugger: use-zero restart" result 0))
 ;; Test 3: policy selects abort
 (reset-stacks!)
 (let
  ((result (begin (set! cl-debugger-hook (make-policy-debugger (fn (c restarts) "abort"))) (cl-restart-case (fn () (cl-error-with-debugger "aborting error") 999) (list "abort" (list) (fn () "aborted"))))))
  (check "policy debugger: abort restart" result "aborted"))
 ;; Test 4: compute-restarts inside debugger hook
 (reset-stacks!)
 (let
  ((seen-restarts (list)))
  (begin
    (set!
      cl-debugger-hook
      (fn
        (c hook)
        (set! seen-restarts (cl-compute-restarts))
        (cl-invoke-restart "continue")))
    (cl-restart-case
      (fn () (cl-error-with-debugger "test") 42)
      (list "continue" (list) (fn () "ok"))
      (list "abort" (list) (fn () "no")))
    (check
      "debugger: compute-restarts visible"
      (= (len seen-restarts) 2)
      true)))
 ;; Test 5: hook not invoked when handler catches first
 (reset-stacks!)
 (let
  ((hook-called false)
    (result
      (begin
        (set! cl-debugger-hook (fn (c hook) (set! hook-called true) nil))
        (cl-handler-case
          (fn () (cl-error-with-debugger "handled"))
          (list "error" (fn (c) "handler-won"))))))
  (check "handler wins; hook not called" hook-called false)
  (check "handler result returned" result "handler-won"))
 ;; Test 6: debugger-hook nil after re-raise guard
 (reset-stacks!)
 (let
  ((hook-calls 0))
  (begin
    (set!
      cl-debugger-hook
      (fn
        (c hook)
        (set! hook-calls (+ hook-calls 1))
        (if
          (> hook-calls 1)
          (error "infinite loop guard")
          (cl-invoke-restart "escape"))))
    (cl-restart-case
      (fn () (cl-error-with-debugger "once"))
      (list "escape" (list) (fn () nil)))
    (check
      "hook called exactly once (no infinite recursion)"
      hook-calls
      1)))
 ;; ── summary ────────────────────────────────────────────────────────────────
 (define debugger-passed passed)
 (define debugger-failed failed)
 (define debugger-failures failures)
--- a/lib/common-lisp/tests/programs/mop-trace.sx
+++ b/lib/common-lisp/tests/programs/mop-trace.sx
@@ -1,228 +0,0 @@
 ;; mop-trace.sx — :before/:after method tracing with CLOS
 ;;
 ;; Classic CLOS pattern: instrument generic functions with :before and :after
 ;; qualifiers to print call/return traces without modifying the primary method.
 ;;
 ;; Depends on: lib/common-lisp/runtime.sx, lib/common-lisp/clos.sx
 ;; ── trace log (mutable accumulator) ───────────────────────────────────────
 (define trace-log (list))
 (define
  trace-push
  (fn (msg) (set! trace-log (append trace-log (list msg)))))
 (define trace-clear (fn () (set! trace-log (list))))
 ;; ── domain classes ─────────────────────────────────────────────────────────
 (clos-defclass "shape" (list "t") (list {:initform "white" :initarg ":color" :reader nil :writer nil :accessor nil :name "color"}))
 (clos-defclass "circle" (list "shape") (list {:initform 1 :initarg ":radius" :reader nil :writer nil :accessor nil :name "radius"}))
 (clos-defclass "rect" (list "shape") (list {:initform 1 :initarg ":width" :reader nil :writer nil :accessor nil :name "width"} {:initform 1 :initarg ":height" :reader nil :writer nil :accessor nil :name "height"}))
 ;; ── generic function: area ─────────────────────────────────────────────────
 (clos-defgeneric "area" {})
 ;; primary methods
 (clos-defmethod
  "area"
  (list)
  (list "circle")
  (fn
    (args next-fn)
    (let
      ((c (first args)))
      (let ((r (clos-slot-value c "radius"))) (* r r)))))
 (clos-defmethod
  "area"
  (list)
  (list "rect")
  (fn
    (args next-fn)
    (let
      ((r (first args)))
      (* (clos-slot-value r "width") (clos-slot-value r "height")))))
 ;; :before tracing
 (clos-defmethod
  "area"
  (list "before")
  (list "shape")
  (fn
    (args next-fn)
    (trace-push (str "BEFORE area(" (clos-class-of (first args)) ")"))))
 ;; :after tracing
 (clos-defmethod
  "area"
  (list "after")
  (list "shape")
  (fn
    (args next-fn)
    (trace-push (str "AFTER area(" (clos-class-of (first args)) ")"))))
 ;; ── generic function: describe-shape ──────────────────────────────────────
 (clos-defgeneric "describe-shape" {})
 (clos-defmethod
  "describe-shape"
  (list)
  (list "shape")
  (fn
    (args next-fn)
    (let
      ((s (first args)))
      (str "shape[" (clos-slot-value s "color") "]"))))
 (clos-defmethod
  "describe-shape"
  (list)
  (list "circle")
  (fn
    (args next-fn)
    (let
      ((c (first args)))
      (str
        "circle[r="
        (clos-slot-value c "radius")
        " "
        (clos-call-next-method next-fn)
        "]"))))
 (clos-defmethod
  "describe-shape"
  (list)
  (list "rect")
  (fn
    (args next-fn)
    (let
      ((r (first args)))
      (str
        "rect["
        (clos-slot-value r "width")
        "x"
        (clos-slot-value r "height")
        " "
        (clos-call-next-method next-fn)
        "]"))))
 ;; :before on base shape (fires for all subclasses too)
 (clos-defmethod
  "describe-shape"
  (list "before")
  (list "shape")
  (fn
    (args next-fn)
    (trace-push
      (str "BEFORE describe-shape(" (clos-class-of (first args)) ")"))))
 ;; ── tests ─────────────────────────────────────────────────────────────────
 (define passed 0)
 (define failed 0)
 (define failures (list))
 (define
  check
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))
 ;; ── area tests ────────────────────────────────────────────────────────────
 ;; circle area = r*r (no pi — integer arithmetic for predictability)
 (let
  ((c (clos-make-instance "circle" ":radius" 5 ":color" "red")))
  (do
    (trace-clear)
    (check "circle area" (clos-call-generic "area" (list c)) 25)
    (check
      ":before fired for circle"
      (= (first trace-log) "BEFORE area(circle)")
      true)
    (check
      ":after fired for circle"
      (= (first (rest trace-log)) "AFTER area(circle)")
      true)
    (check "trace length 2" (len trace-log) 2)))
 ;; rect area = w*h
 (let
  ((r (clos-make-instance "rect" ":width" 4 ":height" 6 ":color" "blue")))
  (do
    (trace-clear)
    (check "rect area" (clos-call-generic "area" (list r)) 24)
    (check
      ":before fired for rect"
      (= (first trace-log) "BEFORE area(rect)")
      true)
    (check
      ":after fired for rect"
      (= (first (rest trace-log)) "AFTER area(rect)")
      true)
    (check "trace length 2 (rect)" (len trace-log) 2)))
 ;; ── describe-shape tests ───────────────────────────────────────────────────
 (let
  ((c (clos-make-instance "circle" ":radius" 3 ":color" "green")))
  (do
    (trace-clear)
    (check
      "circle describe"
      (clos-call-generic "describe-shape" (list c))
      "circle[r=3 shape[green]]")
    (check
      ":before fired for describe circle"
      (= (first trace-log) "BEFORE describe-shape(circle)")
      true)))
 (let
  ((r (clos-make-instance "rect" ":width" 2 ":height" 7 ":color" "black")))
  (do
    (trace-clear)
    (check
      "rect describe"
      (clos-call-generic "describe-shape" (list r))
      "rect[2x7 shape[black]]")
    (check
      ":before fired for describe rect"
      (= (first trace-log) "BEFORE describe-shape(rect)")
      true)))
 ;; ── call-next-method: circle -> shape ─────────────────────────────────────
 (let
  ((c (clos-make-instance "circle" ":radius" 1 ":color" "purple")))
  (check
    "call-next-method result in describe"
    (clos-call-generic "describe-shape" (list c))
    "circle[r=1 shape[purple]]"))
 ;; ── summary ────────────────────────────────────────────────────────────────
 (define mop-passed passed)
 (define mop-failed failed)
 (define mop-failures failures)
--- a/lib/common-lisp/tests/programs/parse-recover.sx
+++ b/lib/common-lisp/tests/programs/parse-recover.sx
@@ -1,163 +0,0 @@
 ;; parse-recover.sx — Parser with skipped-token restart
 ;;
 ;; Classic CL pattern: a simple token parser that signals a condition
 ;; when it encounters an unexpected token. The :skip-token restart
 ;; allows the parser to continue past the offending token.
 ;;
 ;; Depends on: lib/common-lisp/runtime.sx already loaded.
 ;; ── condition type ─────────────────────────────────────────────────────────
 (cl-define-condition "parse-error" (list "error") (list "token" "position"))
 ;; ── simple token parser ────────────────────────────────────────────────────
 ;;
 ;; parse-numbers: given a list of tokens (strings), parse integers.
 ;; Non-integer tokens signal parse-error with two restarts:
 ;;   skip-token   — skip the bad token and continue
 ;;   use-zero     — use 0 in place of the bad token
 (define
  parse-numbers
  (fn
    (tokens)
    (define result (list))
    (define
      process
      (fn
        (toks)
        (if
          (empty? toks)
          result
          (let
            ((tok (first toks)) (rest-toks (rest toks)))
            (let
              ((n (string->number tok 10)))
              (if
                n
                (begin
                  (set! result (append result (list n)))
                  (process rest-toks))
                (cl-restart-case
                  (fn
                    ()
                    (cl-signal
                      (cl-make-condition
                        "parse-error"
                        "token"
                        tok
                        "position"
                        (len result)))
                    (set! result (append result (list 0)))
                    (process rest-toks))
                  (list "skip-token" (list) (fn () (process rest-toks)))
                  (list
                    "use-zero"
                    (list)
                    (fn
                      ()
                      (begin
                        (set! result (append result (list 0)))
                        (process rest-toks)))))))))))
    (process tokens)
    result))
 ;; ── tests ─────────────────────────────────────────────────────────────────
 (define passed 0)
 (define failed 0)
 (define failures (list))
 (define
  check
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))
 (define
  reset-stacks!
  (fn () (set! cl-handler-stack (list)) (set! cl-restart-stack (list))))
 ;; All valid tokens
 (reset-stacks!)
 (check
  "all valid: 1 2 3"
  (cl-handler-bind
    (list (list "parse-error" (fn (c) (cl-invoke-restart "skip-token"))))
    (fn () (parse-numbers (list "1" "2" "3"))))
  (list 1 2 3))
 ;; Skip bad token
 (reset-stacks!)
 (check
  "skip bad token: 1 x 3 -> (1 3)"
  (cl-handler-bind
    (list (list "parse-error" (fn (c) (cl-invoke-restart "skip-token"))))
    (fn () (parse-numbers (list "1" "x" "3"))))
  (list 1 3))
 ;; Use zero for bad token
 (reset-stacks!)
 (check
  "use-zero for bad: 1 x 3 -> (1 0 3)"
  (cl-handler-bind
    (list (list "parse-error" (fn (c) (cl-invoke-restart "use-zero"))))
    (fn () (parse-numbers (list "1" "x" "3"))))
  (list 1 0 3))
 ;; Multiple bad tokens, all skipped
 (reset-stacks!)
 (check
  "skip multiple bad: a 2 b 4 -> (2 4)"
  (cl-handler-bind
    (list (list "parse-error" (fn (c) (cl-invoke-restart "skip-token"))))
    (fn () (parse-numbers (list "a" "2" "b" "4"))))
  (list 2 4))
 ;; handler-case: abort on first bad token
 (reset-stacks!)
 (check
  "handler-case: abort on first bad"
  (cl-handler-case
    (fn () (parse-numbers (list "1" "bad" "3")))
    (list
      "parse-error"
      (fn
        (c)
        (str
          "parse error at position "
          (cl-condition-slot c "position")
          ": "
          (cl-condition-slot c "token")))))
  "parse error at position 1: bad")
 ;; Verify condition type hierarchy
 (reset-stacks!)
 (check
  "parse-error isa error"
  (cl-condition-of-type?
    (cl-make-condition "parse-error" "token" "x" "position" 0)
    "error")
  true)
 ;; ── summary ────────────────────────────────────────────────────────────────
 (define parse-passed passed)
 (define parse-failed failed)
 (define parse-failures failures)
--- a/lib/common-lisp/tests/programs/restart-demo.sx
+++ b/lib/common-lisp/tests/programs/restart-demo.sx
@@ -1,141 +0,0 @@
 ;; restart-demo.sx — Classic CL condition system demo
 ;;
 ;; Demonstrates resumable exceptions via restarts.
 ;; The `safe-divide` function signals a division-by-zero condition
 ;; and offers two restarts:
 ;;   :use-zero  — return 0 as the result
 ;;   :retry     — call safe-divide again with a corrected divisor
 ;;
 ;; Depends on: lib/common-lisp/runtime.sx already loaded.
 ;; ── safe-divide ────────────────────────────────────────────────────────────
 ;;
 ;; Divides numerator by denominator.
 ;; When denominator is 0, signals division-by-zero with two restarts.
 (define
  safe-divide
  (fn
    (n d)
    (if
      (= d 0)
      (cl-restart-case
        (fn
          ()
          (cl-signal
            (cl-make-condition
              "division-by-zero"
              "operation"
              "/"
              "operands"
              (list n d)))
          (error "division by zero — no restart invoked"))
        (list "use-zero" (list) (fn () 0))
        (list "retry" (list "d") (fn (d2) (safe-divide n d2))))
      (/ n d))))
 ;; ── tests ─────────────────────────────────────────────────────────────────
 (define passed 0)
 (define failed 0)
 (define failures (list))
 (define
  check
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))
 (define
  reset-stacks!
  (fn () (set! cl-handler-stack (list)) (set! cl-restart-stack (list))))
 ;; Normal division
 (reset-stacks!)
 (check "10 / 2 = 5" (safe-divide 10 2) 5)
 ;; Invoke use-zero restart
 (reset-stacks!)
 (check
  "10 / 0 -> use-zero"
  (cl-handler-bind
    (list
      (list "division-by-zero" (fn (c) (cl-invoke-restart "use-zero"))))
    (fn () (safe-divide 10 0)))
  0)
 ;; Invoke retry restart with a corrected denominator
 (reset-stacks!)
 (check
  "10 / 0 -> retry with 2"
  (cl-handler-bind
    (list
      (list
        "division-by-zero"
        (fn (c) (cl-invoke-restart "retry" 2))))
    (fn () (safe-divide 10 0)))
  5)
 ;; Nested calls: outer handles the inner divide-by-zero
 (reset-stacks!)
 (check
  "nested: 20 / (0->4) = 5"
  (cl-handler-bind
    (list
      (list
        "division-by-zero"
        (fn (c) (cl-invoke-restart "retry" 4))))
    (fn () (let ((r1 (safe-divide 20 0))) r1)))
  5)
 ;; handler-case — unwinding version
 (reset-stacks!)
 (check
  "handler-case: catches division-by-zero"
  (cl-handler-case
    (fn () (safe-divide 9 0))
    (list "division-by-zero" (fn (c) "caught!")))
  "caught!")
 ;; Verify use-zero is idempotent (two uses)
 (reset-stacks!)
 (check
  "two use-zero invocations"
  (cl-handler-bind
    (list
      (list "division-by-zero" (fn (c) (cl-invoke-restart "use-zero"))))
    (fn
      ()
      (+
        (safe-divide 10 0)
        (safe-divide 3 0))))
  0)
 ;; No restart needed for normal division
 (reset-stacks!)
 (check
  "no restart needed for 8/4"
  (safe-divide 8 4)
  2)
 ;; ── summary ────────────────────────────────────────────────────────────────
 (define demo-passed passed)
 (define demo-failed failed)
 (define demo-failures failures)
--- a/lib/common-lisp/tests/read.sx
+++ b/lib/common-lisp/tests/read.sx
@@ -1,180 +0,0 @@
 ;; Common Lisp tokenizer tests
 (define cl-test-pass 0)
 (define cl-test-fail 0)
 (define cl-test-fails (list))
 (define
  cl-test
  (fn
    (name actual expected)
    (if
      (= actual expected)
      (set! cl-test-pass (+ cl-test-pass 1))
      (do
        (set! cl-test-fail (+ cl-test-fail 1))
        (append! cl-test-fails {:name name :expected expected :actual actual})))))
 ;; Helpers: extract types and values from token stream (drops eof)
 (define
  cl-tok-types
  (fn
    (src)
    (map
      (fn (t) (get t "type"))
      (filter (fn (t) (not (= (get t "type") "eof"))) (cl-tokenize src)))))
 (define
  cl-tok-values
  (fn
    (src)
    (map
      (fn (t) (get t "value"))
      (filter (fn (t) (not (= (get t "type") "eof"))) (cl-tokenize src)))))
 (define
  cl-tok-first
  (fn (src) (nth (cl-tokenize src) 0)))
 ;; ── symbols ───────────────────────────────────────────────────────
 (cl-test "symbol: bare lowercase" (cl-tok-values "foo") (list "FOO"))
 (cl-test "symbol: uppercase" (cl-tok-values "BAR") (list "BAR"))
 (cl-test "symbol: mixed case folded" (cl-tok-values "FooBar") (list "FOOBAR"))
 (cl-test "symbol: with hyphen" (cl-tok-values "foo-bar") (list "FOO-BAR"))
 (cl-test "symbol: with star" (cl-tok-values "*special*") (list "*SPECIAL*"))
 (cl-test "symbol: with question" (cl-tok-values "null?") (list "NULL?"))
 (cl-test "symbol: with exclamation" (cl-tok-values "set!") (list "SET!"))
 (cl-test "symbol: plus sign alone" (cl-tok-values "+") (list "+"))
 (cl-test "symbol: minus sign alone" (cl-tok-values "-") (list "-"))
 (cl-test "symbol: type is symbol" (cl-tok-types "foo") (list "symbol"))
 ;; ── package-qualified symbols ─────────────────────────────────────
 (cl-test "symbol: pkg:sym external" (cl-tok-values "cl:car") (list "CL:CAR"))
 (cl-test "symbol: pkg::sym internal" (cl-tok-values "pkg::foo") (list "PKG::FOO"))
 (cl-test "symbol: cl:car type" (cl-tok-types "cl:car") (list "symbol"))
 ;; ── keywords ──────────────────────────────────────────────────────
 (cl-test "keyword: basic" (cl-tok-values ":foo") (list "FOO"))
 (cl-test "keyword: type" (cl-tok-types ":foo") (list "keyword"))
 (cl-test "keyword: upcase" (cl-tok-values ":hello-world") (list "HELLO-WORLD"))
 (cl-test "keyword: multiple" (cl-tok-types ":a :b :c") (list "keyword" "keyword" "keyword"))
 ;; ── integers ──────────────────────────────────────────────────────
 (cl-test "integer: zero" (cl-tok-values "0") (list "0"))
 (cl-test "integer: positive" (cl-tok-values "42") (list "42"))
 (cl-test "integer: negative" (cl-tok-values "-5") (list "-5"))
 (cl-test "integer: positive-sign" (cl-tok-values "+3") (list "+3"))
 (cl-test "integer: type" (cl-tok-types "42") (list "integer"))
 (cl-test "integer: multi-digit" (cl-tok-values "12345678") (list "12345678"))
 ;; ── hex, binary, octal ───────────────────────────────────────────
 (cl-test "hex: lowercase x" (cl-tok-values "#xFF") (list "#xFF"))
 (cl-test "hex: uppercase X" (cl-tok-values "#XFF") (list "#XFF"))
 (cl-test "hex: type" (cl-tok-types "#xFF") (list "integer"))
 (cl-test "hex: zero" (cl-tok-values "#x0") (list "#x0"))
 (cl-test "binary: #b" (cl-tok-values "#b1010") (list "#b1010"))
 (cl-test "binary: type" (cl-tok-types "#b1010") (list "integer"))
 (cl-test "octal: #o" (cl-tok-values "#o17") (list "#o17"))
 (cl-test "octal: type" (cl-tok-types "#o17") (list "integer"))
 ;; ── floats ────────────────────────────────────────────────────────
 (cl-test "float: basic" (cl-tok-values "3.14") (list "3.14"))
 (cl-test "float: type" (cl-tok-types "3.14") (list "float"))
 (cl-test "float: negative" (cl-tok-values "-2.5") (list "-2.5"))
 (cl-test "float: exponent" (cl-tok-values "1.0e10") (list "1.0e10"))
 (cl-test "float: neg exponent" (cl-tok-values "1.5e-3") (list "1.5e-3"))
 (cl-test "float: leading dot" (cl-tok-values ".5") (list "0.5"))
 (cl-test "float: exp only" (cl-tok-values "1e5") (list "1e5"))
 ;; ── ratios ────────────────────────────────────────────────────────
 (cl-test "ratio: 1/3" (cl-tok-values "1/3") (list "1/3"))
 (cl-test "ratio: type" (cl-tok-types "1/3") (list "ratio"))
 (cl-test "ratio: 22/7" (cl-tok-values "22/7") (list "22/7"))
 (cl-test "ratio: negative" (cl-tok-values "-1/2") (list "-1/2"))
 ;; ── strings ───────────────────────────────────────────────────────
 (cl-test "string: empty" (cl-tok-values "\"\"") (list ""))
 (cl-test "string: basic" (cl-tok-values "\"hello\"") (list "hello"))
 (cl-test "string: type" (cl-tok-types "\"hello\"") (list "string"))
 (cl-test "string: with space" (cl-tok-values "\"hello world\"") (list "hello world"))
 (cl-test "string: escaped quote" (cl-tok-values "\"say \\\"hi\\\"\"") (list "say \"hi\""))
 (cl-test "string: escaped backslash" (cl-tok-values "\"a\\\\b\"") (list "a\\b"))
 (cl-test "string: newline escape" (cl-tok-values "\"a\\nb\"") (list "a\nb"))
 (cl-test "string: tab escape" (cl-tok-values "\"a\\tb\"") (list "a\tb"))
 ;; ── characters ────────────────────────────────────────────────────
 (cl-test "char: lowercase a" (cl-tok-values "#\\a") (list "a"))
 (cl-test "char: uppercase A" (cl-tok-values "#\\A") (list "A"))
 (cl-test "char: digit" (cl-tok-values "#\\1") (list "1"))
 (cl-test "char: type" (cl-tok-types "#\\a") (list "char"))
 (cl-test "char: Space" (cl-tok-values "#\\Space") (list " "))
 (cl-test "char: Newline" (cl-tok-values "#\\Newline") (list "\n"))
 (cl-test "char: Tab" (cl-tok-values "#\\Tab") (list "\t"))
 (cl-test "char: Return" (cl-tok-values "#\\Return") (list "\r"))
 ;; ── reader macros ─────────────────────────────────────────────────
 (cl-test "quote: type" (cl-tok-types "'x") (list "quote" "symbol"))
 (cl-test "backquote: type" (cl-tok-types "`x") (list "backquote" "symbol"))
 (cl-test "comma: type" (cl-tok-types ",x") (list "comma" "symbol"))
 (cl-test "comma-at: type" (cl-tok-types ",@x") (list "comma-at" "symbol"))
 (cl-test "hash-quote: type" (cl-tok-types "#'foo") (list "hash-quote" "symbol"))
 (cl-test "hash-paren: type" (cl-tok-types "#(1 2)") (list "hash-paren" "integer" "integer" "rparen"))
 ;; ── uninterned ────────────────────────────────────────────────────
 (cl-test "uninterned: type" (cl-tok-types "#:foo") (list "uninterned"))
 (cl-test "uninterned: value upcase" (cl-tok-values "#:foo") (list "FOO"))
 (cl-test "uninterned: compound" (cl-tok-values "#:my-sym") (list "MY-SYM"))
 ;; ── parens and structure ──────────────────────────────────────────
 (cl-test "paren: empty list" (cl-tok-types "()") (list "lparen" "rparen"))
 (cl-test "paren: nested" (cl-tok-types "((a))") (list "lparen" "lparen" "symbol" "rparen" "rparen"))
 (cl-test "dot: standalone" (cl-tok-types "(a . b)") (list "lparen" "symbol" "dot" "symbol" "rparen"))
 ;; ── comments ──────────────────────────────────────────────────────
 (cl-test "comment: line" (cl-tok-types "; comment\nfoo") (list "symbol"))
 (cl-test "comment: inline" (cl-tok-values "foo ; bar\nbaz") (list "FOO" "BAZ"))
 (cl-test "block-comment: basic" (cl-tok-types "#| hello |# foo") (list "symbol"))
 (cl-test "block-comment: nested" (cl-tok-types "#| a #| b |# c |# x") (list "symbol"))
 ;; ── combined ──────────────────────────────────────────────────────
 (cl-test
  "combined: defun skeleton"
  (cl-tok-types "(defun foo (x) x)")
  (list "lparen" "symbol" "symbol" "lparen" "symbol" "rparen" "symbol" "rparen"))
 (cl-test
  "combined: let form"
  (cl-tok-types "(let ((x 1)) x)")
  (list
    "lparen"
    "symbol"
    "lparen"
    "lparen"
    "symbol"
    "integer"
    "rparen"
    "rparen"
    "symbol"
    "rparen"))
 (cl-test
  "combined: whitespace skip"
  (cl-tok-values "  foo   bar   baz  ")
  (list "FOO" "BAR" "BAZ"))
 (cl-test "eof: present" (get (nth (cl-tokenize "") 0) "type") "eof")
 (cl-test "eof: at end of tokens" (get (nth (cl-tokenize "x") 1) "type") "eof")
--- a/lib/common-lisp/tests/runtime.sx
+++ b/lib/common-lisp/tests/runtime.sx
@@ -1,207 +0,0 @@
 ;; lib/common-lisp/tests/runtime.sx — tests for CL runtime layer
 (load "lib/common-lisp/runtime.sx")
 (defsuite
  "cl-types"
  (deftest "cl-null? nil" (assert= true (cl-null? nil)))
  (deftest "cl-null? false" (assert= false (cl-null? false)))
  (deftest
    "cl-consp? pair"
    (assert= true (cl-consp? (list 1 2))))
  (deftest "cl-consp? nil" (assert= false (cl-consp? nil)))
  (deftest "cl-listp? nil" (assert= true (cl-listp? nil)))
  (deftest
    "cl-listp? list"
    (assert= true (cl-listp? (list 1 2))))
  (deftest "cl-atom? nil" (assert= true (cl-atom? nil)))
  (deftest "cl-atom? pair" (assert= false (cl-atom? (list 1))))
  (deftest "cl-integerp?" (assert= true (cl-integerp? 42)))
  (deftest "cl-floatp?" (assert= true (cl-floatp? 3.14)))
  (deftest
    "cl-characterp?"
    (assert= true (cl-characterp? (integer->char 65))))
  (deftest "cl-stringp?" (assert= true (cl-stringp? "hello")))
  (deftest "cl-symbolp?" (assert= true (cl-symbolp? (quote foo)))))
 (defsuite
  "cl-arithmetic"
  (deftest "cl-mod" (assert= 1 (cl-mod 10 3)))
  (deftest "cl-rem" (assert= 1 (cl-rem 10 3)))
  (deftest
    "cl-quotient"
    (assert= 3 (cl-quotient 10 3)))
  (deftest "cl-gcd" (assert= 4 (cl-gcd 12 8)))
  (deftest "cl-lcm" (assert= 12 (cl-lcm 4 6)))
  (deftest "cl-abs pos" (assert= 5 (cl-abs 5)))
  (deftest "cl-abs neg" (assert= 5 (cl-abs -5)))
  (deftest "cl-min" (assert= 2 (cl-min 2 7)))
  (deftest "cl-max" (assert= 7 (cl-max 2 7)))
  (deftest "cl-evenp? t" (assert= true (cl-evenp? 4)))
  (deftest "cl-evenp? f" (assert= false (cl-evenp? 3)))
  (deftest "cl-oddp? t" (assert= true (cl-oddp? 7)))
  (deftest "cl-zerop?" (assert= true (cl-zerop? 0)))
  (deftest "cl-plusp?" (assert= true (cl-plusp? 1)))
  (deftest "cl-minusp?" (assert= true (cl-minusp? -1)))
  (deftest "cl-signum pos" (assert= 1 (cl-signum 42)))
  (deftest "cl-signum neg" (assert= -1 (cl-signum -7)))
  (deftest "cl-signum zero" (assert= 0 (cl-signum 0))))
 (defsuite
  "cl-chars"
  (deftest
    "cl-char-code"
    (assert= 65 (cl-char-code (integer->char 65))))
  (deftest "cl-code-char" (assert= true (char? (cl-code-char 65))))
  (deftest
    "cl-char-upcase"
    (assert=
      (integer->char 65)
      (cl-char-upcase (integer->char 97))))
  (deftest
    "cl-char-downcase"
    (assert=
      (integer->char 97)
      (cl-char-downcase (integer->char 65))))
  (deftest
    "cl-alpha-char-p"
    (assert= true (cl-alpha-char-p (integer->char 65))))
  (deftest
    "cl-digit-char-p"
    (assert= true (cl-digit-char-p (integer->char 48))))
  (deftest
    "cl-char=?"
    (assert=
      true
      (cl-char=? (integer->char 65) (integer->char 65))))
  (deftest
    "cl-char<?"
    (assert=
      true
      (cl-char<? (integer->char 65) (integer->char 90))))
  (deftest
    "cl-char space"
    (assert= (integer->char 32) cl-char-space))
  (deftest
    "cl-char newline"
    (assert= (integer->char 10) cl-char-newline)))
 (defsuite
  "cl-format"
  (deftest
    "cl-format nil basic"
    (assert= "hello" (cl-format nil "~a" "hello")))
  (deftest
    "cl-format nil number"
    (assert= "42" (cl-format nil "~d" 42)))
  (deftest
    "cl-format nil hex"
    (assert= "ff" (cl-format nil "~x" 255)))
  (deftest
    "cl-format nil template"
    (assert= "x=3 y=4" (cl-format nil "x=~d y=~d" 3 4)))
  (deftest "cl-format nil tilde" (assert= "a~b" (cl-format nil "a~~b"))))
 (defsuite
  "cl-gensym"
  (deftest
    "cl-gensym returns symbol"
    (assert= "symbol" (type-of (cl-gensym))))
  (deftest "cl-gensym unique" (assert= false (= (cl-gensym) (cl-gensym)))))
 (defsuite
  "cl-sets"
  (deftest "cl-make-set empty" (assert= true (cl-set? (cl-make-set))))
  (deftest
    "cl-set-add/member"
    (let
      ((s (cl-make-set)))
      (do
        (cl-set-add s 1)
        (assert= true (cl-set-memberp s 1)))))
  (deftest
    "cl-set-memberp false"
    (assert= false (cl-set-memberp (cl-make-set) 42)))
  (deftest
    "cl-list->set"
    (let
      ((s (cl-list->set (list 1 2 3))))
      (assert= true (cl-set-memberp s 2)))))
 (defsuite
  "cl-lists"
  (deftest
    "cl-nth 0"
    (assert=
      1
      (cl-nth 0 (list 1 2 3))))
  (deftest
    "cl-nth 2"
    (assert=
      3
      (cl-nth 2 (list 1 2 3))))
  (deftest
    "cl-last"
    (assert=
      (list 3)
      (cl-last (list 1 2 3))))
  (deftest
    "cl-butlast"
    (assert=
      (list 1 2)
      (cl-butlast (list 1 2 3))))
  (deftest
    "cl-nthcdr 1"
    (assert=
      (list 2 3)
      (cl-nthcdr 1 (list 1 2 3))))
  (deftest
    "cl-assoc hit"
    (assert=
      (list "b" 2)
      (cl-assoc "b" (list (list "a" 1) (list "b" 2)))))
  (deftest
    "cl-assoc miss"
    (assert= nil (cl-assoc "z" (list (list "a" 1)))))
  (deftest
    "cl-getf hit"
    (assert= 42 (cl-getf (list "x" 42 "y" 99) "x")))
  (deftest "cl-getf miss" (assert= nil (cl-getf (list "x" 42) "z")))
  (deftest
    "cl-adjoin new"
    (assert=
      (list 0 1 2)
      (cl-adjoin 0 (list 1 2))))
  (deftest
    "cl-adjoin dup"
    (assert=
      (list 1 2)
      (cl-adjoin 1 (list 1 2))))
  (deftest
    "cl-flatten"
    (assert=
      (list 1 2 3 4)
      (cl-flatten (list 1 (list 2 3) 4))))
  (deftest
    "cl-member hit"
    (assert=
      (list 2 3)
      (cl-member 2 (list 1 2 3))))
  (deftest
    "cl-member miss"
    (assert=
      nil
      (cl-member 9 (list 1 2 3)))))
 (defsuite
  "cl-radix"
  (deftest "binary" (assert= "1010" (cl-format-binary 10)))
  (deftest "octal" (assert= "17" (cl-format-octal 15)))
  (deftest "hex" (assert= "ff" (cl-format-hex 255)))
  (deftest "decimal" (assert= "42" (cl-format-decimal 42)))
  (deftest
    "n->s r16"
    (assert= "1f" (cl-integer-to-string 31 16)))
  (deftest
    "s->n r16"
    (assert= 31 (cl-string-to-integer "1f" 16))))
--- a/lib/common-lisp/tests/stdlib.sx
+++ b/lib/common-lisp/tests/stdlib.sx
@@ -1,285 +0,0 @@
 ;; lib/common-lisp/tests/stdlib.sx — Phase 6: sequence, list, string functions
 (define ev (fn (src) (cl-eval-str src (cl-make-env))))
 (define passed 0)
 (define failed 0)
 (define failures (list))
 (define
  check
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))
 ;; ── mapc ─────────────────────────────────────────────────────────
 (check "mapc returns list"
  (ev "(mapc #'1+ '(1 2 3))")
  (list 1 2 3))
 ;; ── mapcan ───────────────────────────────────────────────────────
 (check "mapcan basic"
  (ev "(mapcan (lambda (x) (list x (* x x))) '(1 2 3))")
  (list 1 1 2 4 3 9))
 (check "mapcan filter-like"
  (ev "(mapcan (lambda (x) (if (evenp x) (list x) nil)) '(1 2 3 4 5 6))")
  (list 2 4 6))
 ;; ── reduce ───────────────────────────────────────────────────────
 (check "reduce sum"
  (ev "(reduce #'+ '(1 2 3 4 5))")
  15)
 (check "reduce with initial-value"
  (ev "(reduce #'+ '(1 2 3) :initial-value 10)")
  16)
 (check "reduce max"
  (ev "(reduce (lambda (a b) (if (> a b) a b)) '(3 1 4 1 5 9 2 6))")
  9)
 ;; ── find ─────────────────────────────────────────────────────────
 (check "find present"
  (ev "(find 3 '(1 2 3 4 5))")
  3)
 (check "find absent"
  (ev "(find 9 '(1 2 3))")
  nil)
 (check "find-if present"
  (ev "(find-if #'evenp '(1 3 4 7))")
  4)
 (check "find-if absent"
  (ev "(find-if #'evenp '(1 3 5))")
  nil)
 (check "find-if-not"
  (ev "(find-if-not #'evenp '(2 4 5 6))")
  5)
 ;; ── position ─────────────────────────────────────────────────────
 (check "position found"
  (ev "(position 3 '(1 2 3 4 5))")
  2)
 (check "position not found"
  (ev "(position 9 '(1 2 3))")
  nil)
 (check "position-if"
  (ev "(position-if #'evenp '(1 3 4 8))")
  2)
 ;; ── count ────────────────────────────────────────────────────────
 (check "count"
  (ev "(count 2 '(1 2 3 2 4 2))")
  3)
 (check "count-if"
  (ev "(count-if #'evenp '(1 2 3 4 5 6))")
  3)
 ;; ── every / some / notany / notevery ─────────────────────────────
 (check "every true"
  (ev "(every #'evenp '(2 4 6))")
  true)
 (check "every false"
  (ev "(every #'evenp '(2 3 6))")
  nil)
 (check "every empty"
  (ev "(every #'evenp '())")
  true)
 (check "some truthy"
  (ev "(some #'evenp '(1 3 4))")
  true)
 (check "some nil"
  (ev "(some #'evenp '(1 3 5))")
  nil)
 (check "notany true"
  (ev "(notany #'evenp '(1 3 5))")
  true)
 (check "notany false"
  (ev "(notany #'evenp '(1 2 5))")
  nil)
 (check "notevery false"
  (ev "(notevery #'evenp '(2 4 6))")
  nil)
 (check "notevery true"
  (ev "(notevery #'evenp '(2 3 6))")
  true)
 ;; ── remove ───────────────────────────────────────────────────────
 (check "remove"
  (ev "(remove 3 '(1 2 3 4 3 5))")
  (list 1 2 4 5))
 (check "remove-if"
  (ev "(remove-if #'evenp '(1 2 3 4 5 6))")
  (list 1 3 5))
 (check "remove-if-not"
  (ev "(remove-if-not #'evenp '(1 2 3 4 5 6))")
  (list 2 4 6))
 ;; ── member ───────────────────────────────────────────────────────
 (check "member found"
  (ev "(member 3 '(1 2 3 4 5))")
  (list 3 4 5))
 (check "member not found"
  (ev "(member 9 '(1 2 3))")
  nil)
 ;; ── subst ────────────────────────────────────────────────────────
 (check "subst flat"
  (ev "(subst 'b 'a '(a b c a))")
  (list "B" "B" "C" "B"))
 (check "subst nested"
  (ev "(subst 99 1 '(1 (2 1) 3))")
  (list 99 (list 2 99) 3))
 ;; ── assoc ────────────────────────────────────────────────────────
 (check "assoc found"
  (ev "(assoc 'b '((a 1) (b 2) (c 3)))")
  (list "B" 2))
 (check "assoc not found"
  (ev "(assoc 'z '((a 1) (b 2)))")
  nil)
 ;; ── list ops ─────────────────────────────────────────────────────
 (check "last"
  (ev "(last '(1 2 3 4))")
  (list 4))
 (check "butlast"
  (ev "(butlast '(1 2 3 4))")
  (list 1 2 3))
 (check "nthcdr"
  (ev "(nthcdr 2 '(a b c d))")
  (list "C" "D"))
 (check "list*"
  (ev "(list* 1 2 '(3 4))")
  (list 1 2 3 4))
 (check "cadr"
  (ev "(cadr '(1 2 3))")
  2)
 (check "caddr"
  (ev "(caddr '(1 2 3))")
  3)
 (check "cadddr"
  (ev "(cadddr '(1 2 3 4))")
  4)
 (check "cddr"
  (ev "(cddr '(1 2 3 4))")
  (list 3 4))
 ;; ── subseq ───────────────────────────────────────────────────────
 (check "subseq string"
  (ev "(subseq \"hello\" 1 3)")
  "el")
 (check "subseq list"
  (ev "(subseq '(a b c d) 1 3)")
  (list "B" "C"))
 (check "subseq no end"
  (ev "(subseq \"hello\" 2)")
  "llo")
 ;; ── FORMAT ─────────────────────────────────────────────────────────
 (check "format ~A"
  (ev "(format nil \"hello ~A\" \"world\")")
  "hello world")
 (check "format ~D"
  (ev "(format nil \"~D items\" 42)")
  "42 items")
 (check "format two args"
  (ev "(format nil \"~A ~A\" 1 2)")
  "1 2")
 (check "format ~A+~A=~A"
  (ev "(format nil \"~A + ~A = ~A\" 1 2 3)")
  "1 + 2 = 3")
 (check "format iterate"
  (ev "(format nil \"~{~A~}\" (quote (1 2 3)))")
  "123")
 (check "format iterate with space"
  (ev "(format nil \"(~{~A ~})\" (quote (1 2 3)))")
  "(1 2 3 )")
 ;; ── packages ─────────────────────────────────────────────────────
 (check "defpackage returns name"
  (ev "(defpackage :my-pkg (:use :cl))")
  "MY-PKG")
 (check "in-package"
  (ev "(progn (defpackage :test-pkg) (in-package :test-pkg) (package-name))")
  "TEST-PKG")
 (check "package-qualified function"
  (ev "(cl:car (quote (1 2 3)))")
  1)
 (check "package-qualified function 2"
  (ev "(cl:mapcar (function evenp) (quote (2 3 4)))")
  (list true nil true))
 ;; ── summary ──────────────────────────────────────────────────────
 (define stdlib-passed passed)
 (define stdlib-failed failed)
 (define stdlib-failures failures)
--- a/lib/compiler.sx
+++ b/lib/compiler.sx
@@ -1008,27 +1008,11 @@
            (let
              ((name (symbol-name head))
                (argc (len args))
-                (specialized-op (cond
+                (name-idx (pool-add (get em "pool") name)))
                  (and (= argc 2) (= name "+")) 160
                  (and (= argc 2) (= name "-")) 161
                  (and (= argc 2) (= name "*")) 162
                  (and (= argc 2) (= name "/")) 163
                  (and (= argc 2) (= name "=")) 164
                  (and (= argc 2) (= name "<")) 165
                  (and (= argc 2) (= name ">")) 166
                  (and (= argc 2) (= name "cons")) 172
                  (and (= argc 1) (= name "not")) 167
                  (and (= argc 1) (= name "len")) 168
                  (and (= argc 1) (= name "first")) 169
                  (and (= argc 1) (= name "rest")) 170
                  :else nil)))
              (for-each (fn (a) (compile-expr em a scope false)) args)
              (if specialized-op
                (emit-op em specialized-op)
                (let ((name-idx (pool-add (get em "pool") name)))
              (emit-op em 52)
              (emit-u16 em name-idx)
-                  (emit-byte em argc))))
+              (emit-byte em argc))
            (do
              (compile-expr em head scope false)
              (for-each (fn (a) (compile-expr em a scope false)) args)
--- a/lib/erlang/scoreboard.json
+++ b/lib/erlang/scoreboard.json
@@ -1,16 +1,16 @@
 {
  "language": "erlang",
-  "total_pass": 0,
+  "total_pass": 530,
-  "total": 0,
+  "total": 530,
  "suites": [
-    {"name":"tokenize","pass":0,"total":0,"status":"ok"},
+    {"name":"tokenize","pass":62,"total":62,"status":"ok"},
-    {"name":"parse","pass":0,"total":0,"status":"ok"},
+    {"name":"parse","pass":52,"total":52,"status":"ok"},
-    {"name":"eval","pass":0,"total":0,"status":"ok"},
+    {"name":"eval","pass":346,"total":346,"status":"ok"},
-    {"name":"runtime","pass":0,"total":0,"status":"ok"},
+    {"name":"runtime","pass":39,"total":39,"status":"ok"},
-    {"name":"ring","pass":0,"total":0,"status":"ok"},
+    {"name":"ring","pass":4,"total":4,"status":"ok"},
-    {"name":"ping-pong","pass":0,"total":0,"status":"ok"},
+    {"name":"ping-pong","pass":4,"total":4,"status":"ok"},
-    {"name":"bank","pass":0,"total":0,"status":"ok"},
+    {"name":"bank","pass":8,"total":8,"status":"ok"},
-    {"name":"echo","pass":0,"total":0,"status":"ok"},
+    {"name":"echo","pass":7,"total":7,"status":"ok"},
-    {"name":"fib","pass":0,"total":0,"status":"ok"}
+    {"name":"fib","pass":8,"total":8,"status":"ok"}
  ]
 }
--- a/lib/erlang/scoreboard.md
+++ b/lib/erlang/scoreboard.md
@@ -1,18 +1,18 @@
 # Erlang-on-SX Scoreboard
-**Total: 0 / 0 tests passing**
+**Total: 530 / 530 tests passing**
 |  | Suite | Pass | Total |
 |---|---|---|---|
-| ✅ | tokenize | 0 | 0 |
+| ✅ | tokenize | 62 | 62 |
-| ✅ | parse | 0 | 0 |
+| ✅ | parse | 52 | 52 |
-| ✅ | eval | 0 | 0 |
+| ✅ | eval | 346 | 346 |
-| ✅ | runtime | 0 | 0 |
+| ✅ | runtime | 39 | 39 |
-| ✅ | ring | 0 | 0 |
+| ✅ | ring | 4 | 4 |
-| ✅ | ping-pong | 0 | 0 |
+| ✅ | ping-pong | 4 | 4 |
-| ✅ | bank | 0 | 0 |
+| ✅ | bank | 8 | 8 |
-| ✅ | echo | 0 | 0 |
+| ✅ | echo | 7 | 7 |
-| ✅ | fib | 0 | 0 |
+| ✅ | fib | 8 | 8 |
 Generated by `lib/erlang/conformance.sh`.
--- a/lib/erlang/test.sh
+++ b/lib/erlang/test.sh
@@ -1,260 +0,0 @@
 #!/usr/bin/env bash
 # lib/erlang/test.sh — smoke-test the Erlang runtime layer.
 # Uses sx_server.exe epoch protocol.
 #
 # Usage:
 #   bash lib/erlang/test.sh
 #   bash lib/erlang/test.sh -v
 set -uo pipefail
 cd "$(git rev-parse --show-toplevel)"
 SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
 if [ ! -x "$SX_SERVER" ]; then
  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
 fi
 if [ ! -x "$SX_SERVER" ]; then
  echo "ERROR: sx_server.exe not found. Run: cd hosts/ocaml && dune build"
  exit 1
 fi
 VERBOSE="${1:-}"
 PASS=0; FAIL=0; ERRORS=""
 TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
 cat > "$TMPFILE" << 'EPOCHS'
 (epoch 1)
 (load "lib/erlang/runtime.sx")
 ;; --- Numeric tower ---
 (epoch 10)
 (eval "(er-is-integer? 42)")
 (epoch 11)
 (eval "(er-is-integer? 3.14)")
 (epoch 12)
 (eval "(er-is-float? 3.14)")
 (epoch 13)
 (eval "(er-is-float? 42)")
 (epoch 14)
 (eval "(er-is-number? 42)")
 (epoch 15)
 (eval "(er-is-number? 3.14)")
 (epoch 16)
 (eval "(er-float 5)")
 (epoch 17)
 (eval "(er-trunc 3.9)")
 (epoch 18)
 (eval "(er-round 3.5)")
 (epoch 19)
 (eval "(er-abs -7)")
 (epoch 20)
 (eval "(er-max 3 7)")
 (epoch 21)
 (eval "(er-min 3 7)")
 ;; --- div + rem ---
 (epoch 30)
 (eval "(er-div 10 3)")
 (epoch 31)
 (eval "(er-div -10 3)")
 (epoch 32)
 (eval "(er-rem 10 3)")
 (epoch 33)
 (eval "(er-rem -10 3)")
 (epoch 34)
 (eval "(er-gcd 12 8)")
 ;; --- Bitwise ---
 (epoch 40)
 (eval "(er-band 12 10)")
 (epoch 41)
 (eval "(er-bor 12 10)")
 (epoch 42)
 (eval "(er-bxor 12 10)")
 (epoch 43)
 (eval "(er-bnot 0)")
 (epoch 44)
 (eval "(er-bsl 1 4)")
 (epoch 45)
 (eval "(er-bsr 16 2)")
 ;; --- Sets ---
 (epoch 50)
 (eval "(er-sets-is-set? (er-sets-new))")
 (epoch 51)
 (eval "(let ((s (er-sets-new))) (do (er-sets-add-element s 1) (er-sets-is-element s 1)))")
 (epoch 52)
 (eval "(er-sets-is-element (er-sets-new) 42)")
 (epoch 53)
 (eval "(er-sets-is-element (er-sets-from-list (list 1 2 3)) 2)")
 (epoch 54)
 (eval "(er-sets-size (er-sets-from-list (list 1 2 3)))")
 (epoch 55)
 (eval "(len (er-sets-to-list (er-sets-from-list (list 1 2 3))))")
 ;; --- Regexp ---
 (epoch 60)
 (eval "(not (= (er-re-run \"hello\" \"ll\") nil))")
 (epoch 61)
 (eval "(= (er-re-run \"hello\" \"xyz\") nil)")
 (epoch 62)
 (eval "(get (er-re-run \"hello\" \"ll\") :match)")
 (epoch 63)
 (eval "(er-re-replace \"hello\" \"l\" \"r\")")
 (epoch 64)
 (eval "(er-re-replace-all \"hello\" \"l\" \"r\")")
 (epoch 65)
 (eval "(er-re-match-groups (er-re-run \"hello world\" \"(\\w+)\\s+(\\w+)\"))")
 (epoch 66)
 (eval "(len (er-re-split \"a,b,c\" \",\"))")
 ;; --- List BIFs ---
 (epoch 70)
 (eval "(er-hd (list 1 2 3))")
 (epoch 71)
 (eval "(er-tl (list 1 2 3))")
 (epoch 72)
 (eval "(er-length (list 1 2 3))")
 (epoch 73)
 (eval "(er-lists-member 2 (list 1 2 3))")
 (epoch 74)
 (eval "(er-lists-member 9 (list 1 2 3))")
 (epoch 75)
 (eval "(er-lists-reverse (list 1 2 3))")
 (epoch 76)
 (eval "(er-lists-nth 2 (list 10 20 30))")
 (epoch 77)
 (eval "(er-lists-foldl + 0 (list 1 2 3 4 5))")
 (epoch 78)
 (eval "(er-lists-seq 1 5)")
 (epoch 79)
 (eval "(er-lists-flatten (list 1 (list 2 3) (list 4 (list 5))))")
 ;; --- Type conversions ---
 (epoch 80)
 (eval "(er-integer-to-list 42)")
 (epoch 81)
 (eval "(er-list-to-integer \"42\")")
 (epoch 82)
 (eval "(er-integer-to-list-radix 255 16)")
 (epoch 83)
 (eval "(er-atom-to-list (make-symbol \"hello\"))")
 (epoch 84)
 (eval "(= (type-of (er-list-to-atom \"foo\")) \"symbol\")")
 ;; --- ok/error tuples ---
 (epoch 90)
 (eval "(er-is-ok? (er-ok 42))")
 (epoch 91)
 (eval "(er-is-error? (er-error \"reason\"))")
 (epoch 92)
 (eval "(er-unwrap (er-ok 42))")
 (epoch 93)
 (eval "(er-is-ok? (er-error \"bad\"))")
 EPOCHS
 OUTPUT=$(timeout 30 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
 check() {
  local epoch="$1" desc="$2" expected="$3"
  local actual
  actual=$(echo "$OUTPUT" | grep -A1 "^(ok-len $epoch " | tail -1 || true)
  if echo "$actual" | grep -q "^(ok-len"; then actual=""; fi
  if [ -z "$actual" ]; then
    actual=$(echo "$OUTPUT" | grep "^(ok $epoch " | head -1 || true)
  fi
  if [ -z "$actual" ]; then
    actual=$(echo "$OUTPUT" | grep "^(error $epoch " | head -1 || true)
  fi
  [ -z "$actual" ] && actual="<no output for epoch $epoch>"
  if echo "$actual" | grep -qF -- "$expected"; then
    PASS=$((PASS+1))
    [ "$VERBOSE" = "-v" ] && echo "  ok $desc"
  else
    FAIL=$((FAIL+1))
    ERRORS+="  FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
 "
  fi
 }
 # Numeric tower
 check 10  "is-integer? 42"        "true"
 check 11  "is-integer? float"     "false"
 check 12  "is-float? 3.14"        "true"
 check 13  "is-float? int"         "false"
 check 14  "is-number? int"        "true"
 check 15  "is-number? float"      "true"
 check 16  "float 5"               "5"
 check 17  "trunc 3.9"             "3"
 check 18  "round 3.5"             "4"
 check 19  "abs -7"                "7"
 check 20  "max 3 7"               "7"
 check 21  "min 3 7"               "3"
 # div + rem
 check 30  "div 10 3"              "3"
 check 31  "div -10 3"             "-3"
 check 32  "rem 10 3"              "1"
 check 33  "rem -10 3"             "-1"
 check 34  "gcd 12 8"              "4"
 # Bitwise
 check 40  "band 12 10"            "8"
 check 41  "bor 12 10"             "14"
 check 42  "bxor 12 10"            "6"
 check 43  "bnot 0"                "-1"
 check 44  "bsl 1 4"               "16"
 check 45  "bsr 16 2"              "4"
 # Sets
 check 50  "sets-new is-set?"      "true"
 check 51  "sets add+member"       "true"
 check 52  "member empty"          "false"
 check 53  "from-list member"      "true"
 check 54  "sets-size"             "3"
 check 55  "sets-to-list len"      "3"
 # Regexp
 check 60  "re-run match"          "true"
 check 61  "re-run no match"       "true"
 check 62  "re-run match text"     '"ll"'
 check 63  "re-replace first"      '"herlo"'
 check 64  "re-replace-all"        '"herro"'
 check 65  "re-match-groups"       '"hello"'
 check 66  "re-split count"        "3"
 # List BIFs
 check 70  "hd"                    "1"
 check 71  "tl"                    "(2 3)"
 check 72  "length"                "3"
 check 73  "member hit"            "true"
 check 74  "member miss"           "false"
 check 75  "reverse"               "(3 2 1)"
 check 76  "nth 2"                 "20"
 check 77  "foldl sum"             "15"
 check 78  "seq 1..5"              "(1 2 3 4 5)"
 check 79  "flatten"               "(1 2 3 4 5)"
 # Type conversions
 check 80  "integer-to-list"       '"42"'
 check 81  "list-to-integer"       "42"
 check 82  "integer-to-list hex"   '"ff"'
 check 83  "atom-to-list"          '"hello"'
 check 84  "list-to-atom"          "true"
 # ok/error
 check 90  "ok? ok-tuple"          "true"
 check 91  "error? error-tuple"    "true"
 check 92  "unwrap ok"             "42"
 check 93  "ok? error-tuple"       "false"
 TOTAL=$((PASS+FAIL))
 if [ $FAIL -eq 0 ]; then
  echo "ok $PASS/$TOTAL lib/erlang tests passed"
 else
  echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
  echo "$ERRORS"
 fi
 [ $FAIL -eq 0 ]
--- a/lib/fiber.sx
+++ b/lib/fiber.sx
@@ -1,44 +0,0 @@
 ; lib/fiber.sx — pure SX fiber library using call/cc
 ;
 ; A fiber is a cooperative coroutine with true suspension (no eager
 ; pre-execution). Each fiber is a dict {:resume fn :done? fn}.
 ;
 ; make-fiber body   → fiber dict
 ;   body = (fn (yield init-val) ...)  — body receives yield + first resume val
 ;   yield = (fn (val) ...)            — suspends fiber, returns val to resumer
 ;
 ; fiber-resume f v  → next yielded value, or nil when body returns
 ; fiber-done? f     → true after body has returned
 (define make-fiber
  (fn (body)
    (let
      ((resume-k nil)
        (caller-k nil)
        (done false))
      (let
        ((yield
            (fn (val)
              (call/cc
                (fn (k)
                  (set! resume-k k)
                  (caller-k val))))))
        {:resume
         (fn (val)
           (if
             done
             nil
             (call/cc
               (fn (k)
                 (set! caller-k k)
                 (if
                   (nil? resume-k)
                   (begin
                     (body yield val)
                     (set! done true)
                     (k nil))
                   (resume-k val))))))
         :done? (fn () done)}))))
 (define fiber-resume (fn (f v) ((get f :resume) v)))
 (define fiber-done?  (fn (f) ((get f :done?))))
--- a/lib/forth/runtime.sx
+++ b/lib/forth/runtime.sx
@@ -1,175 +1,433 @@
-;; lib/forth/runtime.sx — Forth primitives on SX
+;; Forth runtime — state, stacks, dictionary, output buffer.
-;;
+;; Data stack: mutable SX list, TOS = first.
-;; Provides Forth-idiomatic wrappers over SX built-ins.
+;; Return stack: separate mutable list.
-;; Primitives used:
+;; Dictionary: SX dict {lowercased-name -> word-record}.
-;;   bitwise-and/or/xor/not/arithmetic-shift/bit-count (Phase 7)
+;; Word record: {"kind" "body" "immediate?"}; kind is "primitive" or "colon-def".
-;;   make-bytevector/bytevector-u8-ref/u8-set!/...     (Phase 20)
+;; Output buffer: mutable string appended to by `.`, `EMIT`, `CR`, etc.
-;;   quotient/remainder/modulo                          (Phase 15 / builtin)
+;; Compile-mode flag: "compiling" on the state.
 ;;
 ;; Naming: SX identifiers can't include @ or !-alone, so Forth words are:
 ;;   C@ → forth-cfetch    C! → forth-cstore
 ;;   @  → forth-fetch     !  → forth-store
 ;; ---------------------------------------------------------------------------
 ;; 1. Bitwise operations — Forth core words
 ;;    Forth TRUE = -1 (all bits set), FALSE = 0.
 ;;    All ops coerce to integer via truncate.
 ;; ---------------------------------------------------------------------------
 (define (forth-and a b) (bitwise-and (truncate a) (truncate b)))
 (define (forth-or a b) (bitwise-or (truncate a) (truncate b)))
 (define (forth-xor a b) (bitwise-xor (truncate a) (truncate b)))
 ;; INVERT — bitwise NOT (Forth NOT is logical; INVERT is bitwise)
 (define (forth-invert a) (bitwise-not (truncate a)))
 ;; LSHIFT RSHIFT — n bit — shift a by n positions
 (define (forth-lshift a n) (arithmetic-shift (truncate a) (truncate n)))
 (define
  (forth-rshift a n)
  (arithmetic-shift (truncate a) (- 0 (truncate n))))
 ;; 2* 2/ — multiply/divide by 2 via bit shift
 (define (forth-2* a) (arithmetic-shift (truncate a) 1))
 (define (forth-2/ a) (arithmetic-shift (truncate a) -1))
 ;; BIT-COUNT — number of set bits (Kernighan popcount)
 (define (forth-bit-count a) (bit-count (truncate a)))
 ;; INTEGER-LENGTH — index of highest set bit (0 for zero)
 (define (forth-integer-length a) (integer-length (truncate a)))
 ;; WITHIN — ( u ul uh -- flag ) true if ul <= u < uh
 (define (forth-within u ul uh) (and (>= u ul) (< u uh)))
 ;; Arithmetic complements commonly used alongside bitwise ops
 (define (forth-negate a) (- 0 (truncate a)))
 (define (forth-abs a) (abs (truncate a)))
 (define (forth-min a b) (if (< a b) a b))
 (define (forth-max a b) (if (> a b) a b))
 (define (forth-mod a b) (modulo (truncate a) (truncate b)))
 ;; /MOD — ( n1 n2 -- rem quot ) returns list (remainder quotient)
 (define
  (forth-divmod a b)
  (list
    (remainder (truncate a) (truncate b))
    (quotient (truncate a) (truncate b))))
 ;; ---------------------------------------------------------------------------
 ;; 2. String buffer — word-definition / string accumulation
 ;;    EMIT appends one char; TYPE appends a string.
 ;;    Value is retrieved with forth-sb-value.
 ;; ---------------------------------------------------------------------------
 (define
-  (forth-sb-new)
+  forth-make-state
  (fn
    ()
    (let
-    ((sb (dict)))
+      ((s (dict)))
-    (dict-set! sb "_forth_sb" true)
+      (dict-set! s "dstack" (list))
-    (dict-set! sb "_chars" (list))
+      (dict-set! s "rstack" (list))
-    sb))
+      (dict-set! s "dict" (dict))
-
+      (dict-set! s "output" "")
-(define (forth-sb? v) (and (dict? v) (dict-has? v "_forth_sb")))
+      (dict-set! s "compiling" false)
-
+      (dict-set! s "current-def" nil)
-;; EMIT — append one character
+      (dict-set! s "base" 10)
-(define
+      (dict-set! s "vars" (dict))
-  (forth-sb-emit! sb c)
+      s)))
  (dict-set! sb "_chars" (append (get sb "_chars") (list c)))
  sb)
 ;; TYPE — append a string
 (define
  (forth-sb-type! sb s)
  (dict-set! sb "_chars" (append (get sb "_chars") (string->list s)))
  sb)
 (define (forth-sb-value sb) (list->string (get sb "_chars")))
 (define (forth-sb-length sb) (len (get sb "_chars")))
 (define (forth-sb-clear! sb) (dict-set! sb "_chars" (list)) sb)
 ;; Emit integer as decimal digits
 (define (forth-sb-emit-int! sb n) (forth-sb-type! sb (str (truncate n))))
 ;; ---------------------------------------------------------------------------
 ;; 3. Memory / Bytevectors — Forth raw memory model
 ;;    ALLOT allocates a bytevector. Byte and cell (32-bit LE) access.
 ;; ---------------------------------------------------------------------------
 ;; ALLOT — allocate n bytes zero-initialised
 (define (forth-mem-new n) (make-bytevector (truncate n) 0))
 (define (forth-mem? v) (bytevector? v))
 (define (forth-mem-size v) (bytevector-length v))
 ;; C@ C! — byte fetch/store
 (define (forth-cfetch mem addr) (bytevector-u8-ref mem (truncate addr)))
 (define
-  (forth-cstore mem addr val)
+  forth-error
-  (bytevector-u8-set!
+  (fn (state msg) (dict-set! state "error" msg) (raise msg)))
    mem
    (truncate addr)
    (modulo (truncate val) 256))
  mem)
 ;; @ ! — 32-bit little-endian cell fetch/store
 (define
-  (forth-fetch mem addr)
+  forth-push
  (fn (state v) (dict-set! state "dstack" (cons v (get state "dstack")))))
 (define
  forth-pop
  (fn
    (state)
    (let
-    ((a (truncate addr)))
+      ((st (get state "dstack")))
-    (+
+      (if
-      (bytevector-u8-ref mem a)
+        (= (len st) 0)
-      (* 256 (bytevector-u8-ref mem (+ a 1)))
+        (forth-error state "stack underflow")
-      (* 65536 (bytevector-u8-ref mem (+ a 2)))
+        (let ((top (first st))) (dict-set! state "dstack" (rest st)) top)))))
      (* 16777216 (bytevector-u8-ref mem (+ a 3))))))
 (define
-  (forth-store mem addr val)
+  forth-peek
  (fn
    (state)
    (let
-    ((a (truncate addr)) (v (truncate val)))
+      ((st (get state "dstack")))
-    (bytevector-u8-set! mem a (modulo v 256))
+      (if (= (len st) 0) (forth-error state "stack underflow") (first st)))))
    (bytevector-u8-set!
      mem
      (+ a 1)
      (modulo (quotient v 256) 256))
    (bytevector-u8-set!
      mem
      (+ a 2)
      (modulo (quotient v 65536) 256))
    (bytevector-u8-set!
      mem
      (+ a 3)
      (modulo (quotient v 16777216) 256)))
  mem)
-;; MOVE — copy count bytes from src[src-addr] to dst[dst-addr]
+(define forth-depth (fn (state) (len (get state "dstack"))))
 (define
  (forth-move! src src-addr dst dst-addr count)
  (letrec
    ((go (fn (i) (when (< i (truncate count)) (bytevector-u8-set! dst (+ (truncate dst-addr) i) (bytevector-u8-ref src (+ (truncate src-addr) i))) (go (+ i 1))))))
    (go 0))
  dst)
 ;; FILL — fill count bytes at addr with byte value
 (define
-  (forth-fill! mem addr count byte)
+  forth-rpush
-  (letrec
+  (fn (state v) (dict-set! state "rstack" (cons v (get state "rstack")))))
    ((go (fn (i) (when (< i (truncate count)) (bytevector-u8-set! mem (+ (truncate addr) i) (modulo (truncate byte) 256)) (go (+ i 1))))))
    (go 0))
  mem)
 ;; ERASE — fill with zeros (Forth: ERASE)
 (define
-  (forth-erase! mem addr count)
+  forth-rpop
-  (forth-fill! mem addr count 0))
+  (fn
    (state)
    (let
      ((st (get state "rstack")))
      (if
        (= (len st) 0)
        (forth-error state "return stack underflow")
        (let ((top (first st))) (dict-set! state "rstack" (rest st)) top)))))
 ;; Dump memory region as list of byte values
 (define
-  (forth-mem->list mem addr count)
+  forth-rpeek
-  (letrec
+  (fn
-    ((go (fn (i acc) (if (= i 0) acc (go (- i 1) (cons (bytevector-u8-ref mem (+ (truncate addr) (- i 1))) acc))))))
+    (state)
-    (go (truncate count) (list))))
+    (let
      ((st (get state "rstack")))
      (if
        (= (len st) 0)
        (forth-error state "return stack underflow")
        (first st)))))
 (define
  forth-emit-str
  (fn (state s) (dict-set! state "output" (str (get state "output") s))))
 (define
  forth-make-word
  (fn
    (kind body immediate?)
    (let
      ((w (dict)))
      (dict-set! w "kind" kind)
      (dict-set! w "body" body)
      (dict-set! w "immediate?" immediate?)
      w)))
 (define
  forth-def-prim!
  (fn
    (state name body)
    (dict-set!
      (get state "dict")
      (downcase name)
      (forth-make-word "primitive" body false))))
 (define
  forth-def-prim-imm!
  (fn
    (state name body)
    (dict-set!
      (get state "dict")
      (downcase name)
      (forth-make-word "primitive" body true))))
 (define
  forth-lookup
  (fn (state name) (get (get state "dict") (downcase name))))
 (define
  forth-binop
  (fn
    (op)
    (fn
      (state)
      (let
        ((b (forth-pop state)) (a (forth-pop state)))
        (forth-push state (op a b))))))
 (define
  forth-unop
  (fn
    (op)
    (fn (state) (let ((a (forth-pop state))) (forth-push state (op a))))))
 (define
  forth-cmp
  (fn
    (op)
    (fn
      (state)
      (let
        ((b (forth-pop state)) (a (forth-pop state)))
        (forth-push state (if (op a b) -1 0))))))
 (define
  forth-cmp0
  (fn
    (op)
    (fn
      (state)
      (let ((a (forth-pop state))) (forth-push state (if (op a) -1 0))))))
 (define
  forth-trunc
  (fn (x) (if (< x 0) (- 0 (floor (- 0 x))) (floor x))))
 (define
  forth-div
  (fn
    (a b)
    (if (= b 0) (raise "division by zero") (forth-trunc (/ a b)))))
 (define
  forth-mod
  (fn
    (a b)
    (if (= b 0) (raise "division by zero") (- a (* b (forth-div a b))))))
 (define forth-bits-width 32)
 (define
  forth-to-unsigned
  (fn (n w) (let ((m (pow 2 w))) (mod (+ (mod n m) m) m))))
 (define
  forth-from-unsigned
  (fn
    (n w)
    (let ((half (pow 2 (- w 1)))) (if (>= n half) (- n (pow 2 w)) n))))
 (define
  forth-bitwise-step
  (fn
    (op ua ub out place i w)
    (if
      (>= i w)
      out
      (let
        ((da (mod ua 2)) (db (mod ub 2)))
        (forth-bitwise-step
          op
          (floor (/ ua 2))
          (floor (/ ub 2))
          (+ out (* place (op da db)))
          (* place 2)
          (+ i 1)
          w)))))
 (define
  forth-bitwise-uu
  (fn
    (op)
    (fn
      (a b)
      (let
        ((ua (forth-to-unsigned a forth-bits-width))
          (ub (forth-to-unsigned b forth-bits-width)))
        (forth-from-unsigned
          (forth-bitwise-step op ua ub 0 1 0 forth-bits-width)
          forth-bits-width)))))
 (define
  forth-bit-and
  (forth-bitwise-uu (fn (x y) (if (and (= x 1) (= y 1)) 1 0))))
 (define
  forth-bit-or
  (forth-bitwise-uu (fn (x y) (if (or (= x 1) (= y 1)) 1 0))))
 (define forth-bit-xor (forth-bitwise-uu (fn (x y) (if (= x y) 0 1))))
 (define forth-bit-invert (fn (a) (- 0 (+ a 1))))
 (define
  forth-install-primitives!
  (fn
    (state)
    (forth-def-prim! state "DUP" (fn (s) (forth-push s (forth-peek s))))
    (forth-def-prim! state "DROP" (fn (s) (forth-pop s)))
    (forth-def-prim!
      state
      "SWAP"
      (fn
        (s)
        (let
          ((b (forth-pop s)) (a (forth-pop s)))
          (forth-push s b)
          (forth-push s a))))
    (forth-def-prim!
      state
      "OVER"
      (fn
        (s)
        (let
          ((b (forth-pop s)) (a (forth-pop s)))
          (forth-push s a)
          (forth-push s b)
          (forth-push s a))))
    (forth-def-prim!
      state
      "ROT"
      (fn
        (s)
        (let
          ((c (forth-pop s)) (b (forth-pop s)) (a (forth-pop s)))
          (forth-push s b)
          (forth-push s c)
          (forth-push s a))))
    (forth-def-prim!
      state
      "-ROT"
      (fn
        (s)
        (let
          ((c (forth-pop s)) (b (forth-pop s)) (a (forth-pop s)))
          (forth-push s c)
          (forth-push s a)
          (forth-push s b))))
    (forth-def-prim!
      state
      "NIP"
      (fn (s) (let ((b (forth-pop s))) (forth-pop s) (forth-push s b))))
    (forth-def-prim!
      state
      "TUCK"
      (fn
        (s)
        (let
          ((b (forth-pop s)) (a (forth-pop s)))
          (forth-push s b)
          (forth-push s a)
          (forth-push s b))))
    (forth-def-prim!
      state
      "?DUP"
      (fn
        (s)
        (let ((a (forth-peek s))) (when (not (= a 0)) (forth-push s a)))))
    (forth-def-prim! state "DEPTH" (fn (s) (forth-push s (forth-depth s))))
    (forth-def-prim!
      state
      "PICK"
      (fn
        (s)
        (let
          ((n (forth-pop s)) (st (get s "dstack")))
          (if
            (or (< n 0) (>= n (len st)))
            (forth-error s "PICK out of range")
            (forth-push s (nth st n))))))
    (forth-def-prim!
      state
      "ROLL"
      (fn
        (s)
        (let
          ((n (forth-pop s)) (st (get s "dstack")))
          (if
            (or (< n 0) (>= n (len st)))
            (forth-error s "ROLL out of range")
            (let
              ((taken (nth st n))
                (before (take st n))
                (after (drop st (+ n 1))))
              (dict-set! s "dstack" (concat before after))
              (forth-push s taken))))))
    (forth-def-prim!
      state
      "2DUP"
      (fn
        (s)
        (let
          ((b (forth-pop s)) (a (forth-pop s)))
          (forth-push s a)
          (forth-push s b)
          (forth-push s a)
          (forth-push s b))))
    (forth-def-prim! state "2DROP" (fn (s) (forth-pop s) (forth-pop s)))
    (forth-def-prim!
      state
      "2SWAP"
      (fn
        (s)
        (let
          ((d (forth-pop s))
            (c (forth-pop s))
            (b (forth-pop s))
            (a (forth-pop s)))
          (forth-push s c)
          (forth-push s d)
          (forth-push s a)
          (forth-push s b))))
    (forth-def-prim!
      state
      "2OVER"
      (fn
        (s)
        (let
          ((d (forth-pop s))
            (c (forth-pop s))
            (b (forth-pop s))
            (a (forth-pop s)))
          (forth-push s a)
          (forth-push s b)
          (forth-push s c)
          (forth-push s d)
          (forth-push s a)
          (forth-push s b))))
    (forth-def-prim! state "+" (forth-binop (fn (a b) (+ a b))))
    (forth-def-prim! state "-" (forth-binop (fn (a b) (- a b))))
    (forth-def-prim! state "*" (forth-binop (fn (a b) (* a b))))
    (forth-def-prim! state "/" (forth-binop forth-div))
    (forth-def-prim! state "MOD" (forth-binop forth-mod))
    (forth-def-prim!
      state
      "/MOD"
      (fn
        (s)
        (let
          ((b (forth-pop s)) (a (forth-pop s)))
          (forth-push s (forth-mod a b))
          (forth-push s (forth-div a b)))))
    (forth-def-prim! state "NEGATE" (forth-unop (fn (a) (- 0 a))))
    (forth-def-prim! state "ABS" (forth-unop abs))
    (forth-def-prim!
      state
      "MIN"
      (forth-binop (fn (a b) (if (< a b) a b))))
    (forth-def-prim!
      state
      "MAX"
      (forth-binop (fn (a b) (if (> a b) a b))))
    (forth-def-prim! state "1+" (forth-unop (fn (a) (+ a 1))))
    (forth-def-prim! state "1-" (forth-unop (fn (a) (- a 1))))
    (forth-def-prim! state "2+" (forth-unop (fn (a) (+ a 2))))
    (forth-def-prim! state "2-" (forth-unop (fn (a) (- a 2))))
    (forth-def-prim! state "2*" (forth-unop (fn (a) (* a 2))))
    (forth-def-prim! state "2/" (forth-unop (fn (a) (floor (/ a 2)))))
    (forth-def-prim! state "=" (forth-cmp (fn (a b) (= a b))))
    (forth-def-prim! state "<>" (forth-cmp (fn (a b) (not (= a b)))))
    (forth-def-prim! state "<" (forth-cmp (fn (a b) (< a b))))
    (forth-def-prim! state ">" (forth-cmp (fn (a b) (> a b))))
    (forth-def-prim! state "<=" (forth-cmp (fn (a b) (<= a b))))
    (forth-def-prim! state ">=" (forth-cmp (fn (a b) (>= a b))))
    (forth-def-prim! state "0=" (forth-cmp0 (fn (a) (= a 0))))
    (forth-def-prim! state "0<>" (forth-cmp0 (fn (a) (not (= a 0)))))
    (forth-def-prim! state "0<" (forth-cmp0 (fn (a) (< a 0))))
    (forth-def-prim! state "0>" (forth-cmp0 (fn (a) (> a 0))))
    (forth-def-prim! state "AND" (forth-binop forth-bit-and))
    (forth-def-prim! state "OR" (forth-binop forth-bit-or))
    (forth-def-prim! state "XOR" (forth-binop forth-bit-xor))
    (forth-def-prim! state "INVERT" (forth-unop forth-bit-invert))
    (forth-def-prim!
      state
      "."
      (fn (s) (forth-emit-str s (str (forth-pop s) " "))))
    (forth-def-prim!
      state
      ".S"
      (fn
        (s)
        (let
          ((st (reverse (get s "dstack"))))
          (forth-emit-str s "<")
          (forth-emit-str s (str (len st)))
          (forth-emit-str s "> ")
          (for-each (fn (v) (forth-emit-str s (str v " "))) st))))
    (forth-def-prim!
      state
      "EMIT"
      (fn (s) (forth-emit-str s (code-char (forth-pop s)))))
    (forth-def-prim! state "CR" (fn (s) (forth-emit-str s "\n")))
    (forth-def-prim! state "SPACE" (fn (s) (forth-emit-str s " ")))
    (forth-def-prim!
      state
      "SPACES"
      (fn
        (s)
        (let
          ((n (forth-pop s)))
          (when
            (> n 0)
            (for-each (fn (_) (forth-emit-str s " ")) (range 0 n))))))
    (forth-def-prim! state "BL" (fn (s) (forth-push s 32)))
    state))
--- a/lib/forth/test.sh
+++ b/lib/forth/test.sh
@@ -1,62 +0,0 @@
 #!/usr/bin/env bash
 # lib/forth/test.sh — smoke-test the Forth runtime layer.
 set -uo pipefail
 cd "$(git rev-parse --show-toplevel)"
 SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
 if [ ! -x "$SX_SERVER" ]; then
  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
 fi
 if [ ! -x "$SX_SERVER" ]; then
  echo "ERROR: sx_server.exe not found."
  exit 1
 fi
 TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
 cat > "$TMPFILE" << 'EPOCHS'
 (epoch 1)
 (load "lib/forth/runtime.sx")
 (epoch 2)
 (load "lib/forth/tests/runtime.sx")
 (epoch 3)
 (eval "(list forth-test-pass forth-test-fail)")
 EPOCHS
 OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
 LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}')
 if [ -z "$LINE" ]; then
  LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \
          | sed -E 's/^\(ok 3 //; s/\)$//')
 fi
 if [ -z "$LINE" ]; then
  echo "ERROR: could not extract summary"
  echo "$OUTPUT" | tail -20
  exit 1
 fi
 P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
 F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
 TOTAL=$((P + F))
 if [ "$F" -eq 0 ]; then
  echo "ok $P/$TOTAL lib/forth tests passed"
 else
  echo "FAIL $P/$TOTAL passed, $F failed"
  TMPFILE2=$(mktemp)
  cat > "$TMPFILE2" << 'EPOCHS2'
 (epoch 1)
 (load "lib/forth/runtime.sx")
 (epoch 2)
 (load "lib/forth/tests/runtime.sx")
 (epoch 3)
 (eval "(map (fn (f) (list (get f :name) (get f :got) (get f :expected))) forth-test-fails)")
 EPOCHS2
  FAILS=$(timeout 60 "$SX_SERVER" < "$TMPFILE2" 2>/dev/null | grep -E '^\(ok-len 3' -A1 | tail -1 || true)
  echo "  Details: $FAILS"
  rm -f "$TMPFILE2"
 fi
 [ "$F" -eq 0 ]
--- a/lib/forth/tests/runtime.sx
+++ b/lib/forth/tests/runtime.sx
@@ -1,201 +0,0 @@
 ;; lib/forth/tests/runtime.sx — Tests for lib/forth/runtime.sx
 (define forth-test-pass 0)
 (define forth-test-fail 0)
 (define forth-test-fails (list))
 (define
  (forth-test name got expected)
  (if
    (= got expected)
    (set! forth-test-pass (+ forth-test-pass 1))
    (begin
      (set! forth-test-fail (+ forth-test-fail 1))
      (set! forth-test-fails (append forth-test-fails (list {:got got :expected expected :name name}))))))
 ;; ---------------------------------------------------------------------------
 ;; 1. Bitwise operations
 ;; ---------------------------------------------------------------------------
 ;; AND
 (forth-test "and 0b1100 0b1010" (forth-and 12 10) 8)
 (forth-test "and 0xFF 0x0F" (forth-and 255 15) 15)
 (forth-test "and 0 any" (forth-and 0 42) 0)
 ;; OR
 (forth-test "or 0b1100 0b1010" (forth-or 12 10) 14)
 (forth-test "or 0 x" (forth-or 0 7) 7)
 ;; XOR
 (forth-test "xor 0b1100 0b1010" (forth-xor 12 10) 6)
 (forth-test "xor x x" (forth-xor 42 42) 0)
 ;; INVERT
 (forth-test "invert 0" (forth-invert 0) -1)
 (forth-test "invert -1" (forth-invert -1) 0)
 (forth-test "invert 1" (forth-invert 1) -2)
 ;; LSHIFT RSHIFT
 (forth-test "lshift 1 3" (forth-lshift 1 3) 8)
 (forth-test "lshift 3 2" (forth-lshift 3 2) 12)
 (forth-test "rshift 8 3" (forth-rshift 8 3) 1)
 (forth-test "rshift 16 2" (forth-rshift 16 2) 4)
 ;; 2* 2/
 (forth-test "2* 5" (forth-2* 5) 10)
 (forth-test "2/ 10" (forth-2/ 10) 5)
 (forth-test "2/ 7" (forth-2/ 7) 3)
 ;; BIT-COUNT
 (forth-test "bit-count 0" (forth-bit-count 0) 0)
 (forth-test "bit-count 1" (forth-bit-count 1) 1)
 (forth-test "bit-count 7" (forth-bit-count 7) 3)
 (forth-test "bit-count 255" (forth-bit-count 255) 8)
 (forth-test "bit-count 256" (forth-bit-count 256) 1)
 ;; INTEGER-LENGTH
 (forth-test "integer-length 0" (forth-integer-length 0) 0)
 (forth-test "integer-length 1" (forth-integer-length 1) 1)
 (forth-test "integer-length 4" (forth-integer-length 4) 3)
 (forth-test "integer-length 255" (forth-integer-length 255) 8)
 ;; WITHIN
 (forth-test
  "within 5 0 10"
  (forth-within 5 0 10)
  true)
 (forth-test
  "within 0 0 10"
  (forth-within 0 0 10)
  true)
 (forth-test
  "within 10 0 10"
  (forth-within 10 0 10)
  false)
 (forth-test
  "within -1 0 10"
  (forth-within -1 0 10)
  false)
 ;; Arithmetic ops
 (forth-test "negate 5" (forth-negate 5) -5)
 (forth-test "negate -3" (forth-negate -3) 3)
 (forth-test "abs -7" (forth-abs -7) 7)
 (forth-test "min 3 5" (forth-min 3 5) 3)
 (forth-test "max 3 5" (forth-max 3 5) 5)
 (forth-test "mod 7 3" (forth-mod 7 3) 1)
 (forth-test
  "divmod 7 3"
  (forth-divmod 7 3)
  (list 1 2))
 (forth-test
  "divmod 10 5"
  (forth-divmod 10 5)
  (list 0 2))
 ;; ---------------------------------------------------------------------------
 ;; 2. String buffer
 ;; ---------------------------------------------------------------------------
 (define sb1 (forth-sb-new))
 (forth-test "sb? new" (forth-sb? sb1) true)
 (forth-test "sb? non-sb" (forth-sb? 42) false)
 (forth-test "sb value empty" (forth-sb-value sb1) "")
 (forth-test "sb length empty" (forth-sb-length sb1) 0)
 (forth-sb-type! sb1 "HELLO")
 (forth-test "sb type" (forth-sb-value sb1) "HELLO")
 (forth-test "sb length after type" (forth-sb-length sb1) 5)
 ;; EMIT one char
 (define sb2 (forth-sb-new))
 (forth-sb-emit! sb2 (nth (string->list "A") 0))
 (forth-sb-emit! sb2 (nth (string->list "B") 0))
 (forth-sb-emit! sb2 (nth (string->list "C") 0))
 (forth-test "sb emit chars" (forth-sb-value sb2) "ABC")
 ;; Emit integer
 (define sb3 (forth-sb-new))
 (forth-sb-type! sb3 "n=")
 (forth-sb-emit-int! sb3 42)
 (forth-test "sb emit-int" (forth-sb-value sb3) "n=42")
 (forth-sb-clear! sb1)
 (forth-test "sb clear" (forth-sb-value sb1) "")
 (forth-test "sb length after clear" (forth-sb-length sb1) 0)
 ;; Build a word definition-style name
 (define sb4 (forth-sb-new))
 (forth-sb-type! sb4 ": ")
 (forth-sb-type! sb4 "SQUARE")
 (forth-sb-type! sb4 " DUP * ;")
 (forth-test "sb word def" (forth-sb-value sb4) ": SQUARE DUP * ;")
 ;; ---------------------------------------------------------------------------
 ;; 3. Memory / Bytevectors
 ;; ---------------------------------------------------------------------------
 (define m1 (forth-mem-new 8))
 (forth-test "mem? yes" (forth-mem? m1) true)
 (forth-test "mem? no" (forth-mem? 42) false)
 (forth-test "mem size" (forth-mem-size m1) 8)
 (forth-test "mem cfetch zero" (forth-cfetch m1 0) 0)
 ;; C! C@
 (forth-cstore m1 0 65)
 (forth-cstore m1 1 66)
 (forth-test "mem cstore/cfetch 0" (forth-cfetch m1 0) 65)
 (forth-test "mem cstore/cfetch 1" (forth-cfetch m1 1) 66)
 (forth-cstore m1 2 256)
 (forth-test
  "mem cstore wraps 256→0"
  (forth-cfetch m1 2)
  0)
 (forth-cstore m1 2 257)
 (forth-test
  "mem cstore wraps 257→1"
  (forth-cfetch m1 2)
  1)
 ;; @ ! (32-bit LE cell)
 (define m2 (forth-mem-new 8))
 (forth-store m2 0 305419896)
 (forth-test "mem store/fetch" (forth-fetch m2 0) 305419896)
 (forth-store m2 4 1)
 (forth-test "mem fetch byte 4" (forth-cfetch m2 4) 1)
 (forth-test "mem fetch byte 5" (forth-cfetch m2 5) 0)
 ;; FILL ERASE
 (define m3 (forth-mem-new 4))
 (forth-fill! m3 0 4 42)
 (forth-test
  "mem fill"
  (forth-mem->list m3 0 4)
  (list 42 42 42 42))
 (forth-erase! m3 1 2)
 (forth-test
  "mem erase middle"
  (forth-mem->list m3 0 4)
  (list 42 0 0 42))
 ;; MOVE
 (define m4 (forth-mem-new 4))
 (forth-cstore m4 0 1)
 (forth-cstore m4 1 2)
 (forth-cstore m4 2 3)
 (define m5 (forth-mem-new 4))
 (forth-move! m4 0 m5 0 3)
 (forth-test
  "mem move"
  (forth-mem->list m5 0 3)
  (list 1 2 3))
 ;; mem->list
 (define m6 (forth-mem-new 3))
 (forth-cstore m6 0 10)
 (forth-cstore m6 1 20)
 (forth-cstore m6 2 30)
 (forth-test
  "mem->list"
  (forth-mem->list m6 0 3)
  (list 10 20 30))
--- a/lib/guest/baseline/apl.json
+++ b/lib/guest/baseline/apl.json
@@ -1,18 +0,0 @@
 {
  "lang": "apl",
  "captured": "2026-05-06T22:01:00Z",
  "suite_command": "bash lib/apl/test.sh",
  "totals": {
    "pass": 73,
    "fail": 0,
    "total": 73
  },
  "suites": [
    {
      "name": "all",
      "pass": 73,
      "fail": 0,
      "total": 73
    }
  ]
 }
--- a/lib/guest/baseline/common-lisp.json
+++ b/lib/guest/baseline/common-lisp.json
@@ -1,86 +0,0 @@
 {
  "lang": "common-lisp",
  "captured": "2026-05-06T22:59:46Z",
  "suite_command": "bash lib/common-lisp/conformance.sh",
  "totals": {
    "pass": 518,
    "fail": 0,
    "total": 518
  },
  "suites": [
    {
      "name": "Phase 1: tokenizer/reader",
      "pass": 79,
      "fail": 0,
      "total": 79
    },
    {
      "name": "Phase 1: parser/lambda-lists",
      "pass": 31,
      "fail": 0,
      "total": 31
    },
    {
      "name": "Phase 2: evaluator",
      "pass": 182,
      "fail": 0,
      "total": 182
    },
    {
      "name": "Phase 3: condition system",
      "pass": 59,
      "fail": 0,
      "total": 59
    },
    {
      "name": "Phase 3: restart-demo",
      "pass": 7,
      "fail": 0,
      "total": 7
    },
    {
      "name": "Phase 3: parse-recover",
      "pass": 6,
      "fail": 0,
      "total": 6
    },
    {
      "name": "Phase 3: interactive-debugger",
      "pass": 7,
      "fail": 0,
      "total": 7
    },
    {
      "name": "Phase 4: CLOS",
      "pass": 41,
      "fail": 0,
      "total": 41
    },
    {
      "name": "Phase 4: geometry",
      "pass": 12,
      "fail": 0,
      "total": 12
    },
    {
      "name": "Phase 4: mop-trace",
      "pass": 13,
      "fail": 0,
      "total": 13
    },
    {
      "name": "Phase 5: macros+LOOP",
      "pass": 27,
      "fail": 0,
      "total": 27
    },
    {
      "name": "Phase 6: stdlib",
      "pass": 54,
      "fail": 0,
      "total": 54
    }
  ],
  "source_scoreboard": "lib/common-lisp/scoreboard.json",
  "note": "Step 2: previous baseline (309) was lower because Phase 2 (evaluator, +182 tests) and Phase 6 (stdlib, +27 tests) results were under-counted by the original conformance.sh's parser. Re-running with prefix.sx loaded reveals true counts. No tests regressed."
 }
--- a/lib/guest/baseline/erlang.json
+++ b/lib/guest/baseline/erlang.json
@@ -1,67 +0,0 @@
 {
  "lang": "erlang",
  "captured": "2026-05-06T22:01:00Z",
  "suite_command": "bash lib/erlang/conformance.sh",
  "totals": {
    "pass": 0,
    "fail": 0,
    "total": 0
  },
  "suites": [
    {
      "name": "tokenize",
      "pass": 0,
      "fail": 0,
      "total": 0
    },
    {
      "name": "parse",
      "pass": 0,
      "fail": 0,
      "total": 0
    },
    {
      "name": "eval",
      "pass": 0,
      "fail": 0,
      "total": 0
    },
    {
      "name": "runtime",
      "pass": 0,
      "fail": 0,
      "total": 0
    },
    {
      "name": "ring",
      "pass": 0,
      "fail": 0,
      "total": 0
    },
    {
      "name": "ping-pong",
      "pass": 0,
      "fail": 0,
      "total": 0
    },
    {
      "name": "bank",
      "pass": 0,
      "fail": 0,
      "total": 0
    },
    {
      "name": "echo",
      "pass": 0,
      "fail": 0,
      "total": 0
    },
    {
      "name": "fib",
      "pass": 0,
      "fail": 0,
      "total": 0
    }
  ],
  "source_scoreboard": "lib/erlang/scoreboard.json"
 }
--- a/lib/guest/baseline/forth.json
+++ b/lib/guest/baseline/forth.json
@@ -1,18 +0,0 @@
 {
  "lang": "forth",
  "captured": "2026-05-06T22:01:00Z",
  "suite_command": "bash lib/forth/test.sh",
  "totals": {
    "pass": 64,
    "fail": 0,
    "total": 64
  },
  "suites": [
    {
      "name": "all",
      "pass": 64,
      "fail": 0,
      "total": 64
    }
  ]
 }
--- a/lib/guest/baseline/haskell.json
+++ b/lib/guest/baseline/haskell.json
@@ -1,122 +0,0 @@
 {
  "lang": "haskell",
  "captured": "2026-05-06T22:46:16Z",
  "suite_command": "bash lib/haskell/conformance.sh",
  "totals": {
    "pass": 156,
    "fail": 0,
    "total": 156
  },
  "suites": [
    {
      "name": "fib",
      "pass": 2,
      "fail": 0,
      "total": 2
    },
    {
      "name": "sieve",
      "pass": 2,
      "fail": 0,
      "total": 2
    },
    {
      "name": "quicksort",
      "pass": 5,
      "fail": 0,
      "total": 5
    },
    {
      "name": "nqueens",
      "pass": 2,
      "fail": 0,
      "total": 2
    },
    {
      "name": "calculator",
      "pass": 5,
      "fail": 0,
      "total": 5
    },
    {
      "name": "collatz",
      "pass": 11,
      "fail": 0,
      "total": 11
    },
    {
      "name": "palindrome",
      "pass": 8,
      "fail": 0,
      "total": 8
    },
    {
      "name": "maybe",
      "pass": 12,
      "fail": 0,
      "total": 12
    },
    {
      "name": "fizzbuzz",
      "pass": 12,
      "fail": 0,
      "total": 12
    },
    {
      "name": "anagram",
      "pass": 9,
      "fail": 0,
      "total": 9
    },
    {
      "name": "roman",
      "pass": 14,
      "fail": 0,
      "total": 14
    },
    {
      "name": "binary",
      "pass": 12,
      "fail": 0,
      "total": 12
    },
    {
      "name": "either",
      "pass": 12,
      "fail": 0,
      "total": 12
    },
    {
      "name": "primes",
      "pass": 12,
      "fail": 0,
      "total": 12
    },
    {
      "name": "zipwith",
      "pass": 9,
      "fail": 0,
      "total": 9
    },
    {
      "name": "matrix",
      "pass": 8,
      "fail": 0,
      "total": 8
    },
    {
      "name": "wordcount",
      "pass": 7,
      "fail": 0,
      "total": 7
    },
    {
      "name": "powers",
      "pass": 14,
      "fail": 0,
      "total": 14
    }
  ],
  "source_scoreboard": "lib/haskell/scoreboard.json",
  "note": "Step 1: previous baseline (0/18) was an artefact of the old conformance.sh bug \u2014 its (ok-len 3 ...) grep never matched, defaulting every program to 0 pass / 1 fail. Shared driver in Step 1 reads counters correctly."
 }
--- a/lib/guest/baseline/js.json
+++ b/lib/guest/baseline/js.json
@@ -1,75 +0,0 @@
 {
  "lang": "js",
  "captured": "2026-05-06T22:01:00Z",
  "suite_command": "bash lib/js/conformance.sh",
  "totals": {
    "pass": 94,
    "fail": 54,
    "total": 148
  },
  "suites": [
    {
      "name": "test262-slice",
      "pass": 94,
      "fail": 54,
      "total": 148,
      "failing_tests": [
        "arithmetic/bitnot",
        "arithmetic/mixed_concat",
        "async/await_promise_all",
        "closures/sum_sq",
        "coercion/implicit_str_add",
        "collections/array_index",
        "collections/array_nested",
        "collections/string_index",
        "functions/rest_param",
        "loops/for_break",
        "loops/for_continue",
        "loops/nested_for",
        "loops/while_basic",
        "loops/while_break_infinite",
        "objects/array_filter_reduce",
        "objects/array_map",
        "objects/array_method_chain",
        "objects/array_mutate",
        "objects/array_push_length",
        "objects/arrow_lexical_this",
        "objects/class_basic",
        "objects/class_extend_chain",
        "objects/class_inherit",
        "objects/counter_closure",
        "objects/in_operator",
        "objects/instanceof",
        "objects/method_this",
        "objects/new_constructor",
        "objects/object_mutate",
        "objects/prototype_chain",
        "objects/string_method",
        "objects/string_slice",
        "promises/executor_throws",
        "promises/finally_passthrough",
        "promises/microtask_ordering",
        "promises/new_promise_reject",
        "promises/new_promise_resolve",
        "promises/promise_all",
        "promises/promise_all_empty",
        "promises/promise_all_nonpromise",
        "promises/promise_all_reject",
        "promises/promise_race",
        "promises/promise_resolve_already_promise",
        "promises/reject_catch",
        "promises/resolve_adopts",
        "promises/resolve_then",
        "promises/then_chain",
        "promises/then_throw_catch",
        "statements/block_scope",
        "statements/const_multi",
        "statements/if_else_false",
        "statements/if_else_true",
        "statements/let_init",
        "statements/var_decl"
      ]
    }
  ],
  "source_scoreboard": "lib/js/conformance.sh-output"
 }
--- a/lib/guest/baseline/lua.json
+++ b/lib/guest/baseline/lua.json
@@ -1,18 +0,0 @@
 {
  "lang": "lua",
  "captured": "2026-05-06T22:01:00Z",
  "suite_command": "bash lib/lua/test.sh",
  "totals": {
    "pass": 185,
    "fail": 0,
    "total": 185
  },
  "suites": [
    {
      "name": "all",
      "pass": 185,
      "fail": 0,
      "total": 185
    }
  ]
 }
--- a/lib/guest/baseline/prolog.json
+++ b/lib/guest/baseline/prolog.json
@@ -1,187 +0,0 @@
 {
  "lang": "prolog",
  "captured": "2026-05-06T22:01:00Z",
  "suite_command": "bash lib/prolog/conformance.sh",
  "totals": {
    "pass": 590,
    "fail": 0,
    "total": 590
  },
  "suites": [
    {
      "name": "parse",
      "pass": 25,
      "fail": 0,
      "total": 25
    },
    {
      "name": "unify",
      "pass": 47,
      "fail": 0,
      "total": 47
    },
    {
      "name": "clausedb",
      "pass": 14,
      "fail": 0,
      "total": 14
    },
    {
      "name": "solve",
      "pass": 62,
      "fail": 0,
      "total": 62
    },
    {
      "name": "operators",
      "pass": 19,
      "fail": 0,
      "total": 19
    },
    {
      "name": "dynamic",
      "pass": 11,
      "fail": 0,
      "total": 11
    },
    {
      "name": "findall",
      "pass": 11,
      "fail": 0,
      "total": 11
    },
    {
      "name": "term_inspect",
      "pass": 14,
      "fail": 0,
      "total": 14
    },
    {
      "name": "append",
      "pass": 6,
      "fail": 0,
      "total": 6
    },
    {
      "name": "reverse",
      "pass": 6,
      "fail": 0,
      "total": 6
    },
    {
      "name": "member",
      "pass": 7,
      "fail": 0,
      "total": 7
    },
    {
      "name": "nqueens",
      "pass": 6,
      "fail": 0,
      "total": 6
    },
    {
      "name": "family",
      "pass": 10,
      "fail": 0,
      "total": 10
    },
    {
      "name": "atoms",
      "pass": 34,
      "fail": 0,
      "total": 34
    },
    {
      "name": "query_api",
      "pass": 16,
      "fail": 0,
      "total": 16
    },
    {
      "name": "iso_predicates",
      "pass": 29,
      "fail": 0,
      "total": 29
    },
    {
      "name": "meta_predicates",
      "pass": 25,
      "fail": 0,
      "total": 25
    },
    {
      "name": "list_predicates",
      "pass": 33,
      "fail": 0,
      "total": 33
    },
    {
      "name": "meta_call",
      "pass": 15,
      "fail": 0,
      "total": 15
    },
    {
      "name": "set_predicates",
      "pass": 15,
      "fail": 0,
      "total": 15
    },
    {
      "name": "char_predicates",
      "pass": 27,
      "fail": 0,
      "total": 27
    },
    {
      "name": "io_predicates",
      "pass": 24,
      "fail": 0,
      "total": 24
    },
    {
      "name": "assert_rules",
      "pass": 15,
      "fail": 0,
      "total": 15
    },
    {
      "name": "string_agg",
      "pass": 25,
      "fail": 0,
      "total": 25
    },
    {
      "name": "advanced",
      "pass": 21,
      "fail": 0,
      "total": 21
    },
    {
      "name": "compiler",
      "pass": 17,
      "fail": 0,
      "total": 17
    },
    {
      "name": "cross_validate",
      "pass": 17,
      "fail": 0,
      "total": 17
    },
    {
      "name": "integration",
      "pass": 20,
      "fail": 0,
      "total": 20
    },
    {
      "name": "hs_bridge",
      "pass": 19,
      "fail": 0,
      "total": 19
    }
  ],
  "source_scoreboard": "lib/prolog/scoreboard.json"
 }
--- a/lib/guest/baseline/ruby.json
+++ b/lib/guest/baseline/ruby.json
@@ -1,18 +0,0 @@
 {
  "lang": "ruby",
  "captured": "2026-05-06T22:01:00Z",
  "suite_command": "bash lib/ruby/test.sh",
  "totals": {
    "pass": 76,
    "fail": 0,
    "total": 76
  },
  "suites": [
    {
      "name": "all",
      "pass": 76,
      "fail": 0,
      "total": 76
    }
  ]
 }
--- a/lib/guest/baseline/smalltalk.json
+++ b/lib/guest/baseline/smalltalk.json
@@ -1,25 +0,0 @@
 {
  "lang": "smalltalk",
  "captured": "2026-05-06T22:01:00Z",
  "suite_command": "bash lib/smalltalk/conformance.sh",
  "totals": {
    "pass": 625,
    "fail": 4,
    "total": 629
  },
  "suites": [
    {
      "name": "all",
      "pass": 625,
      "fail": 4,
      "total": 629
    },
    {
      "name": "classic-corpus",
      "pass": 4,
      "fail": 1,
      "total": 5
    }
  ],
  "source_scoreboard": "lib/smalltalk/scoreboard.json"
 }
--- a/lib/guest/baseline/tcl.json
+++ b/lib/guest/baseline/tcl.json
@@ -1,37 +0,0 @@
 {
  "lang": "tcl",
  "captured": "2026-05-06T22:01:00Z",
  "suite_command": "bash lib/tcl/conformance.sh",
  "totals": {
    "pass": 3,
    "fail": 1,
    "total": 4
  },
  "suites": [
    {
      "name": "assert",
      "pass": 1,
      "fail": 0,
      "total": 1
    },
    {
      "name": "event-loop",
      "pass": 0,
      "fail": 1,
      "total": 1
    },
    {
      "name": "for-each-line",
      "pass": 1,
      "fail": 0,
      "total": 1
    },
    {
      "name": "with-temp-var",
      "pass": 1,
      "fail": 0,
      "total": 1
    }
  ],
  "source_scoreboard": "lib/tcl/scoreboard.json"
 }
--- a/lib/guest/conformance.sh
+++ b/lib/guest/conformance.sh
@@ -1,221 +0,0 @@
 #!/usr/bin/env bash
 # lib/guest/conformance.sh — shared, config-driven conformance driver.
 #
 # Usage:
 #   bash lib/guest/conformance.sh <conf-file>
 #
 # The conf file is a bash file that sets:
 #   LANG_NAME           e.g. prolog
 #   PRELOADS=( ... )    .sx files to load before any suite (path from repo root)
 #   SUITES=( ... )      colon-separated entries; format depends on MODE
 #   MODE                "dict" or "counters"
 #   COUNTERS_PASS       (counters mode) global symbol for the pass counter
 #   COUNTERS_FAIL       (counters mode) global symbol for the fail counter
 #   TIMEOUT_PER_SUITE   (optional, counters mode) seconds per suite, default 120
 #   SCOREBOARD_DIR      (optional) defaults to lib/$LANG_NAME
 #
 # It may override the bash functions emit_scoreboard_json / emit_scoreboard_md
 # to produce the per-language scoreboard schema. Defaults are provided.
 #
 # Suite formats:
 #   MODE=dict       — "name:test-file:(runner-fn)"
 #                     The runner expression is evaluated and is expected to
 #                     return a dict with :passed/:failed/:total.
 #   MODE=counters   — "name:test-file"
 #                     Each suite is run in a fresh sx_server session: preloads
 #                     are loaded, then the test file, then counters are read.
 #                     The suite is treated as starting from counters (0, 0).
 #
 # Output:
 #   Writes $SCOREBOARD_DIR/scoreboard.json and $SCOREBOARD_DIR/scoreboard.md.
 #   Exits 0 if every suite is green, 1 otherwise.
 set -uo pipefail
 cd "$(git rev-parse --show-toplevel)"
 if [ "$#" -lt 1 ]; then
  echo "usage: $0 <conf-file>" >&2
  exit 2
 fi
 CONF="$1"
 if [ ! -f "$CONF" ]; then
  echo "config not found: $CONF" >&2
  exit 2
 fi
 # Defaults — the conf file may override these.
 LANG_NAME=
 PRELOADS=()
 SUITES=()
 MODE=dict
 COUNTERS_PASS=
 COUNTERS_FAIL=
 TIMEOUT_PER_SUITE=120
 SCOREBOARD_DIR=
 emit_scoreboard_json() {
  # Generic schema. Per-lang configs override this for byte-equality with
  # historical scoreboards.
  local n=${#GC_NAMES[@]} i sep
  printf '{\n'
  printf '  "lang": "%s",\n' "$LANG_NAME"
  printf '  "total_passed": %d,\n' "$GC_TOTAL_PASS"
  printf '  "total_failed": %d,\n' "$GC_TOTAL_FAIL"
  printf '  "total": %d,\n' "$GC_TOTAL"
  printf '  "suites": ['
  for ((i=0; i<n; i++)); do
    sep=","; [ $i -eq $((n-1)) ] && sep=""
    printf '\n    {"name":"%s","passed":%d,"failed":%d,"total":%d}%s' \
      "${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_FAIL[$i]}" "${GC_TOTAL_S[$i]}" "$sep"
  done
  printf '\n  ],\n'
  printf '  "generated": "%s"\n' "$(date -Iseconds 2>/dev/null || date)"
  printf '}\n'
 }
 emit_scoreboard_md() {
  local n=${#GC_NAMES[@]} i status
  printf '# %s scoreboard\n\n' "$LANG_NAME"
  printf '**%d / %d passing** (%d failure(s)).\n\n' "$GC_TOTAL_PASS" "$GC_TOTAL" "$GC_TOTAL_FAIL"
  printf '| Suite | Passed | Total | Status |\n'
  printf '|-------|--------|-------|--------|\n'
  for ((i=0; i<n; i++)); do
    status="ok"; [ "${GC_FAIL[$i]}" -gt 0 ] && status="FAIL"
    printf '| %s | %d | %d | %s |\n' \
      "${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_TOTAL_S[$i]}" "$status"
  done
 }
 # shellcheck disable=SC1090
 source "$CONF"
 if [ -z "$LANG_NAME" ]; then
  echo "LANG_NAME not set in $CONF" >&2
  exit 2
 fi
 SCOREBOARD_DIR="${SCOREBOARD_DIR:-lib/$LANG_NAME}"
 SX="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
 if [ ! -x "$SX" ]; then
  MAIN_ROOT=$(git worktree list 2>/dev/null | head -1 | awk '{print $1}')
  if [ -n "${MAIN_ROOT:-}" ] && [ -x "$MAIN_ROOT/$SX" ]; then
    SX="$MAIN_ROOT/$SX"
  else
    echo "ERROR: sx_server.exe not found (set SX_SERVER to override)." >&2
    exit 2
  fi
 fi
 GC_NAMES=()
 GC_PASS=()
 GC_FAIL=()
 GC_TOTAL_S=()
 parse_result_line() {
  # Match a (gc-result "name" P F T) line.
  local line="$1"
  if [[ "$line" =~ ^\(gc-result\ \"([^\"]+)\"\ ([0-9]+)\ ([0-9]+)\ ([0-9]+)\)$ ]]; then
    GC_NAMES+=("${BASH_REMATCH[1]}")
    GC_PASS+=("${BASH_REMATCH[2]}")
    GC_FAIL+=("${BASH_REMATCH[3]}")
    GC_TOTAL_S+=("${BASH_REMATCH[4]}")
    return 0
  fi
  return 1
 }
 case "$MODE" in
  dict)
    SCRIPT='(epoch 1)
 '
    for f in "${PRELOADS[@]}"; do
      SCRIPT+='(load "'"$f"'")
 '
    done
    SCRIPT+='(load "lib/guest/conformance.sx")
 '
    for entry in "${SUITES[@]}"; do
      IFS=: read -r _ file _ <<< "$entry"
      SCRIPT+='(load "'"$file"'")
 '
    done
    SCRIPT+='(epoch 2)
 '
    for entry in "${SUITES[@]}"; do
      IFS=: read -r name _ runner <<< "$entry"
      SCRIPT+='(eval "(gc-dict-result \"'"$name"'\" '"$runner"')")
 '
    done
    OUTPUT=$(printf '%s' "$SCRIPT" | "$SX" 2>&1)
    expected=${#SUITES[@]}
    matched=0
    while IFS= read -r line; do
      if parse_result_line "$line"; then
        matched=$((matched + 1))
      fi
    done <<< "$OUTPUT"
    if [ "$matched" -ne "$expected" ]; then
      echo "Expected $expected suite results, got $matched" >&2
      echo "---- raw output ----" >&2
      printf '%s\n' "$OUTPUT" >&2
      exit 3
    fi
    ;;
  counters)
    if [ -z "$COUNTERS_PASS" ] || [ -z "$COUNTERS_FAIL" ]; then
      echo "MODE=counters requires COUNTERS_PASS and COUNTERS_FAIL in $CONF" >&2
      exit 2
    fi
    for entry in "${SUITES[@]}"; do
      IFS=: read -r name file <<< "$entry"
      TMPFILE=$(mktemp)
      {
        printf '(epoch 1)\n'
        for f in "${PRELOADS[@]}"; do printf '(load "%s")\n' "$f"; done
        printf '(load "lib/guest/conformance.sx")\n'
        printf '(epoch 2)\n'
        printf '(load "%s")\n' "$file"
        printf '(epoch 3)\n'
        printf '(eval "(gc-counters-result \\"%s\\" 0 0 %s %s)")\n' \
          "$name" "$COUNTERS_PASS" "$COUNTERS_FAIL"
      } > "$TMPFILE"
      OUTPUT=$(timeout "$TIMEOUT_PER_SUITE" "$SX" < "$TMPFILE" 2>&1 || true)
      rm -f "$TMPFILE"
      result=$(printf '%s\n' "$OUTPUT" | grep -E '^\(gc-result ' | tail -1 || true)
      if [ -n "$result" ] && parse_result_line "$result"; then
        :
      else
        # Suite hung or crashed before emitting a result. Record 0/1 so it
        # shows up as a failure rather than vanishing.
        GC_NAMES+=("$name")
        GC_PASS+=(0)
        GC_FAIL+=(1)
        GC_TOTAL_S+=(1)
      fi
    done
    ;;
  *)
    echo "Unknown MODE=$MODE in $CONF (expected dict|counters)" >&2
    exit 2
    ;;
 esac
 GC_TOTAL_PASS=0
 GC_TOTAL_FAIL=0
 GC_TOTAL=0
 for ((i=0; i<${#GC_NAMES[@]}; i++)); do
  GC_TOTAL_PASS=$((GC_TOTAL_PASS + GC_PASS[i]))
  GC_TOTAL_FAIL=$((GC_TOTAL_FAIL + GC_FAIL[i]))
  GC_TOTAL=$((GC_TOTAL + GC_TOTAL_S[i]))
 done
 mkdir -p "$SCOREBOARD_DIR"
 emit_scoreboard_json > "$SCOREBOARD_DIR/scoreboard.json"
 emit_scoreboard_md > "$SCOREBOARD_DIR/scoreboard.md"
 if [ "$GC_TOTAL_FAIL" -gt 0 ]; then
  echo "$GC_TOTAL_FAIL failure(s) across $GC_TOTAL tests" >&2
  exit 1
 fi
 echo "All $GC_TOTAL tests pass."
--- a/lib/guest/conformance.sx
+++ b/lib/guest/conformance.sx
@@ -1,40 +0,0 @@
 ;; lib/guest/conformance.sx — shared helpers for the guest conformance driver.
 ;;
 ;; The bash driver lib/guest/conformance.sh loads this file and then for each
 ;; suite emits an (eval "...") form whose result is a tagged list:
 ;;
 ;;     (gc-result NAME PASSED FAILED TOTAL)
 ;;
 ;; The driver greps these from sx_server's output and aggregates them.
 ;;
 ;; Two suite shapes are supported:
 ;;
 ;;   :dict     — runner expression returns a dict with :passed/:failed/:total.
 ;;               (gc-dict-result "parse" (pl-parse-tests-run!))
 ;;
 ;;   :counters — runner has no return value, mutates pass/fail global counters.
 ;;               (gc-counters-result NAME P0 F0 PASS FAIL)
 ;;               where P0/F0 are the counters captured BEFORE the suite ran
 ;;               and PASS/FAIL are the counters AFTER.
 (define
  gc-dict-result
  (fn
    (name r)
    (list
      (quote gc-result)
      name
      (get r :passed)
      (get r :failed)
      (get r :total))))
 (define
  gc-counters-result
  (fn
    (name p0 f0 p1 f1)
    (list
      (quote gc-result)
      name
      (- p1 p0)
      (- f1 f0)
      (- (+ p1 f1) (+ p0 f0)))))
--- a/lib/guest/lex.sx
+++ b/lib/guest/lex.sx
@@ -1,67 +0,0 @@
 ;; lib/guest/lex.sx — character-class predicates and token primitives shared
 ;; across guest tokenisers.
 ;;
 ;; All predicates are nil-safe — they accept nil (end-of-input) and return
 ;; false. This matches the convention used by the existing per-language
 ;; tokenisers (cur returns nil at EOF).
 ;;
 ;; Char classes
 ;; ------------
 ;;   lex-digit?       — 0-9
 ;;   lex-hex-digit?   — 0-9, a-f, A-F
 ;;   lex-alpha?       — a-z, A-Z (alias: lex-letter?)
 ;;   lex-alnum?       — alpha or digit
 ;;   lex-ident-start? — alpha or underscore
 ;;   lex-ident-char?  — ident-start or digit
 ;;   lex-space?       — " ", "\t", "\r"           (no newline)
 ;;   lex-whitespace?  — " ", "\t", "\r", "\n"     (includes newline)
 ;;
 ;; Token record
 ;; ------------
 ;;   (lex-make-token TYPE VALUE POS)        — {:type :value :pos}
 ;;   (lex-make-token-spanning TYPE VALUE POS END)
 ;;                                          — {:type :value :pos :end}
 ;;   (lex-token-type TOK)
 ;;   (lex-token-value TOK)
 ;;   (lex-token-pos TOK)
 (define lex-digit? (fn (c) (and (not (= c nil)) (>= c "0") (<= c "9"))))
 (define
  lex-hex-digit?
  (fn
    (c)
    (and
      (not (= c nil))
      (or
        (lex-digit? c)
        (and (>= c "a") (<= c "f"))
        (and (>= c "A") (<= c "F"))))))
 (define
  lex-alpha?
  (fn
    (c)
    (and
      (not (= c nil))
      (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z"))))))
 (define lex-letter? lex-alpha?)
 (define lex-alnum? (fn (c) (or (lex-alpha? c) (lex-digit? c))))
 (define lex-ident-start? (fn (c) (or (lex-alpha? c) (= c "_"))))
 (define lex-ident-char? (fn (c) (or (lex-ident-start? c) (lex-digit? c))))
 (define lex-space? (fn (c) (or (= c " ") (= c "\t") (= c "\r"))))
 (define lex-whitespace? (fn (c) (or (lex-space? c) (= c "\n"))))
 (define lex-make-token (fn (type value pos) {:pos pos :value value :type type}))
 (define lex-make-token-spanning (fn (type value pos end) {:pos pos :end end :value value :type type}))
 (define lex-token-type (fn (tok) (get tok :type)))
 (define lex-token-value (fn (tok) (get tok :value)))
 (define lex-token-pos (fn (tok) (get tok :pos)))
--- a/lib/guest/prefix.sx
+++ b/lib/guest/prefix.sx
@@ -1,46 +0,0 @@
 ;; lib/guest/prefix.sx — prefix-rename macro.
 ;;
 ;; A guest runtime often re-exports a stretch of host primitives under a
 ;; language-specific prefix. The prefix-rename macro replaces the repeated
 ;; (define lang-foo foo) boilerplate with a single declarative call.
 ;;
 ;; Two entry shapes are supported:
 ;;
 ;;   (prefix-rename "cl-" '(gcd lcm expt floor truncate))
 ;;     ;; expands to (begin (define cl-gcd gcd)
 ;;     ;;                   (define cl-lcm lcm) ...)
 ;;
 ;;   (prefix-rename "cl-"
 ;;     '((mod modulo)
 ;;       (arrayp? vector?)
 ;;       (ceiling ceil)))
 ;;     ;; expands to (begin (define cl-mod modulo)
 ;;     ;;                   (define cl-arrayp? vector?)
 ;;     ;;                   (define cl-ceiling ceil))
 ;;
 ;; Mixed lists are supported — bare symbols are same-name aliases, two-element
 ;; lists are (alias target) pairs.
 (defmacro
  prefix-rename
  (prefix entries-q)
  (let
    ((entries (nth entries-q 1)))
    (cons
      (quote begin)
      (map
        (fn
          (entry)
          (cond
            ((= (type-of entry) "symbol")
              (list
                (quote define)
                (make-symbol (str prefix (symbol-name entry)))
                entry))
            ((and (list? entry) (= (len entry) 2))
              (list
                (quote define)
                (make-symbol (str prefix (symbol-name (first entry))))
                (nth entry 1)))
            (:else (error (str "prefix-rename: invalid entry " entry)))))
        entries))))
--- a/lib/haskell/conformance.conf
+++ b/lib/haskell/conformance.conf
@@ -1,76 +0,0 @@
 # Haskell-on-SX conformance config — sourced by lib/guest/conformance.sh.
 LANG_NAME=haskell
 MODE=counters
 COUNTERS_PASS=hk-test-pass
 COUNTERS_FAIL=hk-test-fail
 TIMEOUT_PER_SUITE=120
 PRELOADS=(
  lib/haskell/tokenizer.sx
  lib/haskell/layout.sx
  lib/haskell/parser.sx
  lib/haskell/desugar.sx
  lib/haskell/runtime.sx
  lib/haskell/match.sx
  lib/haskell/eval.sx
  lib/haskell/testlib.sx
 )
 SUITES=(
  "fib:lib/haskell/tests/program-fib.sx"
  "sieve:lib/haskell/tests/program-sieve.sx"
  "quicksort:lib/haskell/tests/program-quicksort.sx"
  "nqueens:lib/haskell/tests/program-nqueens.sx"
  "calculator:lib/haskell/tests/program-calculator.sx"
  "collatz:lib/haskell/tests/program-collatz.sx"
  "palindrome:lib/haskell/tests/program-palindrome.sx"
  "maybe:lib/haskell/tests/program-maybe.sx"
  "fizzbuzz:lib/haskell/tests/program-fizzbuzz.sx"
  "anagram:lib/haskell/tests/program-anagram.sx"
  "roman:lib/haskell/tests/program-roman.sx"
  "binary:lib/haskell/tests/program-binary.sx"
  "either:lib/haskell/tests/program-either.sx"
  "primes:lib/haskell/tests/program-primes.sx"
  "zipwith:lib/haskell/tests/program-zipwith.sx"
  "matrix:lib/haskell/tests/program-matrix.sx"
  "wordcount:lib/haskell/tests/program-wordcount.sx"
  "powers:lib/haskell/tests/program-powers.sx"
 )
 emit_scoreboard_json() {
  local n=${#GC_NAMES[@]} i sep date_only
  date_only=$(date '+%Y-%m-%d')
  printf '{\n'
  printf '  "date": "%s",\n' "$date_only"
  printf '  "total_pass": %d,\n' "$GC_TOTAL_PASS"
  printf '  "total_fail": %d,\n' "$GC_TOTAL_FAIL"
  printf '  "programs": {\n'
  for ((i=0; i<n; i++)); do
    sep=","; [ $i -eq $((n-1)) ] && sep=""
    printf '    "%s": {"pass": %d, "fail": %d}%s\n' \
      "${GC_NAMES[$i]}" "${GC_PASS[$i]}" "${GC_FAIL[$i]}" "$sep"
  done
  printf '  }\n'
  printf '}\n'
 }
 emit_scoreboard_md() {
  local n=${#GC_NAMES[@]}
  local i status p f t prog_pass=0 prog_total=$n date_only
  date_only=$(date '+%Y-%m-%d')
  for ((i=0; i<n; i++)); do
    [ "${GC_FAIL[$i]}" -eq 0 ] && prog_pass=$((prog_pass + 1))
  done
  printf '# Haskell-on-SX Scoreboard\n\n'
  printf 'Updated %s · Phase 6 (prelude extras + 18 programs)\n\n' "$date_only"
  printf '| Program | Tests | Status |\n'
  printf '|---------|-------|--------|\n'
  for ((i=0; i<n; i++)); do
    p=${GC_PASS[$i]}; f=${GC_FAIL[$i]}; t=${GC_TOTAL_S[$i]}
    [ "$f" -eq 0 ] && status="✓" || status="✗"
    printf '| %s.hs | %d/%d | %s |\n' "${GC_NAMES[$i]}" "$p" "$t" "$status"
  done
  printf '| **Total** | **%d/%d** | **%d/%d programs** |\n' \
    "$GC_TOTAL_PASS" "$GC_TOTAL" "$prog_pass" "$prog_total"
 }
--- a/lib/haskell/conformance.sh
+++ b/lib/haskell/conformance.sh
@@ -1,3 +0,0 @@
 #!/usr/bin/env bash
 # Thin wrapper — see lib/guest/conformance.sh and lib/haskell/conformance.conf.
 exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@"
--- a/lib/haskell/desugar.sx
+++ b/lib/haskell/desugar.sx
@@ -1,249 +0,0 @@
 ;; Desugar the Haskell surface AST into a smaller core AST.
 ;;
 ;; Eliminates the three surface-only shapes produced by the parser:
 ;;   :where BODY DECLS     →  :let DECLS BODY
 ;;   :guarded GUARDS       →  :if C1 E1 (:if C2 E2 … (:app error …))
 ;;   :list-comp EXPR QUALS →  concatMap-based expression (§3.11)
 ;;
 ;; Everything else (:app, :op, :lambda, :let, :case, :do, :tuple,
 ;; :list, :range, :if, :neg, :sect-left / :sect-right, plus all
 ;; leaf forms and pattern / type nodes) is passed through after
 ;; recursing into children.
 (define
  hk-guards-to-if
  (fn
    (guards)
    (cond
      ((empty? guards)
        (list
          :app
          (list :var "error")
          (list :string "Non-exhaustive guards")))
      (:else
        (let
          ((g (first guards)))
          (list
            :if
            (hk-desugar (nth g 1))
            (hk-desugar (nth g 2))
            (hk-guards-to-if (rest guards))))))))
 ;; do-notation desugaring (Haskell 98 §3.14):
 ;;   do { e }              =  e
 ;;   do { e ; ss }         =  e >> do { ss }
 ;;   do { p <- e ; ss }    =  e >>= \p -> do { ss }
 ;;   do { let decls ; ss } =  let decls in do { ss }
 (define
  hk-desugar-do
  (fn
    (stmts)
    (cond
      ((empty? stmts) (raise "empty do block"))
      ((empty? (rest stmts))
        (let ((s (first stmts)))
          (cond
            ((= (first s) "do-expr") (hk-desugar (nth s 1)))
            (:else
              (raise "do block must end with an expression")))))
      (:else
        (let
          ((s (first stmts)) (rest-stmts (rest stmts)))
          (let
            ((rest-do (hk-desugar-do rest-stmts)))
            (cond
              ((= (first s) "do-expr")
                (list
                  :app
                  (list
                    :app
                    (list :var ">>")
                    (hk-desugar (nth s 1)))
                  rest-do))
              ((= (first s) "do-bind")
                (list
                  :app
                  (list
                    :app
                    (list :var ">>=")
                    (hk-desugar (nth s 2)))
                  (list :lambda (list (nth s 1)) rest-do)))
              ((= (first s) "do-let")
                (list
                  :let
                  (map hk-desugar (nth s 1))
                  rest-do))
              (:else (raise "unknown do-stmt tag")))))))))
 ;; List-comprehension desugaring (Haskell 98 §3.11):
 ;;   [e |             ]  =  [e]
 ;;   [e | b,     Q    ]  =  if b then [e | Q] else []
 ;;   [e | p <- l, Q    ]  =  concatMap (\p -> [e | Q]) l
 ;;   [e | let ds, Q    ]  =  let ds in [e | Q]
 (define
  hk-lc-desugar
  (fn
    (e quals)
    (cond
      ((empty? quals) (list :list (list e)))
      (:else
        (let
          ((q (first quals)))
          (let
            ((qtag (first q)))
            (cond
              ((= qtag "q-guard")
                (list
                  :if
                  (hk-desugar (nth q 1))
                  (hk-lc-desugar e (rest quals))
                  (list :list (list))))
              ((= qtag "q-gen")
                (list
                  :app
                  (list
                    :app
                    (list :var "concatMap")
                    (list
                      :lambda
                      (list (nth q 1))
                      (hk-lc-desugar e (rest quals))))
                  (hk-desugar (nth q 2))))
              ((= qtag "q-let")
                (list
                  :let
                  (map hk-desugar (nth q 1))
                  (hk-lc-desugar e (rest quals))))
              (:else
                (raise
                  (str
                    "hk-lc-desugar: unknown qualifier tag "
                    qtag))))))))))
 (define
  hk-desugar
  (fn
    (node)
    (cond
      ((not (list? node)) node)
      ((empty? node) node)
      (:else
        (let
          ((tag (first node)))
          (cond
            ;; Transformations
            ((= tag "where")
              (list
                :let
                (map hk-desugar (nth node 2))
                (hk-desugar (nth node 1))))
            ((= tag "guarded") (hk-guards-to-if (nth node 1)))
            ((= tag "list-comp")
              (hk-lc-desugar
                (hk-desugar (nth node 1))
                (nth node 2)))
            ;; Expression nodes
            ((= tag "app")
              (list
                :app
                (hk-desugar (nth node 1))
                (hk-desugar (nth node 2))))
            ((= tag "op")
              (list
                :op
                (nth node 1)
                (hk-desugar (nth node 2))
                (hk-desugar (nth node 3))))
            ((= tag "neg") (list :neg (hk-desugar (nth node 1))))
            ((= tag "if")
              (list
                :if
                (hk-desugar (nth node 1))
                (hk-desugar (nth node 2))
                (hk-desugar (nth node 3))))
            ((= tag "tuple")
              (list :tuple (map hk-desugar (nth node 1))))
            ((= tag "list")
              (list :list (map hk-desugar (nth node 1))))
            ((= tag "range")
              (list
                :range
                (hk-desugar (nth node 1))
                (hk-desugar (nth node 2))))
            ((= tag "range-step")
              (list
                :range-step
                (hk-desugar (nth node 1))
                (hk-desugar (nth node 2))
                (hk-desugar (nth node 3))))
            ((= tag "lambda")
              (list
                :lambda
                (nth node 1)
                (hk-desugar (nth node 2))))
            ((= tag "let")
              (list
                :let
                (map hk-desugar (nth node 1))
                (hk-desugar (nth node 2))))
            ((= tag "case")
              (list
                :case
                (hk-desugar (nth node 1))
                (map hk-desugar (nth node 2))))
            ((= tag "alt")
              (list :alt (nth node 1) (hk-desugar (nth node 2))))
            ((= tag "do") (hk-desugar-do (nth node 1)))
            ((= tag "sect-left")
              (list
                :sect-left
                (nth node 1)
                (hk-desugar (nth node 2))))
            ((= tag "sect-right")
              (list
                :sect-right
                (nth node 1)
                (hk-desugar (nth node 2))))
            ;; Top-level
            ((= tag "program")
              (list :program (map hk-desugar (nth node 1))))
            ((= tag "module")
              (list
                :module
                (nth node 1)
                (nth node 2)
                (nth node 3)
                (map hk-desugar (nth node 4))))
            ;; Decls carrying a body
            ((= tag "fun-clause")
              (list
                :fun-clause
                (nth node 1)
                (nth node 2)
                (hk-desugar (nth node 3))))
            ((= tag "pat-bind")
              (list
                :pat-bind
                (nth node 1)
                (hk-desugar (nth node 2))))
            ((= tag "bind")
              (list
                :bind
                (nth node 1)
                (hk-desugar (nth node 2))))
            ;; Everything else: leaf literals, vars, cons, patterns,
            ;; types, imports, type-sigs, data / newtype / fixity, …
            (:else node)))))))
 ;; Convenience — tokenize + layout + parse + desugar.
 (define
  hk-core
  (fn (src) (hk-desugar (hk-parse-top src))))
 (define
  hk-core-expr
  (fn (src) (hk-desugar (hk-parse src))))
--- a/lib/haskell/eval.sx
+++ b/lib/haskell/eval.sx
--- a/lib/haskell/infer.sx
+++ b/lib/haskell/infer.sx
@@ -1,658 +0,0 @@
 ;; infer.sx — Hindley-Milner Algorithm W for Haskell-on-SX (Phase 4).
 ;;
 ;; Types: TVar, TCon, TArr, TApp, TTuple, TScheme
 ;; Substitution: apply, compose, restrict
 ;; Unification (with occurs check)
 ;; Instantiation + generalization (let-polymorphism)
 ;; Algorithm W for: literals, var, con, lambda, app, let, if, op, tuple, list
 ;; ─── Type constructors ────────────────────────────────────────────────────────
 (define hk-tvar (fn (n) (list "TVar" n)))
 (define hk-tcon (fn (s) (list "TCon" s)))
 (define hk-tarr (fn (a b) (list "TArr" a b)))
 (define hk-tapp (fn (a b) (list "TApp" a b)))
 (define hk-ttuple (fn (ts) (list "TTuple" ts)))
 (define hk-tscheme (fn (vs t) (list "TScheme" vs t)))
 (define hk-tvar? (fn (t) (and (list? t) (not (empty? t)) (= (first t) "TVar"))))
 (define hk-tcon? (fn (t) (and (list? t) (not (empty? t)) (= (first t) "TCon"))))
 (define hk-tarr? (fn (t) (and (list? t) (not (empty? t)) (= (first t) "TArr"))))
 (define hk-tapp? (fn (t) (and (list? t) (not (empty? t)) (= (first t) "TApp"))))
 (define hk-ttuple? (fn (t) (and (list? t) (not (empty? t)) (= (first t) "TTuple"))))
 (define hk-tscheme? (fn (t) (and (list? t) (not (empty? t)) (= (first t) "TScheme"))))
 (define hk-tvar-name (fn (t) (nth t 1)))
 (define hk-tcon-name (fn (t) (nth t 1)))
 (define hk-tarr-t1 (fn (t) (nth t 1)))
 (define hk-tarr-t2 (fn (t) (nth t 2)))
 (define hk-tapp-t1 (fn (t) (nth t 1)))
 (define hk-tapp-t2 (fn (t) (nth t 2)))
 (define hk-ttuple-ts (fn (t) (nth t 1)))
 (define hk-tscheme-vs (fn (t) (nth t 1)))
 (define hk-tscheme-type (fn (t) (nth t 2)))
 (define hk-t-int    (hk-tcon "Int"))
 (define hk-t-bool   (hk-tcon "Bool"))
 (define hk-t-string (hk-tcon "String"))
 (define hk-t-char   (hk-tcon "Char"))
 (define hk-t-float  (hk-tcon "Float"))
 (define hk-t-list (fn (t) (hk-tapp (hk-tcon "[]") t)))
 ;; ─── Type formatter ──────────────────────────────────────────────────────────
 (define
  hk-type->str
  (fn
    (t)
    (cond
      ((hk-tvar? t)   (hk-tvar-name t))
      ((hk-tcon? t)   (hk-tcon-name t))
      ((hk-tarr? t)
       (let ((s1 (if (hk-tarr? (hk-tarr-t1 t))
                   (str "(" (hk-type->str (hk-tarr-t1 t)) ")")
                   (hk-type->str (hk-tarr-t1 t)))))
         (str s1 " -> " (hk-type->str (hk-tarr-t2 t)))))
      ((hk-tapp? t)
       (let ((h (hk-tapp-t1 t)))
         (cond
           ((and (hk-tcon? h) (= (hk-tcon-name h) "[]"))
            (str "[" (hk-type->str (hk-tapp-t2 t)) "]"))
           (:else
            (str "(" (hk-type->str h) " " (hk-type->str (hk-tapp-t2 t)) ")")))))
      ((hk-ttuple? t)
       (str "(" (join ", " (map hk-type->str (hk-ttuple-ts t))) ")"))
      ((hk-tscheme? t)
       (str "forall " (join " " (hk-tscheme-vs t)) ". " (hk-type->str (hk-tscheme-type t))))
      (:else "<?>"))))
 ;; ─── Fresh variable counter ───────────────────────────────────────────────────
 (define hk-fresh-ctr 0)
 (define hk-fresh (fn () (set! hk-fresh-ctr (+ hk-fresh-ctr 1)) (hk-tvar (str "t" hk-fresh-ctr))))
 (define hk-reset-fresh (fn () (set! hk-fresh-ctr 0)))
 ;; ─── Utilities ───────────────────────────────────────────────────────────────
 (define hk-infer-member? (fn (x lst) (some (fn (y) (= x y)) lst)))
 (define
  hk-nub
  (fn (lst)
    (reduce (fn (acc x) (if (hk-infer-member? x acc) acc (append acc (list x)))) (list) lst)))
 ;; ─── Free type variables ──────────────────────────────────────────────────────
 (define
  hk-ftv
  (fn
    (t)
    (cond
      ((hk-tvar? t)    (list (hk-tvar-name t)))
      ((hk-tcon? t)    (list))
      ((hk-tarr? t)    (append (hk-ftv (hk-tarr-t1 t)) (hk-ftv (hk-tarr-t2 t))))
      ((hk-tapp? t)    (append (hk-ftv (hk-tapp-t1 t)) (hk-ftv (hk-tapp-t2 t))))
      ((hk-ttuple? t)  (reduce append (list) (map hk-ftv (hk-ttuple-ts t))))
      ((hk-tscheme? t)
       (filter
         (fn (v) (not (hk-infer-member? v (hk-tscheme-vs t))))
         (hk-ftv (hk-tscheme-type t))))
      (:else (list)))))
 (define
  hk-ftv-env
  (fn (env)
    (reduce (fn (acc k) (append acc (hk-ftv (get env k)))) (list) (keys env))))
 ;; ─── Substitution ─────────────────────────────────────────────────────────────
 (define hk-subst-empty (dict))
 (define
  hk-subst-restrict
  (fn
    (s exclude)
    (let ((r (dict)))
      (for-each
        (fn (k)
          (when (not (hk-infer-member? k exclude))
            (dict-set! r k (get s k))))
        (keys s))
      r)))
 (define
  hk-subst-apply
  (fn
    (s t)
    (cond
      ((hk-tvar? t)
       (let ((v (get s (hk-tvar-name t))))
         (if (nil? v) t (hk-subst-apply s v))))
      ((hk-tarr? t)
       (hk-tarr (hk-subst-apply s (hk-tarr-t1 t))
                (hk-subst-apply s (hk-tarr-t2 t))))
      ((hk-tapp? t)
       (hk-tapp (hk-subst-apply s (hk-tapp-t1 t))
                (hk-subst-apply s (hk-tapp-t2 t))))
      ((hk-ttuple? t)
       (hk-ttuple (map (fn (u) (hk-subst-apply s u)) (hk-ttuple-ts t))))
      ((hk-tscheme? t)
       (let ((s2 (hk-subst-restrict s (hk-tscheme-vs t))))
         (hk-tscheme (hk-tscheme-vs t)
                     (hk-subst-apply s2 (hk-tscheme-type t)))))
      (:else t))))
 (define
  hk-subst-compose
  (fn
    (s2 s1)
    (let ((r (hk-dict-copy s2)))
      (for-each
        (fn (k)
          (when (nil? (get r k))
            (dict-set! r k (hk-subst-apply s2 (get s1 k)))))
        (keys s1))
      r)))
 (define
  hk-env-apply-subst
  (fn
    (s env)
    (let ((r (dict)))
      (for-each (fn (k) (dict-set! r k (hk-subst-apply s (get env k)))) (keys env))
      r)))
 ;; ─── Unification ─────────────────────────────────────────────────────────────
 (define
  hk-bind-var
  (fn
    (v t)
    (cond
      ((and (hk-tvar? t) (= (hk-tvar-name t) v))
       hk-subst-empty)
      ((hk-infer-member? v (hk-ftv t))
       (raise (str "Occurs check failed: " v " in " (hk-type->str t))))
      (:else
       (let ((s (dict)))
         (dict-set! s v t)
         s)))))
 (define
  hk-zip-unify
  (fn
    (ts1 ts2 acc)
    (if (or (empty? ts1) (empty? ts2))
      acc
      (let ((s (hk-unify (hk-subst-apply acc (first ts1))
                         (hk-subst-apply acc (first ts2)))))
        (hk-zip-unify (rest ts1) (rest ts2) (hk-subst-compose s acc))))))
 (define
  hk-unify
  (fn
    (t1 t2)
    (cond
      ((and (hk-tvar? t1) (hk-tvar? t2) (= (hk-tvar-name t1) (hk-tvar-name t2)))
       hk-subst-empty)
      ((hk-tvar? t1) (hk-bind-var (hk-tvar-name t1) t2))
      ((hk-tvar? t2) (hk-bind-var (hk-tvar-name t2) t1))
      ((and (hk-tcon? t1) (hk-tcon? t2) (= (hk-tcon-name t1) (hk-tcon-name t2)))
       hk-subst-empty)
      ((and (hk-tarr? t1) (hk-tarr? t2))
       (let ((s1 (hk-unify (hk-tarr-t1 t1) (hk-tarr-t1 t2))))
         (let ((s2 (hk-unify (hk-subst-apply s1 (hk-tarr-t2 t1))
                             (hk-subst-apply s1 (hk-tarr-t2 t2)))))
           (hk-subst-compose s2 s1))))
      ((and (hk-tapp? t1) (hk-tapp? t2))
       (let ((s1 (hk-unify (hk-tapp-t1 t1) (hk-tapp-t1 t2))))
         (let ((s2 (hk-unify (hk-subst-apply s1 (hk-tapp-t2 t1))
                             (hk-subst-apply s1 (hk-tapp-t2 t2)))))
           (hk-subst-compose s2 s1))))
      ((and (hk-ttuple? t1) (hk-ttuple? t2)
            (= (length (hk-ttuple-ts t1)) (length (hk-ttuple-ts t2))))
       (hk-zip-unify (hk-ttuple-ts t1) (hk-ttuple-ts t2) hk-subst-empty))
      (:else
       (raise (str "Cannot unify " (hk-type->str t1) " with " (hk-type->str t2)))))))
 ;; ─── Instantiation and generalization ────────────────────────────────────────
 (define
  hk-instantiate
  (fn
    (t)
    (if (not (hk-tscheme? t))
      t
      (let ((s (dict)))
        (for-each (fn (v) (dict-set! s v (hk-fresh))) (hk-tscheme-vs t))
        (hk-subst-apply s (hk-tscheme-type t))))))
 (define
  hk-generalize
  (fn
    (env t)
    (let ((free-t   (hk-nub (hk-ftv t)))
          (free-env (hk-nub (hk-ftv-env env))))
      (let ((bound (filter (fn (v) (not (hk-infer-member? v free-env))) free-t)))
        (if (empty? bound)
          t
          (hk-tscheme bound t))))))
 ;; ─── Pattern binding extraction ──────────────────────────────────────────────
 ;; Returns a dict of name → type bindings introduced by matching pat against tv.
 (define
  hk-w-pat
  (fn
    (pat tv)
    (let ((tag (first pat)))
      (cond
        ((= tag "p-var")  (let ((d (dict))) (dict-set! d (nth pat 1) tv) d))
        ((= tag "p-wild") (dict))
        (:else            (dict))))))
 ;; ─── Algorithm W ─────────────────────────────────────────────────────────────
 ;; hk-w : env × expr → (list subst type)
 (define
  hk-w-let
  (fn
    (env binds body)
    ;; Infer types for each binding in order, generalising at each step.
    (let
      ((env2
        (reduce
          (fn
            (cur-env b)
            (let ((tag (first b)))
              (cond
                ;; Simple pattern binding: let x = expr
                ((or (= tag "bind") (= tag "pat-bind"))
                 (let ((pat  (nth b 1))
                       (rhs  (nth b 2)))
                   (let ((tv (hk-fresh)))
                     (let ((r (hk-w cur-env rhs)))
                       (let ((s1 (first r)) (t1 (nth r 1)))
                         (let ((s2 (hk-unify (hk-subst-apply s1 tv) t1)))
                           (let ((s (hk-subst-compose s2 s1)))
                             (let ((t-gen (hk-generalize (hk-env-apply-subst s cur-env)
                                                         (hk-subst-apply s t1))))
                               (let ((bindings (hk-w-pat pat t-gen)))
                                 (let ((r2 (hk-dict-copy cur-env)))
                                   (for-each
                                     (fn (k) (dict-set! r2 k (get bindings k)))
                                     (keys bindings))
                                   r2))))))))))
                ;; Function clause: let f x y = expr
                ((= tag "fun-clause")
                 (let ((name (nth b 1))
                       (pats (nth b 2))
                       (body2 (nth b 3)))
                   ;; Treat as: let name = lambda pats body2
                   (let ((rhs (if (empty? pats)
                                body2
                                (list "lambda" pats body2))))
                     (let ((tv (hk-fresh)))
                       (let ((env-rec (hk-dict-copy cur-env)))
                         (dict-set! env-rec name tv)
                         (let ((r (hk-w env-rec rhs)))
                           (let ((s1 (first r)) (t1 (nth r 1)))
                             (let ((s2 (hk-unify (hk-subst-apply s1 tv) t1)))
                               (let ((s (hk-subst-compose s2 s1)))
                                 (let ((t-gen (hk-generalize
                                                (hk-env-apply-subst s cur-env)
                                                (hk-subst-apply s t1))))
                                   (let ((r2 (hk-dict-copy cur-env)))
                                     (dict-set! r2 name t-gen)
                                     r2)))))))))))
                (:else cur-env))))
          env
          binds)))
      (hk-w env2 body))))
 (define
  hk-w
  (fn
    (env expr)
    (let ((tag (first expr)))
      (cond
        ;; Literals
        ((= tag "int")    (list hk-subst-empty hk-t-int))
        ((= tag "float")  (list hk-subst-empty hk-t-float))
        ((= tag "string") (list hk-subst-empty hk-t-string))
        ((= tag "char")   (list hk-subst-empty hk-t-char))
        ;; Variable
        ((= tag "var")
         (let ((name (nth expr 1)))
           (let ((scheme (get env name)))
             (if (nil? scheme)
               (raise (str "Unbound variable: " name))
               (list hk-subst-empty (hk-instantiate scheme))))))
        ;; Constructor (same lookup as var)
        ((= tag "con")
         (let ((name (nth expr 1)))
           (let ((scheme (get env name)))
             (if (nil? scheme)
               (list hk-subst-empty (hk-fresh))
               (list hk-subst-empty (hk-instantiate scheme))))))
        ;; Unary negation
        ((= tag "neg")
         (let ((r (hk-w env (nth expr 1))))
           (let ((s1 (first r)) (t1 (nth r 1)))
             (let ((s2 (hk-unify t1 hk-t-int)))
               (list (hk-subst-compose s2 s1) hk-t-int)))))
        ;; Lambda: ("lambda" pats body)
        ((= tag "lambda")
         (let ((pats (nth expr 1))
               (body (nth expr 2)))
           (if (empty? pats)
             (hk-w env body)
             (let ((pat  (first pats))
                   (rest (rest pats)))
               (let ((tv (hk-fresh)))
                 (let ((bindings (hk-w-pat pat tv)))
                   (let ((env2 (hk-dict-copy env)))
                     (for-each (fn (k) (dict-set! env2 k (get bindings k))) (keys bindings))
                     (let ((inner (if (empty? rest)
                                    body
                                    (list "lambda" rest body))))
                       (let ((r (hk-w env2 inner)))
                         (let ((s1 (first r)) (t1 (nth r 1)))
                           (list s1 (hk-tarr (hk-subst-apply s1 tv) t1))))))))))))
        ;; Application: ("app" f x)
        ((= tag "app")
         (let ((tv (hk-fresh)))
           (let ((r1 (hk-w env (nth expr 1))))
             (let ((s1 (first r1)) (tf (nth r1 1)))
               (let ((r2 (hk-w (hk-env-apply-subst s1 env) (nth expr 2))))
                 (let ((s2 (first r2)) (tx (nth r2 1)))
                   (let ((s3 (hk-unify (hk-subst-apply s2 tf) (hk-tarr tx tv))))
                     (let ((s (hk-subst-compose s3 (hk-subst-compose s2 s1))))
                       (list s (hk-subst-apply s3 tv))))))))))
        ;; Let: ("let" binds body)
        ((= tag "let")
         (hk-w-let env (nth expr 1) (nth expr 2)))
        ;; If: ("if" cond then else)
        ((= tag "if")
         (let ((r1 (hk-w env (nth expr 1))))
           (let ((s1 (first r1)) (tc (nth r1 1)))
             (let ((s2 (hk-unify tc hk-t-bool)))
               (let ((s12 (hk-subst-compose s2 s1)))
                 (let ((r2 (hk-w (hk-env-apply-subst s12 env) (nth expr 2))))
                   (let ((s3 (first r2)) (tt (nth r2 1)))
                     (let ((s123 (hk-subst-compose s3 s12)))
                       (let ((r3 (hk-w (hk-env-apply-subst s123 env) (nth expr 3))))
                         (let ((s4 (first r3)) (te (nth r3 1)))
                           (let ((s5 (hk-unify (hk-subst-apply s4 tt) te)))
                             (let ((s (hk-subst-compose s5 (hk-subst-compose s4 s123))))
                               (list s (hk-subst-apply s5 te))))))))))))))
        ;; Binary operator: ("op" op-name left right)
        ;; Desugar to double application.
        ((= tag "op")
         (hk-w env
               (list "app"
                     (list "app" (list "var" (nth expr 1)) (nth expr 2))
                     (nth expr 3))))
        ;; Tuple: ("tuple" [e1 e2 ...])
        ((= tag "tuple")
         (let ((elems (nth expr 1)))
           (let ((s-acc hk-subst-empty)
                 (ts    (list)))
             (for-each
               (fn (e)
                 (let ((r (hk-w (hk-env-apply-subst s-acc env) e)))
                   (set! s-acc (hk-subst-compose (first r) s-acc))
                   (set! ts    (append ts (list (nth r 1))))))
               elems)
             (list s-acc (hk-ttuple (map (fn (t) (hk-subst-apply s-acc t)) ts))))))
        ;; List literal: ("list" [e1 e2 ...])
        ((= tag "list")
         (let ((elems (nth expr 1)))
           (if (empty? elems)
             (list hk-subst-empty (hk-t-list (hk-fresh)))
             (let ((tv (hk-fresh)))
               (let ((s-acc hk-subst-empty))
                 (for-each
                   (fn (e)
                     (let ((r (hk-w (hk-env-apply-subst s-acc env) e)))
                       (let ((s2 (first r)) (te (nth r 1)))
                         (let ((s3 (hk-unify (hk-subst-apply s2 tv) te)))
                           (set! s-acc (hk-subst-compose s3 (hk-subst-compose s2 s-acc)))))))
                   elems)
                 (list s-acc (hk-t-list (hk-subst-apply s-acc tv))))))))
        ;; Location annotation: just delegate — position is for outer context.
        ((= tag "loc")
         (hk-w env (nth expr 3)))
        (:else
         (raise (str "hk-w: unhandled tag: " tag)))))))
 ;; ─── Initial type environment ─────────────────────────────────────────────────
 ;; Monomorphic numeric ops (no Num typeclass yet — upgraded in Phase 5).
 (define
  hk-type-env0
  (fn ()
    (let ((env (dict)))
      ;; Integer arithmetic
      (for-each
        (fn (op)
          (dict-set! env op (hk-tarr hk-t-int (hk-tarr hk-t-int hk-t-int))))
        (list "+" "-" "*" "div" "mod" "quot" "rem"))
      ;; Integer comparison → Bool
      (for-each
        (fn (op)
          (dict-set! env op (hk-tarr hk-t-int (hk-tarr hk-t-int hk-t-bool))))
        (list "==" "/=" "<" "<=" ">" ">="))
      ;; Boolean operators
      (dict-set! env "&&" (hk-tarr hk-t-bool (hk-tarr hk-t-bool hk-t-bool)))
      (dict-set! env "||" (hk-tarr hk-t-bool (hk-tarr hk-t-bool hk-t-bool)))
      (dict-set! env "not" (hk-tarr hk-t-bool hk-t-bool))
      ;; Constructors
      (dict-set! env "True"  hk-t-bool)
      (dict-set! env "False" hk-t-bool)
      ;; Polymorphic list ops (using TScheme)
      (let ((a (hk-tvar "a")))
        (dict-set! env "head"  (hk-tscheme (list "a") (hk-tarr (hk-t-list a) a)))
        (dict-set! env "tail"  (hk-tscheme (list "a") (hk-tarr (hk-t-list a) (hk-t-list a))))
        (dict-set! env "null"  (hk-tscheme (list "a") (hk-tarr (hk-t-list a) hk-t-bool)))
        (dict-set! env "length" (hk-tscheme (list "a") (hk-tarr (hk-t-list a) hk-t-int)))
        (dict-set! env "reverse" (hk-tscheme (list "a") (hk-tarr (hk-t-list a) (hk-t-list a))))
        (dict-set! env ":"
          (hk-tscheme (list "a") (hk-tarr a (hk-tarr (hk-t-list a) (hk-t-list a))))))
      ;; negate
      (dict-set! env "negate" (hk-tarr hk-t-int hk-t-int))
      (dict-set! env "abs"    (hk-tarr hk-t-int hk-t-int))
      env)))
 ;; ─── Expression brief printer ────────────────────────────────────────────────
 ;; Produces a short human-readable label for an AST node used in error messages.
 (define
  hk-expr->brief
  (fn
    (expr)
    (cond
      ((not (list? expr)) (str expr))
      ((empty? expr)      "()")
      (:else
       (let ((tag (first expr)))
         (cond
           ((= tag "var")    (nth expr 1))
           ((= tag "con")    (nth expr 1))
           ((= tag "int")    (str (nth expr 1)))
           ((= tag "float")  (str (nth expr 1)))
           ((= tag "string") (str "\"" (nth expr 1) "\""))
           ((= tag "char")   (str "'" (nth expr 1) "'"))
           ((= tag "neg")    (str "(-" (hk-expr->brief (nth expr 1)) ")"))
           ((= tag "app")
            (str "(" (hk-expr->brief (nth expr 1))
                 " " (hk-expr->brief (nth expr 2)) ")"))
           ((= tag "op")
            (str "(" (hk-expr->brief (nth expr 2))
                 " " (nth expr 1)
                 " " (hk-expr->brief (nth expr 3)) ")"))
           ((= tag "lambda") "(\\ ...)")
           ((= tag "let")    "(let ...)")
           ((= tag "if")     "(if ...)")
           ((= tag "tuple")  "(tuple ...)")
           ((= tag "list")   "[...]")
           ((= tag "loc")    (hk-expr->brief (nth expr 3)))
           (:else            (str "(" tag " ..."))))))))
 ;; ─── Loc-annotated inference ──────────────────────────────────────────────────
 ;; ("loc" LINE COL INNER) node: hk-w catches any error and re-raises with
 ;; "at LINE:COL: " prepended.  Emitted by the parser or test scaffolding.
 ;; Extended hk-w handles "loc" — handled inline in the cond below.
 ;; ─── Program-level inference ─────────────────────────────────────────────────
 ;; hk-infer-decl : env × decl → ("ok" name type-str) | ("err" msg) | nil
 ;;   Uses tagged results so callers don't need re-raise.
 (define
  hk-infer-decl
  (fn
    (env decl)
    (let
      ((tag (first decl)))
      (cond
        ((= tag "fun-clause")
          (let
            ((name (nth decl 1)) (pats (nth decl 2)) (body (nth decl 3)))
            (let
              ((rhs (if (empty? pats) body (list "lambda" pats body))))
              (guard
                (e (#t (list "err" (str "in '" name "': " e))))
                (begin
                  (hk-reset-fresh)
                  (let
                    ((r (hk-w env rhs)))
                    (let
                      ((final-type (hk-subst-apply (first r) (nth r 1))))
                      (list "ok" name (hk-type->str final-type) final-type))))))))
        ((or (= tag "bind") (= tag "pat-bind"))
          (let
            ((pat (nth decl 1)) (body (nth decl 2)))
            (let
              ((label (if (and (list? pat) (= (first pat) "p-var")) (nth pat 1) "<binding>")))
              (guard
                (e (#t (list "err" (str "in '" label "': " e))))
                (begin
                  (hk-reset-fresh)
                  (let
                    ((r (hk-w env body)))
                    (let
                      ((final-type (hk-subst-apply (first r) (nth r 1))))
                      (list "ok" label (hk-type->str final-type) final-type))))))))
        (:else nil)))))
 ;; hk-infer-prog : program-ast × env → list of ("ok" name type) | ("err" msg)
 (define
  hk-ast-type
  (fn
    (ast)
    (let
      ((tag (first ast)))
      (cond
        ((= tag "t-con") (list "TCon" (nth ast 1)))
        ((= tag "t-var") (list "TVar" (nth ast 1)))
        ((= tag "t-fun")
          (list "TArr" (hk-ast-type (nth ast 1)) (hk-ast-type (nth ast 2))))
        ((= tag "t-app")
          (list "TApp" (hk-ast-type (nth ast 1)) (hk-ast-type (nth ast 2))))
        ((= tag "t-list")
          (list "TApp" (list "TCon" "[]") (hk-ast-type (nth ast 1))))
        ((= tag "t-tuple") (list "TTuple" (map hk-ast-type (nth ast 1))))
        (:else (raise (str "unknown type node: " (first ast))))))))
 ;; ─── Convenience ─────────────────────────────────────────────────────────────
 ;; hk-infer-type : Haskell expression source → inferred type string
 (define
  hk-collect-tvars
  (fn
    (t acc)
    (cond
      ((= (first t) "TVar")
        (if
          (some (fn (v) (= v (nth t 1))) acc)
          acc
          (begin (append! acc (nth t 1)) acc)))
      ((= (first t) "TArr")
        (hk-collect-tvars (nth t 2) (hk-collect-tvars (nth t 1) acc)))
      ((= (first t) "TApp")
        (hk-collect-tvars (nth t 2) (hk-collect-tvars (nth t 1) acc)))
      ((= (first t) "TTuple")
        (reduce (fn (a elem) (hk-collect-tvars elem a)) acc (nth t 1)))
      (:else acc))))
 (define
  hk-check-sig
  (fn
    (declared-ast inferred-type)
    (let
      ((declared (hk-ast-type declared-ast)))
      (let
        ((tvars (hk-collect-tvars declared (list))))
        (let
          ((scheme (if (empty? tvars) declared (list "TScheme" tvars declared))))
          (let
            ((inst (hk-instantiate scheme)))
            (hk-unify inst inferred-type)))))))
 (define
  hk-infer-prog
  (fn
    (prog env)
    (let
      ((decls (cond ((and (list? prog) (= (first prog) "program")) (nth prog 1)) ((and (list? prog) (= (first prog) "module")) (nth prog 3)) (:else (list))))
        (results (list))
        (sigs (dict)))
      (for-each
        (fn
          (d)
          (when
            (= (first d) "type-sig")
            (let
              ((names (nth d 1)) (type-ast (nth d 2)))
              (for-each (fn (n) (dict-set! sigs n type-ast)) names))))
        decls)
      (for-each
        (fn
          (d)
          (let
            ((r (hk-infer-decl env d)))
            (when
              (not (nil? r))
              (let
                ((checked (if (and (= (first r) "ok") (has-key? sigs (nth r 1))) (guard (e (true (list "err" (str "in '" (nth r 1) "': declared type mismatch: " e)))) (begin (hk-check-sig (get sigs (nth r 1)) (nth r 3)) r)) r)))
                (append! results checked)
                (when
                  (= (first checked) "ok")
                  (dict-set! env (nth checked 1) (nth checked 3)))))))
        decls)
      results)))
 (define
  hk-infer-type
  (fn
    (src)
    (hk-reset-fresh)
    (let
      ((ast (hk-core-expr src)) (env (hk-type-env0)))
      (let
        ((r (hk-w env ast)))
        (hk-type->str (hk-subst-apply (first r) (nth r 1)))))))
--- a/lib/haskell/layout.sx
+++ b/lib/haskell/layout.sx
@@ -1,329 +0,0 @@
 ;; Haskell 98 layout algorithm (§10.3).
 ;;
 ;; Consumes the raw token stream produced by hk-tokenize and inserts
 ;; virtual braces / semicolons (types vlbrace / vrbrace / vsemi) based
 ;; on indentation. Newline tokens are consumed and stripped.
 ;;
 ;;   (hk-layout (hk-tokenize src))  →  tokens-with-virtual-layout
 ;; ── Pre-pass ──────────────────────────────────────────────────────
 ;;
 ;; Walks the raw token list and emits an augmented stream containing
 ;; two fresh pseudo-tokens:
 ;;
 ;;   {:type "layout-open"   :col N :keyword K}
 ;;     At stream start (K = "<module>") unless the first real token is
 ;;     `module` or `{`. Also immediately after every `let` / `where` /
 ;;     `do` / `of` whose following token is NOT `{`. N is the column
 ;;     of the token that follows.
 ;;
 ;;   {:type "layout-indent" :col N}
 ;;     Before any token whose line is strictly greater than the line
 ;;     of the previously emitted real token, EXCEPT when that token
 ;;     is already preceded by a layout-open (Haskell 98 §10.3 note 3).
 ;;
 ;; Raw newline tokens are dropped.
 (define
  hk-layout-keyword?
  (fn
    (tok)
    (and
      (= (get tok "type") "reserved")
      (or
        (= (get tok "value") "let")
        (= (get tok "value") "where")
        (= (get tok "value") "do")
        (= (get tok "value") "of")))))
 (define
  hk-layout-pre
  (fn
    (tokens)
    (let
      ((result (list))
        (n (len tokens))
        (i 0)
        (prev-line -1)
        (first-real-emitted false)
        (suppress-next-indent false))
      (define
        hk-next-real-idx
        (fn
          (start)
          (let
            ((j start))
            (define
              hk-nri-loop
              (fn
                ()
                (when
                  (and
                    (< j n)
                    (= (get (nth tokens j) "type") "newline"))
                  (do (set! j (+ j 1)) (hk-nri-loop)))))
            (hk-nri-loop)
            j)))
      (define
        hk-pre-step
        (fn
          ()
          (when
            (< i n)
            (let
              ((tok (nth tokens i)) (ty (get tok "type")))
              (cond
                ((= ty "newline") (do (set! i (+ i 1)) (hk-pre-step)))
                (:else
                  (do
                    (when
                      (not first-real-emitted)
                      (do
                        (set! first-real-emitted true)
                        (when
                          (not
                            (or
                              (and
                                (= ty "reserved")
                                (= (get tok "value") "module"))
                              (= ty "lbrace")))
                          (do
                            (append!
                              result
                              {:type "layout-open"
                                :col (get tok "col")
                                :keyword "<module>"
                                :line (get tok "line")})
                            (set! suppress-next-indent true)))))
                    (when
                      (and
                        (>= prev-line 0)
                        (> (get tok "line") prev-line)
                        (not suppress-next-indent))
                      (append!
                        result
                        {:type "layout-indent"
                          :col (get tok "col")
                          :line (get tok "line")}))
                    (set! suppress-next-indent false)
                    (set! prev-line (get tok "line"))
                    (append! result tok)
                    (when
                      (hk-layout-keyword? tok)
                      (let
                        ((j (hk-next-real-idx (+ i 1))))
                        (cond
                          ((>= j n)
                            (do
                              (append!
                                result
                                {:type "layout-open"
                                  :col 0
                                  :keyword (get tok "value")
                                  :line (get tok "line")})
                              (set! suppress-next-indent true)))
                          ((= (get (nth tokens j) "type") "lbrace") nil)
                          (:else
                            (do
                              (append!
                                result
                                {:type "layout-open"
                                  :col (get (nth tokens j) "col")
                                  :keyword (get tok "value")
                                  :line (get tok "line")})
                              (set! suppress-next-indent true))))))
                    (set! i (+ i 1))
                    (hk-pre-step))))))))
      (hk-pre-step)
      result)))
 ;; ── Main pass: L algorithm ────────────────────────────────────────
 ;;
 ;; Stack is a list; the head is the top of stack. Each entry is
 ;; either the keyword :explicit (pushed by an explicit `{`) or a dict
 ;; {:col N :keyword K} pushed by a layout-open marker.
 ;;
 ;; Rules (following Haskell 98 §10.3):
 ;;
 ;;   layout-open(n)  vs stack:
 ;;     empty or explicit top                 → push n; emit {
 ;;     n > top-col                           → push n; emit {
 ;;     otherwise                             → emit { }; retry as indent(n)
 ;;
 ;;   layout-indent(n) vs stack:
 ;;     empty or explicit top                 → drop
 ;;     n == top-col                          → emit ;
 ;;     n <  top-col                          → emit }; pop; recurse
 ;;     n >  top-col                          → drop
 ;;
 ;;   lbrace                                  → push :explicit; emit {
 ;;   rbrace                                  → pop if :explicit; emit }
 ;;   `in` with implicit let on top           → emit }; pop; emit in
 ;;   any other token                         → emit
 ;;
 ;; EOF: emit } for every remaining implicit context.
 (define
  hk-layout-L
  (fn
    (pre-toks)
    (let
      ((result (list))
        (stack (list))
        (n (len pre-toks))
        (i 0))
      (define hk-emit (fn (t) (append! result t)))
      (define
        hk-indent-at
        (fn
          (col line)
          (cond
            ((or (empty? stack) (= (first stack) :explicit)) nil)
            (:else
              (let
                ((top-col (get (first stack) "col")))
                (cond
                  ((= col top-col)
                    (hk-emit
                      {:type "vsemi" :value ";" :line line :col col}))
                  ((< col top-col)
                    (do
                      (hk-emit
                        {:type "vrbrace" :value "}" :line line :col col})
                      (set! stack (rest stack))
                      (hk-indent-at col line)))
                  (:else nil)))))))
      (define
        hk-open-at
        (fn
          (col keyword line)
          (cond
            ((and
                (> col 0)
                (or
                  (empty? stack)
                  (= (first stack) :explicit)
                  (> col (get (first stack) "col"))))
              (do
                (hk-emit
                  {:type "vlbrace" :value "{" :line line :col col})
                (set! stack (cons {:col col :keyword keyword} stack))))
            (:else
              (do
                (hk-emit
                  {:type "vlbrace" :value "{" :line line :col col})
                (hk-emit
                  {:type "vrbrace" :value "}" :line line :col col})
                (hk-indent-at col line))))))
      (define
        hk-close-eof
        (fn
          ()
          (when
            (and
              (not (empty? stack))
              (not (= (first stack) :explicit)))
            (do
              (hk-emit {:type "vrbrace" :value "}" :line 0 :col 0})
              (set! stack (rest stack))
              (hk-close-eof)))))
      ;; Peek past further layout-indent / layout-open markers to find
      ;; the next real token's value when its type is `reserved`.
      ;; Returns nil if no such token.
      (define
        hk-peek-next-reserved
        (fn
          (start)
          (let ((j (+ start 1)) (found nil) (done false))
            (define
              hk-pnr-loop
              (fn
                ()
                (when
                  (and (not done) (< j n))
                  (let
                    ((t (nth pre-toks j)) (ty (get t "type")))
                    (cond
                      ((or
                          (= ty "layout-indent")
                          (= ty "layout-open"))
                        (do (set! j (+ j 1)) (hk-pnr-loop)))
                      ((= ty "reserved")
                        (do (set! found (get t "value")) (set! done true)))
                      (:else (set! done true)))))))
            (hk-pnr-loop)
            found)))
      (define
        hk-layout-step
        (fn
          ()
          (when
            (< i n)
            (let
              ((tok (nth pre-toks i)) (ty (get tok "type")))
              (cond
                ((= ty "eof")
                  (do
                    (hk-close-eof)
                    (hk-emit tok)
                    (set! i (+ i 1))
                    (hk-layout-step)))
                ((= ty "layout-open")
                  (do
                    (hk-open-at
                      (get tok "col")
                      (get tok "keyword")
                      (get tok "line"))
                    (set! i (+ i 1))
                    (hk-layout-step)))
                ((= ty "layout-indent")
                  (cond
                    ((= (hk-peek-next-reserved i) "in")
                      (do (set! i (+ i 1)) (hk-layout-step)))
                    (:else
                      (do
                        (hk-indent-at (get tok "col") (get tok "line"))
                        (set! i (+ i 1))
                        (hk-layout-step)))))
                ((= ty "lbrace")
                  (do
                    (set! stack (cons :explicit stack))
                    (hk-emit tok)
                    (set! i (+ i 1))
                    (hk-layout-step)))
                ((= ty "rbrace")
                  (do
                    (when
                      (and
                        (not (empty? stack))
                        (= (first stack) :explicit))
                      (set! stack (rest stack)))
                    (hk-emit tok)
                    (set! i (+ i 1))
                    (hk-layout-step)))
                ((and
                    (= ty "reserved")
                    (= (get tok "value") "in")
                    (not (empty? stack))
                    (not (= (first stack) :explicit))
                    (= (get (first stack) "keyword") "let"))
                  (do
                    (hk-emit
                      {:type "vrbrace"
                        :value "}"
                        :line (get tok "line")
                        :col (get tok "col")})
                    (set! stack (rest stack))
                    (hk-emit tok)
                    (set! i (+ i 1))
                    (hk-layout-step)))
                (:else
                  (do
                    (hk-emit tok)
                    (set! i (+ i 1))
                    (hk-layout-step))))))))
      (hk-layout-step)
      (hk-close-eof)
      result)))
 (define hk-layout (fn (tokens) (hk-layout-L (hk-layout-pre tokens))))
--- a/lib/haskell/match.sx
+++ b/lib/haskell/match.sx
@@ -1,201 +0,0 @@
 ;; Value-level pattern matching.
 ;;
 ;; Constructor values are tagged lists whose first element is the
 ;; constructor name (a string). Tuples use the special tag "Tuple".
 ;; Lists use the spine of `:` cons and `[]` nil.
 ;;
 ;;   Just 5         →  ("Just" 5)
 ;;   Nothing        →  ("Nothing")
 ;;   (1, 2)         →  ("Tuple" 1 2)
 ;;   [1, 2]         →  (":" 1 (":" 2 ("[]")))
 ;;   ()             →  ("()")
 ;;
 ;; Primitive values (numbers, strings, chars) are stored raw.
 ;;
 ;; The matcher takes a pattern AST node, a value, and an environment
 ;; dict; it returns an extended dict on success, or `nil` on failure.
 ;; ── Value builders ──────────────────────────────────────────
 (define
  hk-mk-con
  (fn
    (cname args)
    (let ((result (list cname)))
      (for-each (fn (a) (append! result a)) args)
      result)))
 (define
  hk-mk-tuple
  (fn
    (items)
    (let ((result (list "Tuple")))
      (for-each (fn (x) (append! result x)) items)
      result)))
 (define hk-mk-nil (fn () (list "[]")))
 (define hk-mk-cons (fn (h t) (list ":" h t)))
 (define
  hk-mk-list
  (fn
    (items)
    (cond
      ((empty? items) (hk-mk-nil))
      (:else
        (hk-mk-cons (first items) (hk-mk-list (rest items)))))))
 ;; ── Predicates / accessors on constructor values ───────────
 (define
  hk-is-con-val?
  (fn
    (v)
    (and
      (list? v)
      (not (empty? v))
      (string? (first v)))))
 (define hk-val-con-name (fn (v) (first v)))
 (define hk-val-con-args (fn (v) (rest v)))
 ;; ── The matcher ────────────────────────────────────────────
 ;;
 ;; Pattern match forces the scrutinee to WHNF before inspecting it
 ;; — except for `p-wild`, `p-var`, and `p-lazy`, which never need
 ;; to look at the value. Args of constructor / tuple / list values
 ;; remain thunked (they're forced only when their own pattern needs
 ;; to inspect them, recursively).
 (define
  hk-match
  (fn
    (pat val env)
    (cond
      ((not (list? pat)) nil)
      ((empty? pat) nil)
      (:else
        (let
          ((tag (first pat)))
          (cond
            ((= tag "p-wild") env)
            ((= tag "p-var") (assoc env (nth pat 1) val))
            ((= tag "p-lazy") (hk-match (nth pat 1) val env))
            ((= tag "p-as")
              (let
                ((res (hk-match (nth pat 2) val env)))
                (cond
                  ((nil? res) nil)
                  (:else (assoc res (nth pat 1) val)))))
            (:else
              (let ((fv (hk-force val)))
                (cond
                  ((= tag "p-int")
                    (if
                      (and (number? fv) (= fv (nth pat 1)))
                      env
                      nil))
                  ((= tag "p-float")
                    (if
                      (and (number? fv) (= fv (nth pat 1)))
                      env
                      nil))
                  ((= tag "p-string")
                    (if
                      (and (string? fv) (= fv (nth pat 1)))
                      env
                      nil))
                  ((= tag "p-char")
                    (if
                      (and (string? fv) (= fv (nth pat 1)))
                      env
                      nil))
                  ((= tag "p-con")
                    (let
                      ((pat-name (nth pat 1)) (pat-args (nth pat 2)))
                      (cond
                        ((not (hk-is-con-val? fv)) nil)
                        ((not (= (hk-val-con-name fv) pat-name)) nil)
                        (:else
                          (let
                            ((val-args (hk-val-con-args fv)))
                            (cond
                              ((not (= (len pat-args) (len val-args)))
                                nil)
                              (:else
                                (hk-match-all
                                  pat-args
                                  val-args
                                  env))))))))
                  ((= tag "p-tuple")
                    (let
                      ((items (nth pat 1)))
                      (cond
                        ((not (hk-is-con-val? fv)) nil)
                        ((not (= (hk-val-con-name fv) "Tuple")) nil)
                        ((not (= (len (hk-val-con-args fv)) (len items)))
                          nil)
                        (:else
                          (hk-match-all
                            items
                            (hk-val-con-args fv)
                            env)))))
                  ((= tag "p-list")
                    (hk-match-list-pat (nth pat 1) fv env))
                  (:else nil))))))))))
 (define
  hk-match-all
  (fn
    (pats vals env)
    (cond
      ((empty? pats) env)
      (:else
        (let
          ((res (hk-match (first pats) (first vals) env)))
          (cond
            ((nil? res) nil)
            (:else
              (hk-match-all (rest pats) (rest vals) res))))))))
 (define
  hk-match-list-pat
  (fn
    (items val env)
    (let ((fv (hk-force val)))
      (cond
        ((empty? items)
          (if
            (and
              (hk-is-con-val? fv)
              (= (hk-val-con-name fv) "[]"))
            env
            nil))
        (:else
          (cond
            ((not (hk-is-con-val? fv)) nil)
            ((not (= (hk-val-con-name fv) ":")) nil)
            (:else
              (let
                ((args (hk-val-con-args fv)))
                (let
                  ((h (first args)) (t (first (rest args))))
                  (let
                    ((res (hk-match (first items) h env)))
                    (cond
                      ((nil? res) nil)
                      (:else
                        (hk-match-list-pat
                          (rest items)
                          t
                          res)))))))))))))
 ;; ── Convenience: parse a pattern from source for tests ─────
 ;; (Uses the parser's case-alt entry — `case _ of pat -> 0` —
 ;; to extract a pattern AST.)
 (define
  hk-parse-pat-source
  (fn
    (src)
    (let
      ((expr (hk-parse (str "case 0 of " src " -> 0"))))
      (nth (nth (nth expr 2) 0) 1))))
--- a/lib/haskell/parser.sx
+++ b/lib/haskell/parser.sx
--- a/lib/haskell/runtime.sx
+++ b/lib/haskell/runtime.sx
@@ -1,130 +0,0 @@
 ;; Haskell runtime: constructor registry.
 ;;
 ;; A mutable dict keyed by constructor name (e.g. "Just", "[]") with
 ;; entries of shape  {:arity N :type TYPE-NAME-STRING}.
 ;; Populated by ingesting `data` / `newtype` decls from parsed ASTs.
 ;; Pre-registers a small set of constructors tied to Haskell syntactic
 ;; forms (Bool, list, unit) — every nontrivial program depends on
 ;; these, and the parser/desugar pipeline emits them as (:var "True")
 ;; etc. without a corresponding `data` decl.
 (define hk-constructors (dict))
 (define
  hk-register-con!
  (fn
    (cname arity type-name)
    (dict-set!
      hk-constructors
      cname
      {:arity arity :type type-name})))
 (define hk-is-con? (fn (name) (has-key? hk-constructors name)))
 (define
  hk-con-arity
  (fn
    (name)
    (if
      (has-key? hk-constructors name)
      (get (get hk-constructors name) "arity")
      nil)))
 (define
  hk-con-type
  (fn
    (name)
    (if
      (has-key? hk-constructors name)
      (get (get hk-constructors name) "type")
      nil)))
 (define hk-con-names (fn () (keys hk-constructors)))
 ;; ── Registration from AST ────────────────────────────────────
 ;; (:data NAME TVARS ((:con-def CNAME FIELDS) …))
 (define
  hk-register-data!
  (fn
    (data-node)
    (let
      ((type-name (nth data-node 1))
        (cons-list (nth data-node 3)))
      (for-each
        (fn
          (cd)
          (hk-register-con!
            (nth cd 1)
            (len (nth cd 2))
            type-name))
        cons-list))))
 ;; (:newtype NAME TVARS CNAME FIELD)
 (define
  hk-register-newtype!
  (fn
    (nt-node)
    (hk-register-con!
      (nth nt-node 3)
      1
      (nth nt-node 1))))
 ;; Walk a decls list, registering every `data` / `newtype` decl.
 (define
  hk-register-decls!
  (fn
    (decls)
    (for-each
      (fn
        (d)
        (cond
          ((and
              (list? d)
              (not (empty? d))
              (= (first d) "data"))
            (hk-register-data! d))
          ((and
              (list? d)
              (not (empty? d))
              (= (first d) "newtype"))
            (hk-register-newtype! d))
          (:else nil)))
      decls)))
 (define
  hk-register-program!
  (fn
    (ast)
    (cond
      ((nil? ast) nil)
      ((not (list? ast)) nil)
      ((empty? ast) nil)
      ((= (first ast) "program")
        (hk-register-decls! (nth ast 1)))
      ((= (first ast) "module")
        (hk-register-decls! (nth ast 4)))
      (:else nil))))
 ;; Convenience: source → AST → desugar → register.
 (define
  hk-load-source!
  (fn (src) (hk-register-program! (hk-core src))))
 ;; ── Built-in constructors pre-registered ─────────────────────
 ;; Bool — used implicitly by `if`, comparison operators.
 (hk-register-con! "True" 0 "Bool")
 (hk-register-con! "False" 0 "Bool")
 ;; List — used by list literals, range syntax, and cons operator.
 (hk-register-con! "[]" 0 "List")
 (hk-register-con! ":" 2 "List")
 ;; Unit — produced by empty parens `()`.
 (hk-register-con! "()" 0 "Unit")
 ;; Standard Prelude types — pre-registered so expression-level
 ;; programs can use them without a `data` decl.
 (hk-register-con! "Nothing" 0 "Maybe")
 (hk-register-con! "Just"    1 "Maybe")
 (hk-register-con! "Left"    1 "Either")
 (hk-register-con! "Right"   1 "Either")
 (hk-register-con! "LT" 0 "Ordering")
 (hk-register-con! "EQ" 0 "Ordering")
 (hk-register-con! "GT" 0 "Ordering")
--- a/lib/haskell/scoreboard.json
+++ b/lib/haskell/scoreboard.json
@@ -1,25 +0,0 @@
 {
  "date": "2026-05-06",
  "total_pass": 156,
  "total_fail": 0,
  "programs": {
    "fib": {"pass": 2, "fail": 0},
    "sieve": {"pass": 2, "fail": 0},
    "quicksort": {"pass": 5, "fail": 0},
    "nqueens": {"pass": 2, "fail": 0},
    "calculator": {"pass": 5, "fail": 0},
    "collatz": {"pass": 11, "fail": 0},
    "palindrome": {"pass": 8, "fail": 0},
    "maybe": {"pass": 12, "fail": 0},
    "fizzbuzz": {"pass": 12, "fail": 0},
    "anagram": {"pass": 9, "fail": 0},
    "roman": {"pass": 14, "fail": 0},
    "binary": {"pass": 12, "fail": 0},
    "either": {"pass": 12, "fail": 0},
    "primes": {"pass": 12, "fail": 0},
    "zipwith": {"pass": 9, "fail": 0},
    "matrix": {"pass": 8, "fail": 0},
    "wordcount": {"pass": 7, "fail": 0},
    "powers": {"pass": 14, "fail": 0}
  }
 }
--- a/lib/haskell/scoreboard.md
+++ b/lib/haskell/scoreboard.md
@@ -1,25 +0,0 @@
 # Haskell-on-SX Scoreboard
 Updated 2026-05-06 · Phase 6 (prelude extras + 18 programs)
 | Program | Tests | Status |
 |---------|-------|--------|
 | fib.hs | 2/2 | ✓ |
 | sieve.hs | 2/2 | ✓ |
 | quicksort.hs | 5/5 | ✓ |
 | nqueens.hs | 2/2 | ✓ |
 | calculator.hs | 5/5 | ✓ |
 | collatz.hs | 11/11 | ✓ |
 | palindrome.hs | 8/8 | ✓ |
 | maybe.hs | 12/12 | ✓ |
 | fizzbuzz.hs | 12/12 | ✓ |
 | anagram.hs | 9/9 | ✓ |
 | roman.hs | 14/14 | ✓ |
 | binary.hs | 12/12 | ✓ |
 | either.hs | 12/12 | ✓ |
 | primes.hs | 12/12 | ✓ |
 | zipwith.hs | 9/9 | ✓ |
 | matrix.hs | 8/8 | ✓ |
 | wordcount.hs | 7/7 | ✓ |
 | powers.hs | 14/14 | ✓ |
 | **Total** | **156/156** | **18/18 programs** |
--- a/lib/haskell/test.sh
+++ b/lib/haskell/test.sh
@@ -14,7 +14,7 @@ cd "$(git rev-parse --show-toplevel)"
 SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
 if [ ! -x "$SX_SERVER" ]; then
  # Fall back to the main-repo build if we're in a worktree.
-  MAIN_ROOT=$(git worktree list | awk 'NR==1{print $1}')
+  MAIN_ROOT=$(git worktree list | head -1 | awk '{print $1}')
  if [ -x "$MAIN_ROOT/$SX_SERVER" ]; then
    SX_SERVER="$MAIN_ROOT/$SX_SERVER"
  else
@@ -42,35 +42,24 @@ FAILED_FILES=()
 for FILE in "${FILES[@]}"; do
  [ -f "$FILE" ] || { echo "skip $FILE (not found)"; continue; }
  # Load infer.sx only for infer/typecheck test files (it adds ~6s overhead).
  INFER_LOAD=""
  case "$FILE" in *infer*|*typecheck*) INFER_LOAD='(load "lib/haskell/infer.sx")' ;; esac
  TMPFILE=$(mktemp)
  cat > "$TMPFILE" <<EPOCHS
 (epoch 1)
 (load "lib/haskell/tokenizer.sx")
 (load "lib/haskell/layout.sx")
 (load "lib/haskell/parser.sx")
 (load "lib/haskell/desugar.sx")
 (load "lib/haskell/runtime.sx")
 (load "lib/haskell/match.sx")
 (load "lib/haskell/eval.sx")
 $INFER_LOAD
 (load "lib/haskell/testlib.sx")
 (epoch 2)
 (load "$FILE")
 (epoch 3)
 (eval "(list hk-test-pass hk-test-fail)")
 EPOCHS
-  OUTPUT=$(timeout 360 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
+  OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
  rm -f "$TMPFILE"
  # Output format: either "(ok 3 (P F))" on one line (short result) or
  # "(ok-len 3 N)\n(P F)" where the value appears on the following line.
  LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}')
  if [ -z "$LINE" ]; then
-    LINE=$(echo "$OUTPUT" | { grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' || true; } | tail -1 \
+    LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \
            | sed -E 's/^\(ok 3 //; s/\)$//')
  fi
  if [ -z "$LINE" ]; then
@@ -92,20 +81,12 @@ EPOCHS
    cat > "$TMPFILE2" <<EPOCHS
 (epoch 1)
 (load "lib/haskell/tokenizer.sx")
 (load "lib/haskell/layout.sx")
 (load "lib/haskell/parser.sx")
 (load "lib/haskell/desugar.sx")
 (load "lib/haskell/runtime.sx")
 (load "lib/haskell/match.sx")
 (load "lib/haskell/eval.sx")
 $INFER_LOAD
 (load "lib/haskell/testlib.sx")
 (epoch 2)
 (load "$FILE")
 (epoch 3)
 (eval "(map (fn (f) (get f \"name\")) hk-test-fails)")
 EPOCHS
-    FAILS=$(timeout 360 "$SX_SERVER" < "$TMPFILE2" 2>&1 | grep -E '^\(ok 3 ' || true)
+    FAILS=$(timeout 60 "$SX_SERVER" < "$TMPFILE2" 2>&1 | grep -E '^\(ok 3 ' || true)
    rm -f "$TMPFILE2"
    echo "    $FAILS"
  elif [ "$VERBOSE" = "1" ]; then
--- a/lib/haskell/testlib.sx
+++ b/lib/haskell/testlib.sx
@@ -1,58 +0,0 @@
 ;; Shared test harness for Haskell-on-SX tests.
 ;; Each test file expects hk-test / hk-deep=? / counters to already be bound.
 (define
  hk-deep=?
  (fn
    (a b)
    (cond
      ((= a b) true)
      ((and (dict? a) (dict? b))
        (let
          ((ak (keys a)) (bk (keys b)))
          (if
            (not (= (len ak) (len bk)))
            false
            (every?
              (fn
                (k)
                (and (has-key? b k) (hk-deep=? (get a k) (get b k))))
              ak))))
      ((and (list? a) (list? b))
        (if
          (not (= (len a) (len b)))
          false
          (let
            ((i 0) (ok true))
            (define
              hk-de-loop
              (fn
                ()
                (when
                  (and ok (< i (len a)))
                  (do
                    (when
                      (not (hk-deep=? (nth a i) (nth b i)))
                      (set! ok false))
                    (set! i (+ i 1))
                    (hk-de-loop)))))
            (hk-de-loop)
            ok)))
      (:else false))))
 (define hk-test-pass 0)
 (define hk-test-fail 0)
 (define hk-test-fails (list))
 (define
  hk-test
  (fn
    (name actual expected)
    (if
      (hk-deep=? actual expected)
      (set! hk-test-pass (+ hk-test-pass 1))
      (do
        (set! hk-test-fail (+ hk-test-fail 1))
        (append!
          hk-test-fails
          {:actual actual :expected expected :name name})))))
--- a/lib/haskell/tests/class.sx
+++ b/lib/haskell/tests/class.sx
@@ -1,60 +0,0 @@
 ;; class.sx — tests for class/instance parsing and evaluation.
 (define prog-class1 (hk-core "class MyEq a where\n  myEq :: a -> a -> Bool"))
 (define prog-inst1 (hk-core "instance MyEq Int where\n  myEq x y = x == y"))
 ;; ─── class-decl AST ───────────────────────────────────────────────────────────
 (define cd1 (first (nth prog-class1 1)))
 (hk-test "class-decl tag" (first cd1) "class-decl")
 (hk-test "class-decl name" (nth cd1 1) "MyEq")
 (hk-test "class-decl tvar" (nth cd1 2) "a")
 (hk-test "class-decl methods" (len (nth cd1 3)) 1)
 ;; ─── instance-decl AST ────────────────────────────────────────────────────────
 (define id1 (first (nth prog-inst1 1)))
 (hk-test "instance-decl tag" (first id1) "instance-decl")
 (hk-test "instance-decl class" (nth id1 1) "MyEq")
 (hk-test "instance-decl type tag" (first (nth id1 2)) "t-con")
 (hk-test "instance-decl type name" (nth (nth id1 2) 1) "Int")
 (hk-test "instance-decl method count" (len (nth id1 3)) 1)
 ;; ─── eval: instance dict is built ────────────────────────────────────────────
 (define
  prog-full
  (hk-core
    "class MyEq a where\n  myEq :: a -> a -> Bool\ninstance MyEq Int where\n  myEq x y = x == y"))
 (define env-full (hk-eval-program prog-full))
 (hk-test "instance dict in env" (has-key? env-full "dictMyEq_Int") true)
 (hk-test
  "instance dict has method"
  (has-key? (get env-full "dictMyEq_Int") "myEq")
  true)
 (hk-test
  "dispatch: single-arg method works"
  (hk-deep-force
    (hk-run
      "class Describable a where\n  describe :: a -> String\ninstance Describable Int where\n  describe x = \"an integer\"\nmain = describe 42"))
  "an integer")
 (hk-test
  "dispatch: second instance (Bool)"
  (hk-deep-force
    (hk-run
      "class Describable a where\n  describe :: a -> String\ninstance Describable Bool where\n  describe x = \"a boolean\"\ninstance Describable Int where\n  describe x = \"an integer\"\nmain = describe True"))
  "a boolean")
 (hk-test
  "dispatch: error on unknown instance"
  (guard
    (e (true (>= (index-of e "No instance") 0)))
    (begin
      (hk-deep-force
        (hk-run
          "class Describable a where\n  describe :: a -> String\nmain = describe 42"))
      false))
  true)
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/deriving.sx
+++ b/lib/haskell/tests/deriving.sx
@@ -1,84 +0,0 @@
 ;; deriving.sx — tests for deriving (Eq, Show) on ADTs.
 ;; ─── Show ────────────────────────────────────────────────────────────────────
 (hk-test
  "deriving Show: nullary constructor"
  (hk-deep-force
    (hk-run "data Color = Red | Green | Blue deriving (Show)\nmain = show Red"))
  "Red")
 (hk-test
  "deriving Show: constructor with arg"
  (hk-deep-force
    (hk-run "data Wrapper = Wrap Int deriving (Show)\nmain = show (Wrap 42)"))
  "(Wrap 42)")
 (hk-test
  "deriving Show: nested constructors"
  (hk-deep-force
    (hk-run
      "data Tree = Leaf | Node Int Tree Tree deriving (Show)\nmain = show (Node 1 Leaf Leaf)"))
  "(Node 1 Leaf Leaf)")
 (hk-test
  "deriving Show: second constructor"
  (hk-deep-force
    (hk-run
      "data Color = Red | Green | Blue deriving (Show)\nmain = show Green"))
  "Green")
 ;; ─── Eq ──────────────────────────────────────────────────────────────────────
 (hk-test
  "deriving Eq: same constructor"
  (hk-deep-force
    (hk-run
      "data Color = Red | Green | Blue deriving (Eq)\nmain = show (Red == Red)"))
  "True")
 (hk-test
  "deriving Eq: different constructors"
  (hk-deep-force
    (hk-run
      "data Color = Red | Green | Blue deriving (Eq)\nmain = show (Red == Blue)"))
  "False")
 (hk-test
  "deriving Eq: /= same"
  (hk-deep-force
    (hk-run
      "data Color = Red | Green | Blue deriving (Eq)\nmain = show (Red /= Red)"))
  "False")
 (hk-test
  "deriving Eq: /= different"
  (hk-deep-force
    (hk-run
      "data Color = Red | Green | Blue deriving (Eq)\nmain = show (Red /= Blue)"))
  "True")
 ;; ─── combined Eq + Show ───────────────────────────────────────────────────────
 (hk-test
  "deriving Eq Show: combined in parens"
  (hk-deep-force
    (hk-run
      "data Shape = Circle Int | Square Int deriving (Eq, Show)\nmain = show (Circle 5)"))
  "(Circle 5)")
 (hk-test
  "deriving Eq Show: eq on constructor with arg"
  (hk-deep-force
    (hk-run
      "data Shape = Circle Int | Square Int deriving (Eq, Show)\nmain = show (Circle 3 == Circle 3)"))
  "True")
 (hk-test
  "deriving Eq Show: different constructors with args"
  (hk-deep-force
    (hk-run
      "data Shape = Circle Int | Square Int deriving (Eq, Show)\nmain = show (Circle 3 == Square 3)"))
  "False")
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/desugar.sx
+++ b/lib/haskell/tests/desugar.sx
@@ -1,305 +0,0 @@
 ;; Desugar tests — surface AST → core AST.
 ;;   :guarded   →  nested :if
 ;;   :where     →  :let
 ;;   :list-comp →  concatMap-based tree
 (define
  hk-prog
  (fn (&rest decls) (list :program decls)))
 ;; ── Guards → if ──
 (hk-test
  "two-way guarded rhs"
  (hk-desugar (hk-parse-top "abs x | x < 0 = - x\n      | otherwise = x"))
  (hk-prog
    (list
      :fun-clause
      "abs"
      (list (list :p-var "x"))
      (list
        :if
        (list :op "<" (list :var "x") (list :int 0))
        (list :neg (list :var "x"))
        (list
          :if
          (list :var "otherwise")
          (list :var "x")
          (list
            :app
            (list :var "error")
            (list :string "Non-exhaustive guards")))))))
 (hk-test
  "three-way guarded rhs"
  (hk-desugar
    (hk-parse-top "sign n | n > 0 = 1\n       | n < 0 = -1\n       | otherwise = 0"))
  (hk-prog
    (list
      :fun-clause
      "sign"
      (list (list :p-var "n"))
      (list
        :if
        (list :op ">" (list :var "n") (list :int 0))
        (list :int 1)
        (list
          :if
          (list :op "<" (list :var "n") (list :int 0))
          (list :neg (list :int 1))
          (list
            :if
            (list :var "otherwise")
            (list :int 0)
            (list
              :app
              (list :var "error")
              (list :string "Non-exhaustive guards"))))))))
 (hk-test
  "case-alt guards desugared too"
  (hk-desugar
    (hk-parse "case x of\n  Just y | y > 0 -> y\n         | otherwise -> 0\n  Nothing -> -1"))
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list
          :if
          (list :op ">" (list :var "y") (list :int 0))
          (list :var "y")
          (list
            :if
            (list :var "otherwise")
            (list :int 0)
            (list
              :app
              (list :var "error")
              (list :string "Non-exhaustive guards")))))
      (list
        :alt
        (list :p-con "Nothing" (list))
        (list :neg (list :int 1))))))
 ;; ── Where → let ──
 (hk-test
  "where with single binding"
  (hk-desugar (hk-parse-top "f x = y\n  where y = x + 1"))
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :let
        (list
          (list
            :fun-clause
            "y"
            (list)
            (list :op "+" (list :var "x") (list :int 1))))
        (list :var "y")))))
 (hk-test
  "where with two bindings"
  (hk-desugar
    (hk-parse-top "f x = y + z\n  where y = x + 1\n        z = x - 1"))
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :let
        (list
          (list
            :fun-clause
            "y"
            (list)
            (list :op "+" (list :var "x") (list :int 1)))
          (list
            :fun-clause
            "z"
            (list)
            (list :op "-" (list :var "x") (list :int 1))))
        (list :op "+" (list :var "y") (list :var "z"))))))
 (hk-test
  "guards + where — guarded body inside let"
  (hk-desugar
    (hk-parse-top "f x | x > 0 = y\n    | otherwise = 0\n  where y = 99"))
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :let
        (list (list :fun-clause "y" (list) (list :int 99)))
        (list
          :if
          (list :op ">" (list :var "x") (list :int 0))
          (list :var "y")
          (list
            :if
            (list :var "otherwise")
            (list :int 0)
            (list
              :app
              (list :var "error")
              (list :string "Non-exhaustive guards"))))))))
 ;; ── List comprehensions → concatMap / if / let ──
 (hk-test
  "list-comp: single generator"
  (hk-core-expr "[x | x <- xs]")
  (list
    :app
    (list
      :app
      (list :var "concatMap")
      (list
        :lambda
        (list (list :p-var "x"))
        (list :list (list (list :var "x")))))
    (list :var "xs")))
 (hk-test
  "list-comp: generator then guard"
  (hk-core-expr "[x * 2 | x <- xs, x > 0]")
  (list
    :app
    (list
      :app
      (list :var "concatMap")
      (list
        :lambda
        (list (list :p-var "x"))
        (list
          :if
          (list :op ">" (list :var "x") (list :int 0))
          (list
            :list
            (list (list :op "*" (list :var "x") (list :int 2))))
          (list :list (list)))))
    (list :var "xs")))
 (hk-test
  "list-comp: generator then let"
  (hk-core-expr "[y | x <- xs, let y = x + 1]")
  (list
    :app
    (list
      :app
      (list :var "concatMap")
      (list
        :lambda
        (list (list :p-var "x"))
        (list
          :let
          (list
            (list
              :bind
              (list :p-var "y")
              (list :op "+" (list :var "x") (list :int 1))))
          (list :list (list (list :var "y"))))))
    (list :var "xs")))
 (hk-test
  "list-comp: two generators (nested concatMap)"
  (hk-core-expr "[(x, y) | x <- xs, y <- ys]")
  (list
    :app
    (list
      :app
      (list :var "concatMap")
      (list
        :lambda
        (list (list :p-var "x"))
        (list
          :app
          (list
            :app
            (list :var "concatMap")
            (list
              :lambda
              (list (list :p-var "y"))
              (list
                :list
                (list
                  (list
                    :tuple
                    (list (list :var "x") (list :var "y")))))))
          (list :var "ys"))))
    (list :var "xs")))
 ;; ── Pass-through cases ──
 (hk-test
  "plain int literal unchanged"
  (hk-core-expr "42")
  (list :int 42))
 (hk-test
  "lambda + if passes through"
  (hk-core-expr "\\x -> if x > 0 then x else - x")
  (list
    :lambda
    (list (list :p-var "x"))
    (list
      :if
      (list :op ">" (list :var "x") (list :int 0))
      (list :var "x")
      (list :neg (list :var "x")))))
 (hk-test
  "simple fun-clause (no guards/where) passes through"
  (hk-desugar (hk-parse-top "id x = x"))
  (hk-prog
    (list
      :fun-clause
      "id"
      (list (list :p-var "x"))
      (list :var "x"))))
 (hk-test
  "data decl passes through"
  (hk-desugar (hk-parse-top "data Maybe a = Nothing | Just a"))
  (hk-prog
    (list
      :data
      "Maybe"
      (list "a")
      (list
        (list :con-def "Nothing" (list))
        (list :con-def "Just" (list (list :t-var "a")))))))
 (hk-test
  "module header passes through, body desugared"
  (hk-desugar
    (hk-parse-top "module M where\nf x | x > 0 = 1\n    | otherwise = 0"))
  (list
    :module
    "M"
    nil
    (list)
    (list
      (list
        :fun-clause
        "f"
        (list (list :p-var "x"))
        (list
          :if
          (list :op ">" (list :var "x") (list :int 0))
          (list :int 1)
          (list
            :if
            (list :var "otherwise")
            (list :int 0)
            (list
              :app
              (list :var "error")
              (list :string "Non-exhaustive guards"))))))))
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/do-io.sx
+++ b/lib/haskell/tests/do-io.sx
@@ -1,117 +0,0 @@
 ;; do-notation + stub IO monad. Desugaring is per Haskell 98 §3.14:
 ;;   do { e ; ss }      = e >> do { ss }
 ;;   do { p <- e ; ss } = e >>= \p -> do { ss }
 ;;   do { let ds ; ss } = let ds in do { ss }
 ;;   do { e }           = e
 ;; The IO type is just `("IO" payload)` for now — no real side
 ;; effects yet. `return`, `>>=`, `>>` are built-ins.
 (define
  hk-prog-val
  (fn
    (src name)
    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))
 ;; ── Single-statement do ──
 (hk-test
  "do with a single expression"
  (hk-eval-expr-source "do { return 5 }")
  (list "IO" 5))
 (hk-test
  "return wraps any expression"
  (hk-eval-expr-source "return (1 + 2 * 3)")
  (list "IO" 7))
 ;; ── Bind threads results ──
 (hk-test
  "single bind"
  (hk-eval-expr-source
    "do { x <- return 5 ; return (x + 1) }")
  (list "IO" 6))
 (hk-test
  "two binds"
  (hk-eval-expr-source
    "do\n  x <- return 5\n  y <- return 7\n  return (x + y)")
  (list "IO" 12))
 (hk-test
  "three binds — accumulating"
  (hk-eval-expr-source
    "do\n  a <- return 1\n  b <- return 2\n  c <- return 3\n  return (a + b + c)")
  (list "IO" 6))
 ;; ── Mixing >> and >>= ──
 (hk-test
  ">> sequencing — last wins"
  (hk-eval-expr-source
    "do\n  return 1\n  return 2\n  return 3")
  (list "IO" 3))
 (hk-test
  ">> then >>= — last bind wins"
  (hk-eval-expr-source
    "do\n  return 99\n  x <- return 5\n  return x")
  (list "IO" 5))
 ;; ── do-let ──
 (hk-test
  "do-let single binding"
  (hk-eval-expr-source
    "do\n  let x = 3\n  return (x * 2)")
  (list "IO" 6))
 (hk-test
  "do-let multi-bind, used after"
  (hk-eval-expr-source
    "do\n  let x = 4\n      y = 5\n  return (x * y)")
  (list "IO" 20))
 (hk-test
  "do-let interleaved with bind"
  (hk-eval-expr-source
    "do\n  x <- return 10\n  let y = x + 1\n  return (x * y)")
  (list "IO" 110))
 ;; ── Bind + pattern ──
 (hk-test
  "bind to constructor pattern"
  (hk-eval-expr-source
    "do\n  Just x <- return (Just 7)\n  return (x + 100)")
  (list "IO" 107))
 (hk-test
  "bind to tuple pattern"
  (hk-eval-expr-source
    "do\n  (a, b) <- return (3, 4)\n  return (a * b)")
  (list "IO" 12))
 ;; ── User-defined IO functions ──
 (hk-test
  "do inside top-level fun"
  (hk-prog-val
    "addM x y = do\n  a <- return x\n  b <- return y\n  return (a + b)\nresult = addM 5 6"
    "result")
  (list "IO" 11))
 (hk-test
  "nested do"
  (hk-eval-expr-source
    "do\n  x <- do { y <- return 3 ; return (y + 1) }\n  return (x * 2)")
  (list "IO" 8))
 ;; ── (>>=) and (>>) used directly as functions ──
 (hk-test
  ">>= used directly"
  (hk-eval-expr-source
    "(return 4) >>= (\\x -> return (x + 100))")
  (list "IO" 104))
 (hk-test
  ">> used directly"
  (hk-eval-expr-source
    "(return 1) >> (return 2)")
  (list "IO" 2))
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/eval.sx
+++ b/lib/haskell/tests/eval.sx
@@ -1,278 +0,0 @@
 ;; Strict evaluator tests. Each test parses, desugars, and evaluates
 ;; either an expression (hk-eval-expr-source) or a full program
 ;; (hk-eval-program → look up a named value).
 (define
  hk-prog-val
  (fn
    (src name)
    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))
 ;; ── Literals ──
 (hk-test "int literal" (hk-eval-expr-source "42") 42)
 (hk-test "float literal" (hk-eval-expr-source "3.14") 3.14)
 (hk-test "string literal" (hk-eval-expr-source "\"hi\"") "hi")
 (hk-test "char literal" (hk-eval-expr-source "'a'") "a")
 (hk-test "negative literal" (hk-eval-expr-source "- 5") -5)
 ;; ── Arithmetic ──
 (hk-test "addition" (hk-eval-expr-source "1 + 2") 3)
 (hk-test
  "precedence"
  (hk-eval-expr-source "1 + 2 * 3")
  7)
 (hk-test
  "parens override precedence"
  (hk-eval-expr-source "(1 + 2) * 3")
  9)
 (hk-test
  "subtraction left-assoc"
  (hk-eval-expr-source "10 - 3 - 2")
  5)
 ;; ── Comparison + Bool ──
 (hk-test
  "less than is True"
  (hk-eval-expr-source "3 < 5")
  (list "True"))
 (hk-test
  "equality is False"
  (hk-eval-expr-source "1 == 2")
  (list "False"))
 (hk-test
  "&& shortcuts"
  (hk-eval-expr-source "(1 == 1) && (2 == 2)")
  (list "True"))
 ;; ── if / otherwise ──
 (hk-test
  "if True"
  (hk-eval-expr-source "if True then 1 else 2")
  1)
 (hk-test
  "if comparison branch"
  (hk-eval-expr-source "if 5 > 3 then \"yes\" else \"no\"")
  "yes")
 (hk-test "otherwise is True" (hk-eval-expr-source "otherwise") (list "True"))
 ;; ── let ──
 (hk-test
  "let single binding"
  (hk-eval-expr-source "let x = 5 in x + 1")
  6)
 (hk-test
  "let two bindings"
  (hk-eval-expr-source "let x = 1; y = 2 in x + y")
  3)
 (hk-test
  "let recursive: factorial 5"
  (hk-eval-expr-source
    "let f n = if n == 0 then 1 else n * f (n - 1) in f 5")
  120)
 ;; ── Lambdas ──
 (hk-test
  "lambda apply"
  (hk-eval-expr-source "(\\x -> x + 1) 5")
  6)
 (hk-test
  "lambda multi-arg"
  (hk-eval-expr-source "(\\x y -> x * y) 3 4")
  12)
 (hk-test
  "lambda with constructor pattern"
  (hk-eval-expr-source "(\\(Just x) -> x + 1) (Just 7)")
  8)
 ;; ── Constructors ──
 (hk-test
  "0-arity constructor"
  (hk-eval-expr-source "Nothing")
  (list "Nothing"))
 (hk-test
  "1-arity constructor applied"
  (hk-eval-expr-source "Just 5")
  (list "Just" 5))
 (hk-test
  "True / False as bools"
  (hk-eval-expr-source "True")
  (list "True"))
 ;; ── case ──
 (hk-test
  "case Just"
  (hk-eval-expr-source
    "case Just 7 of Just x -> x ; Nothing -> 0")
  7)
 (hk-test
  "case Nothing"
  (hk-eval-expr-source
    "case Nothing of Just x -> x ; Nothing -> 99")
  99)
 (hk-test
  "case literal pattern"
  (hk-eval-expr-source
    "case 0 of 0 -> \"zero\" ; n -> \"other\"")
  "zero")
 (hk-test
  "case tuple"
  (hk-eval-expr-source
    "case (1, 2) of (a, b) -> a + b")
  3)
 (hk-test
  "case wildcard fallback"
  (hk-eval-expr-source
    "case 5 of 0 -> \"z\" ; _ -> \"nz\"")
  "nz")
 ;; ── List literals + cons ──
 (hk-test
  "list literal as cons spine"
  (hk-eval-expr-source "[1, 2, 3]")
  (list ":" 1 (list ":" 2 (list ":" 3 (list "[]")))))
 (hk-test
  "empty list literal"
  (hk-eval-expr-source "[]")
  (list "[]"))
 (hk-test
  "cons via :"
  (hk-eval-expr-source "1 : []")
  (list ":" 1 (list "[]")))
 (hk-test
  "++ concatenates lists"
  (hk-eval-expr-source "[1, 2] ++ [3]")
  (list ":" 1 (list ":" 2 (list ":" 3 (list "[]")))))
 ;; ── Tuples ──
 (hk-test
  "2-tuple"
  (hk-eval-expr-source "(1, 2)")
  (list "Tuple" 1 2))
 (hk-test
  "3-tuple"
  (hk-eval-expr-source "(\"a\", 5, True)")
  (list "Tuple" "a" 5 (list "True")))
 ;; ── Sections ──
 (hk-test
  "right section (+ 1) applied"
  (hk-eval-expr-source "(+ 1) 5")
  6)
 (hk-test
  "left section (10 -) applied"
  (hk-eval-expr-source "(10 -) 4")
  6)
 ;; ── Multi-clause top-level functions ──
 (hk-test
  "multi-clause: factorial"
  (hk-prog-val
    "fact 0 = 1\nfact n = n * fact (n - 1)\nresult = fact 6"
    "result")
  720)
 (hk-test
  "multi-clause: list length via cons pattern"
  (hk-prog-val
    "len [] = 0\nlen (x:xs) = 1 + len xs\nresult = len [10, 20, 30, 40]"
    "result")
  4)
 (hk-test
  "multi-clause: Maybe handler"
  (hk-prog-val
    "fromMaybe d Nothing = d\nfromMaybe _ (Just x) = x\nresult = fromMaybe 0 (Just 9)"
    "result")
  9)
 (hk-test
  "multi-clause: Maybe with default"
  (hk-prog-val
    "fromMaybe d Nothing = d\nfromMaybe _ (Just x) = x\nresult = fromMaybe 0 Nothing"
    "result")
  0)
 ;; ── User-defined data and matching ──
 (hk-test
  "custom data with pattern match"
  (hk-prog-val
    "data Color = Red | Green | Blue\nname Red = \"red\"\nname Green = \"green\"\nname Blue = \"blue\"\nresult = name Green"
    "result")
  "green")
 (hk-test
  "custom binary tree height"
  (hk-prog-val
    "data Tree = Leaf | Node Tree Tree\nh Leaf = 0\nh (Node l r) = 1 + max (h l) (h r)\nmax a b = if a > b then a else b\nresult = h (Node (Node Leaf Leaf) Leaf)"
    "result")
  2)
 ;; ── Currying ──
 (hk-test
  "partial application"
  (hk-prog-val
    "add x y = x + y\nadd5 = add 5\nresult = add5 7"
    "result")
  12)
 ;; ── Higher-order ──
 (hk-test
  "higher-order: function as arg"
  (hk-prog-val
    "twice f x = f (f x)\ninc x = x + 1\nresult = twice inc 10"
    "result")
  12)
 ;; ── Error built-in ──
 (hk-test
  "error short-circuits via if"
  (hk-eval-expr-source
    "if True then 1 else error \"unreachable\"")
  1)
 ;; ── Laziness: app args evaluate only when forced ──
 (hk-test
  "second arg never forced"
  (hk-eval-expr-source
    "(\\x y -> x) 1 (error \"never\")")
  1)
 (hk-test
  "first arg never forced"
  (hk-eval-expr-source
    "(\\x y -> y) (error \"never\") 99")
  99)
 (hk-test
  "constructor argument is lazy under wildcard pattern"
  (hk-eval-expr-source
    "case Just (error \"deeply\") of Just _ -> 7 ; Nothing -> 0")
  7)
 (hk-test
  "lazy: const drops its second argument"
  (hk-prog-val
    "const x y = x\nresult = const 5 (error \"boom\")"
    "result")
  5)
 (hk-test
  "lazy: head ignores tail"
  (hk-prog-val
    "myHead (x:_) = x\nresult = myHead (1 : (error \"tail\") : [])"
    "result")
  1)
 (hk-test
  "lazy: Just on undefined evaluates only on force"
  (hk-prog-val
    "wrapped = Just (error \"oh no\")\nresult = case wrapped of Just _ -> True ; Nothing -> False"
    "result")
  (list "True"))
 ;; ── not / id built-ins ──
 (hk-test "not True" (hk-eval-expr-source "not True") (list "False"))
 (hk-test "not False" (hk-eval-expr-source "not False") (list "True"))
 (hk-test "id" (hk-eval-expr-source "id 42") 42)
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/infer.sx
+++ b/lib/haskell/tests/infer.sx
@@ -1,181 +0,0 @@
 ;; infer.sx tests — Algorithm W: literals, vars, lambdas, application, let,
 ;; if, operators, tuples, lists, let-polymorphism.
 (define hk-t (fn (src expected)
  (hk-test (str "infer: " src) (hk-infer-type src) expected)))
 ;; ─── Literals ────────────────────────────────────────────────────────────────
 (hk-t "1"          "Int")
 (hk-t "3.14"       "Float")
 (hk-t "\"hello\""  "String")
 (hk-t "'x'"        "Char")
 (hk-t "True"       "Bool")
 (hk-t "False"      "Bool")
 ;; ─── Arithmetic and boolean operators ────────────────────────────────────────
 (hk-t "1 + 2"      "Int")
 (hk-t "3 * 4"      "Int")
 (hk-t "10 - 3"     "Int")
 (hk-t "True && False" "Bool")
 (hk-t "True || False" "Bool")
 (hk-t "not True"   "Bool")
 (hk-t "1 == 1"     "Bool")
 (hk-t "1 < 2"      "Bool")
 ;; ─── Lambda ───────────────────────────────────────────────────────────────────
 ;; \x -> x   (identity)  should get t1 -> t1
 (hk-test "infer: identity lambda" (hk-infer-type "\\x -> x") "t1 -> t1")
 ;; \x -> x + 1 : Int -> Int
 (hk-test "infer: lambda add" (hk-infer-type "\\x -> x + 1") "Int -> Int")
 ;; \x -> not x : Bool -> Bool
 (hk-test "infer: lambda not" (hk-infer-type "\\x -> not x") "Bool -> Bool")
 ;; \x y -> x + y : Int -> Int -> Int
 (hk-test "infer: two-arg lambda" (hk-infer-type "\\x -> \\y -> x + y") "Int -> Int -> Int")
 ;; ─── Application ─────────────────────────────────────────────────────────────
 (hk-t "not True"    "Bool")
 (hk-t "negate 1"    "Int")
 ;; ─── If-then-else ─────────────────────────────────────────────────────────────
 (hk-t "if True then 1 else 2"     "Int")
 (hk-t "if 1 == 2 then True else False" "Bool")
 ;; ─── Let bindings ─────────────────────────────────────────────────────────────
 ;; let x = 1 in x + 2
 (hk-t "let x = 1 in x + 2" "Int")
 ;; let f x = x + 1 in f 5
 (hk-t "let f x = x + 1 in f 5" "Int")
 ;; let-polymorphism: let id x = x in id 1
 (hk-t "let id x = x in id 1" "Int")
 ;; ─── Tuples ───────────────────────────────────────────────────────────────────
 (hk-t "(1, True)"       "(Int, Bool)")
 (hk-t "(1, 2, 3)"       "(Int, Int, Int)")
 ;; ─── Lists ───────────────────────────────────────────────────────────────────
 (hk-t "[1, 2, 3]"    "[Int]")
 (hk-t "[True, False]" "[Bool]")
 ;; ─── Polymorphic list functions ───────────────────────────────────────────────
 (hk-t "length [1, 2, 3]"   "Int")
 (hk-t "null []"             "Bool")
 (hk-t "head [1, 2, 3]"     "Int")
 ;; ─── hk-expr->brief ──────────────────────────────────────────────────────────
 (hk-test "brief var"    (hk-expr->brief (list "var" "x"))           "x")
 (hk-test "brief con"    (hk-expr->brief (list "con" "Just"))        "Just")
 (hk-test "brief int"    (hk-expr->brief (list "int" 42))            "42")
 (hk-test "brief app"    (hk-expr->brief (list "app" (list "var" "f") (list "var" "x"))) "(f x)")
 (hk-test "brief op"     (hk-expr->brief (list "op" "+" (list "int" 1) (list "int" 2))) "(1 + 2)")
 (hk-test "brief lambda" (hk-expr->brief (list "lambda" (list) (list "var" "x"))) "(\\ ...)")
 (hk-test "brief loc"    (hk-expr->brief (list "loc" 3 7 (list "var" "x"))) "x")
 ;; ─── Type error messages ─────────────────────────────────────────────────────
 ;; Helper: catch the error and check it contains a substring.
 (define hk-str-has? (fn (s sub) (>= (index-of s sub) 0)))
 (define hk-te
  (fn (label src sub)
    (hk-test label
      (guard (e (#t (hk-str-has? e sub)))
        (begin (hk-infer-type src) false))
      true)))
 ;; Unbound variable error includes the variable name.
 (hk-te "error unbound name" "foo + 1"    "foo")
 (hk-te "error unbound unk"  "unknown"    "unknown")
 ;; Unification error mentions the conflicting types.
 (hk-te "error unify int-bool-1" "1 + True"  "Int")
 (hk-te "error unify int-bool-2" "1 + True"  "Bool")
 ;; ─── Loc node: passes through to inner (position decorates outer context) ────
 (define hk-loc-err-msg
  (fn ()
    (guard (e (#t e))
      (begin
        (hk-reset-fresh)
        (hk-w (hk-type-env0) (list "loc" 5 10 (list "var" "mystery")))
        "no-error"))))
 (hk-test "loc passes through to var error"
  (hk-str-has? (hk-loc-err-msg) "mystery")
  true)
 ;; ─── hk-infer-decl ───────────────────────────────────────────────────────────
 ;; Returns ("ok" name type) | ("err" msg)
 (define hk-env0-t (hk-type-env0))
 (define prog1 (hk-core "f x = x + 1"))
 (define decl1 (first (nth prog1 1)))
 (define res1 (hk-infer-decl hk-env0-t decl1))
 (hk-test "decl result tag"  (first res1)    "ok")
 (hk-test "decl result name" (nth res1 1)    "f")
 (hk-test "decl result type" (nth res1 2)    "Int -> Int")
 ;; Error decl: result is ("err" "in 'g': ...")
 (define prog2 (hk-core "g x = x + True"))
 (define decl2 (first (nth prog2 1)))
 (define res2 (hk-infer-decl hk-env0-t decl2))
 (hk-test "decl error tag"    (first res2)                  "err")
 (hk-test "decl error has g"  (hk-str-has? (nth res2 1) "g")   true)
 (hk-test "decl error has msg" (hk-str-has? (nth res2 1) "unify") true)
 ;; ─── hk-infer-prog ───────────────────────────────────────────────────────────
 ;; Returns list of ("ok"/"err" ...) tagged results.
 (define prog3 (hk-core "double x = x + x\ntwice f x = f (f x)"))
 (define results3 (hk-infer-prog prog3 hk-env0-t))
 ;; results3 = (("ok" "double" "Int -> Int") ("ok" "twice" "..."))
 (hk-test "infer-prog count"  (len results3)               2)
 (hk-test "infer-prog double" (nth (nth results3 0) 2)     "Int -> Int")
 (hk-test "infer-prog twice"  (nth (nth results3 1) 2)     "(t3 -> t3) -> t3 -> t3")
 (hk-t "let id x = x in id 1" "Int")
 (hk-t "let id x = x in id True" "Bool")
 (hk-t "let id x = x in (id 1, id True)" "(Int, Bool)")
 (hk-t "let const x y = x in (const 1 True, const True 1)" "(Int, Bool)")
 (hk-t "let f x = x in let g y = f y in (g 1, g True)" "(Int, Bool)")
 (hk-t "let twice f x = f (f x) in twice (\x -> x + 1) 5" "Int")
 (hk-t "not (not True)" "Bool")
 (hk-t "negate (negate 1)" "Int")
 (hk-t "\\x -> \\y -> x && y" "Bool -> Bool -> Bool")
 (hk-t "\\x -> x == 1" "Int -> Bool")
 (hk-t "let x = True in if x then 1 else 0" "Int")
 (hk-t "let f x = not x in f True" "Bool")
 (hk-t "let f x = (x, x + 1) in f 5" "(Int, Int)")
 (hk-t "let x = 1 in let y = 2 in x + y" "Int")
 (hk-t "let f x = x + 1 in f (f 5)" "Int")
 (hk-t "if 1 < 2 then True else False" "Bool")
 (hk-t "if True then 1 + 1 else 2 + 2" "Int")
 (hk-t "(1 + 2, True && False)" "(Int, Bool)")
 (hk-t "(1 == 1, 2 < 3)" "(Bool, Bool)")
 (hk-t "length [True, False]" "Int")
 (hk-t "null [1]" "Bool")
 (hk-t "[True]" "[Bool]")
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/infinite.sx
+++ b/lib/haskell/tests/infinite.sx
@@ -1,137 +0,0 @@
 ;; Infinite structures + Prelude tests. The lazy `:` operator builds
 ;; cons cells with thunked head/tail so recursive list-defining
 ;; functions terminate when only a finite prefix is consumed.
 (define
  hk-prog-val
  (fn
    (src name)
    (hk-deep-force (get (hk-eval-program (hk-core src)) name))))
 (define hk-as-list
  (fn (xs)
    (cond
      ((and (list? xs) (= (first xs) "[]")) (list))
      ((and (list? xs) (= (first xs) ":"))
        (cons (nth xs 1) (hk-as-list (nth xs 2))))
      (:else xs))))
 (define
  hk-eval-list
  (fn (src) (hk-as-list (hk-eval-expr-source src))))
 ;; ── Prelude basics ──
 (hk-test "head of literal" (hk-eval-expr-source "head [1, 2, 3]") 1)
 (hk-test
  "tail of literal"
  (hk-eval-list "tail [1, 2, 3]")
  (list 2 3))
 (hk-test "length" (hk-eval-expr-source "length [10, 20, 30, 40]") 4)
 (hk-test "length empty" (hk-eval-expr-source "length []") 0)
 (hk-test
  "map with section"
  (hk-eval-list "map (+ 1) [1, 2, 3]")
  (list 2 3 4))
 (hk-test
  "filter"
  (hk-eval-list "filter (\\x -> x > 2) [1, 2, 3, 4, 5]")
  (list 3 4 5))
 (hk-test
  "drop"
  (hk-eval-list "drop 2 [10, 20, 30, 40]")
  (list 30 40))
 (hk-test "fst" (hk-eval-expr-source "fst (7, 9)") 7)
 (hk-test "snd" (hk-eval-expr-source "snd (7, 9)") 9)
 (hk-test
  "zipWith"
  (hk-eval-list "zipWith plus [1, 2, 3] [10, 20, 30]")
  (list 11 22 33))
 ;; ── Infinite structures ──
 (hk-test
  "take from repeat"
  (hk-eval-list "take 5 (repeat 7)")
  (list 7 7 7 7 7))
 (hk-test
  "take 0 from repeat returns empty"
  (hk-eval-list "take 0 (repeat 7)")
  (list))
 (hk-test
  "take from iterate"
  (hk-eval-list "take 5 (iterate (\\x -> x + 1) 0)")
  (list 0 1 2 3 4))
 (hk-test
  "iterate with multiplication"
  (hk-eval-list "take 4 (iterate (\\x -> x * 2) 1)")
  (list 1 2 4 8))
 (hk-test
  "head of repeat"
  (hk-eval-expr-source "head (repeat 99)")
  99)
 ;; ── Fibonacci stream ──
 (hk-test
  "first 10 Fibonacci numbers"
  (hk-eval-list "take 10 fibs")
  (list 0 1 1 2 3 5 8 13 21 34))
 (hk-test
  "fib at position 8"
  (hk-eval-expr-source "head (drop 8 fibs)")
  21)
 ;; ── Building infinite structures in user code ──
 (hk-test
  "user-defined infinite ones"
  (hk-prog-val
    "ones = 1 : ones\nresult = take 6 ones"
    "result")
  (list ":" 1 (list ":" 1 (list ":" 1 (list ":" 1 (list ":" 1 (list ":" 1 (list "[]"))))))))
 (hk-test
  "user-defined nats"
  (hk-prog-val
    "nats = naturalsFrom 1\nnaturalsFrom n = n : naturalsFrom (n + 1)\nresult = take 5 nats"
    "result")
  (list ":" 1 (list ":" 2 (list ":" 3 (list ":" 4 (list ":" 5 (list "[]")))))))
 ;; ── Range syntax ──
 (hk-test
  "finite range [1..5]"
  (hk-eval-list "[1..5]")
  (list 1 2 3 4 5))
 (hk-test
  "empty range when from > to"
  (hk-eval-list "[10..3]")
  (list))
 (hk-test
  "stepped range"
  (hk-eval-list "[1, 3..10]")
  (list 1 3 5 7 9))
 (hk-test
  "open range — head"
  (hk-eval-expr-source "head [1..]")
  1)
 (hk-test
  "open range — drop then head"
  (hk-eval-expr-source "head (drop 99 [1..])")
  100)
 (hk-test
  "open range — take 5"
  (hk-eval-list "take 5 [10..]")
  (list 10 11 12 13 14))
 ;; ── Composing Prelude functions ──
 (hk-test
  "map then filter"
  (hk-eval-list
    "filter (\\x -> x > 5) (map (\\x -> x * 2) [1, 2, 3, 4])")
  (list 6 8))
 (hk-test
  "sum-via-foldless"
  (hk-prog-val
    "mySum [] = 0\nmySum (x:xs) = x + mySum xs\nresult = mySum (take 5 (iterate (\\x -> x + 1) 1))"
    "result")
  15)
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/io-input.sx
+++ b/lib/haskell/tests/io-input.sx
@@ -1,85 +0,0 @@
 ;; io-input.sx — tests for getLine, getContents, readFile, writeFile.
 (hk-test
  "getLine reads single line"
  (hk-run-io-with-input "main = getLine >>= putStrLn" (list "hello"))
  (list "hello"))
 (hk-test
  "getLine reads two lines"
  (hk-run-io-with-input
    "main = do { line1 <- getLine; line2 <- getLine; putStrLn line1; putStrLn line2 }"
    (list "first" "second"))
  (list "first" "second"))
 (hk-test
  "getLine bind in layout do"
  (hk-run-io-with-input
    "main = do\n  line <- getLine\n  putStrLn line"
    (list "world"))
  (list "world"))
 (hk-test
  "getLine echo with prefix"
  (hk-run-io-with-input
    "main = do\n  line <- getLine\n  putStrLn (\"Got: \" ++ line)"
    (list "test"))
  (list "Got: test"))
 (hk-test
  "getContents reads all lines joined"
  (hk-run-io-with-input
    "main = getContents >>= putStr"
    (list "line1" "line2" "line3"))
  (list "line1\nline2\nline3"))
 (hk-test
  "getContents empty stdin"
  (hk-run-io-with-input "main = getContents >>= putStr" (list))
  (list ""))
 (hk-test
  "readFile reads pre-loaded content"
  (begin
    (set! hk-vfs (dict))
    (dict-set! hk-vfs "hello.txt" "Hello, World!")
    (hk-run-io "main = readFile \"hello.txt\" >>= putStrLn"))
  (list "Hello, World!"))
 (hk-test
  "writeFile creates file"
  (begin
    (set! hk-vfs (dict))
    (hk-run-io "main = writeFile \"out.txt\" \"written content\"")
    (get hk-vfs "out.txt"))
  "written content")
 (hk-test
  "writeFile then readFile roundtrip"
  (begin
    (set! hk-vfs (dict))
    (hk-run-io
      "main = do { writeFile \"f.txt\" \"round trip\"; readFile \"f.txt\" >>= putStrLn }"))
  (list "round trip"))
 (hk-test
  "readFile error on missing file"
  (guard
    (e (true (>= (index-of e "file not found") 0)))
    (begin
      (set! hk-vfs (dict))
      (hk-run-io "main = readFile \"no.txt\" >>= putStrLn")
      false))
  true)
 (hk-test
  "getLine then writeFile combined"
  (begin
    (set! hk-vfs (dict))
    (hk-run-io-with-input
      "main = do\n  line <- getLine\n  writeFile \"cap.txt\" line"
      (list "captured"))
    (get hk-vfs "cap.txt"))
  "captured")
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/layout.sx
+++ b/lib/haskell/tests/layout.sx
@@ -1,245 +0,0 @@
 ;; Haskell layout-rule tests. hk-tokenizer + hk-layout produce a
 ;; virtual-brace-annotated stream; these tests cover the algorithm
 ;; from Haskell 98 §10.3 plus the pragmatic let/in single-line rule.
 ;; Convenience — tokenize, run layout, strip eof, keep :type/:value.
 (define
  hk-lay
  (fn
    (src)
    (map
      (fn (tok) {:value (get tok "value") :type (get tok "type")})
      (filter
        (fn (tok) (not (= (get tok "type") "eof")))
        (hk-layout (hk-tokenize src))))))
 ;; ── 1. Basics ──
 (hk-test
  "empty input produces empty module { }"
  (hk-lay "")
  (list
    {:value "{" :type "vlbrace"}
    {:value "}" :type "vrbrace"}))
 (hk-test
  "single token → module open+close"
  (hk-lay "foo")
  (list
    {:value "{" :type "vlbrace"}
    {:value "foo" :type "varid"}
    {:value "}" :type "vrbrace"}))
 (hk-test
  "two top-level decls get vsemi between"
  (hk-lay "foo = 1\nbar = 2")
  (list
    {:value "{" :type "vlbrace"}
    {:value "foo" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value ";" :type "vsemi"}
    {:value "bar" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 2 :type "integer"}
    {:value "}" :type "vrbrace"}))
 ;; ── 2. Layout keywords — do / let / where / of ──
 (hk-test
  "do block with two stmts"
  (hk-lay "f = do\n  x\n  y")
  (list
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "do" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value ";" :type "vsemi"}
    {:value "y" :type "varid"}
    {:value "}" :type "vrbrace"}
    {:value "}" :type "vrbrace"}))
 (hk-test
  "single-line let ... in"
  (hk-lay "let x = 1 in x")
  (list
    {:value "{" :type "vlbrace"}
    {:value "let" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value "}" :type "vrbrace"}
    {:value "in" :type "reserved"}
    {:value "x" :type "varid"}
    {:value "}" :type "vrbrace"}))
 (hk-test
  "where block with two bindings"
  (hk-lay "f = g\n  where\n    g = 1\n    h = 2")
  (list
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "g" :type "varid"}
    {:value "where" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "g" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value ";" :type "vsemi"}
    {:value "h" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 2 :type "integer"}
    {:value "}" :type "vrbrace"}
    {:value "}" :type "vrbrace"}))
 (hk-test
  "case … of with arms"
  (hk-lay "f x = case x of\n  Just y -> y\n  Nothing -> 0")
  (list
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "x" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "case" :type "reserved"}
    {:value "x" :type "varid"}
    {:value "of" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "Just" :type "conid"}
    {:value "y" :type "varid"}
    {:value "->" :type "reservedop"}
    {:value "y" :type "varid"}
    {:value ";" :type "vsemi"}
    {:value "Nothing" :type "conid"}
    {:value "->" :type "reservedop"}
    {:value 0 :type "integer"}
    {:value "}" :type "vrbrace"}
    {:value "}" :type "vrbrace"}))
 ;; ── 3. Explicit braces disable layout ──
 (hk-test
  "explicit braces — no implicit vlbrace/vsemi/vrbrace inside"
  (hk-lay "do { x ; y }")
  (list
    {:value "{" :type "vlbrace"}
    {:value "do" :type "reserved"}
    {:value "{" :type "lbrace"}
    {:value "x" :type "varid"}
    {:value ";" :type "semi"}
    {:value "y" :type "varid"}
    {:value "}" :type "rbrace"}
    {:value "}" :type "vrbrace"}))
 ;; ── 4. Dedent closes nested blocks ──
 (hk-test
  "dedent back to module level closes do block"
  (hk-lay "f = do\n  x\n  y\ng = 2")
  (list
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "do" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value ";" :type "vsemi"}
    {:value "y" :type "varid"}
    {:value "}" :type "vrbrace"}
    {:value ";" :type "vsemi"}
    {:value "g" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 2 :type "integer"}
    {:value "}" :type "vrbrace"}))
 (hk-test
  "dedent closes inner let, emits vsemi at outer do level"
  (hk-lay "main = do\n  let x = 1\n  print x")
  (list
    {:value "{" :type "vlbrace"}
    {:value "main" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "do" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "let" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value "}" :type "vrbrace"}
    {:value ";" :type "vsemi"}
    {:value "print" :type "varid"}
    {:value "x" :type "varid"}
    {:value "}" :type "vrbrace"}
    {:value "}" :type "vrbrace"}))
 ;; ── 5. Module header skips outer implicit open ──
 (hk-test
  "module M where — only where opens a block"
  (hk-lay "module M where\n  f = 1")
  (list
    {:value "module" :type "reserved"}
    {:value "M" :type "conid"}
    {:value "where" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value "}" :type "vrbrace"}))
 ;; ── 6. Newlines are stripped ──
 (hk-test
  "newline tokens do not appear in output"
  (let
    ((toks (hk-layout (hk-tokenize "foo\nbar"))))
    (every?
      (fn (t) (not (= (get t "type") "newline")))
      toks))
  true)
 ;; ── 7. Continuation — deeper indent does NOT emit vsemi ──
 (hk-test
  "line continuation (deeper indent) just merges"
  (hk-lay "foo = 1 +\n   2")
  (list
    {:value "{" :type "vlbrace"}
    {:value "foo" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value "+" :type "varsym"}
    {:value 2 :type "integer"}
    {:value "}" :type "vrbrace"}))
 ;; ── 8. Stack closing at EOF ──
 (hk-test
  "EOF inside nested do closes all implicit blocks"
  (let
    ((toks (hk-lay "main = do\n  do\n    x")))
    (let
      ((n (len toks)))
      (list
        (get (nth toks (- n 1)) "type")
        (get (nth toks (- n 2)) "type")
        (get (nth toks (- n 3)) "type"))))
  (list "vrbrace" "vrbrace" "vrbrace"))
 ;; ── 9. Qualified-newline: x at deeper col than stack top does nothing ──
 (hk-test
  "mixed where + do"
  (hk-lay "f = do\n    x\n  where\n    x = 1")
  (list
    {:value "{" :type "vlbrace"}
    {:value "f" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value "do" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value "}" :type "vrbrace"}
    {:value "where" :type "reserved"}
    {:value "{" :type "vlbrace"}
    {:value "x" :type "varid"}
    {:value "=" :type "reservedop"}
    {:value 1 :type "integer"}
    {:value "}" :type "vrbrace"}
    {:value "}" :type "vrbrace"}))
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/match.sx
+++ b/lib/haskell/tests/match.sx
@@ -1,256 +0,0 @@
 ;; Pattern-matcher tests. The matcher takes (pat val env) and returns
 ;; an extended env dict on success, or `nil` on failure. Constructor
 ;; values are tagged lists (con-name first); tuples use the "Tuple"
 ;; tag; lists use chained `:` cons with `[]` nil.
 ;; ── Atomic patterns ──
 (hk-test
  "wildcard always matches"
  (hk-match (list :p-wild) 42 (dict))
  (dict))
 (hk-test
  "var binds value"
  (hk-match (list :p-var "x") 42 (dict))
  {:x 42})
 (hk-test
  "var preserves prior env"
  (hk-match (list :p-var "y") 7 {:x 1})
  {:x 1 :y 7})
 (hk-test
  "int literal matches equal"
  (hk-match (list :p-int 5) 5 (dict))
  (dict))
 (hk-test
  "int literal fails on mismatch"
  (hk-match (list :p-int 5) 6 (dict))
  nil)
 (hk-test
  "negative int literal matches"
  (hk-match (list :p-int -3) -3 (dict))
  (dict))
 (hk-test
  "string literal matches"
  (hk-match (list :p-string "hi") "hi" (dict))
  (dict))
 (hk-test
  "string literal fails"
  (hk-match (list :p-string "hi") "bye" (dict))
  nil)
 (hk-test
  "char literal matches"
  (hk-match (list :p-char "a") "a" (dict))
  (dict))
 ;; ── Constructor patterns ──
 (hk-test
  "0-arity con matches"
  (hk-match
    (list :p-con "Nothing" (list))
    (hk-mk-con "Nothing" (list))
    (dict))
  (dict))
 (hk-test
  "1-arity con matches and binds"
  (hk-match
    (list :p-con "Just" (list (list :p-var "y")))
    (hk-mk-con "Just" (list 9))
    (dict))
  {:y 9})
 (hk-test
  "con name mismatch fails"
  (hk-match
    (list :p-con "Just" (list (list :p-var "y")))
    (hk-mk-con "Nothing" (list))
    (dict))
  nil)
 (hk-test
  "con arity mismatch fails"
  (hk-match
    (list :p-con "Pair" (list (list :p-var "a") (list :p-var "b")))
    (hk-mk-con "Pair" (list 1))
    (dict))
  nil)
 (hk-test
  "nested con: Just (Just x)"
  (hk-match
    (list
      :p-con
      "Just"
      (list
        (list
          :p-con
          "Just"
          (list (list :p-var "x")))))
    (hk-mk-con "Just" (list (hk-mk-con "Just" (list 42))))
    (dict))
  {:x 42})
 ;; ── Tuple patterns ──
 (hk-test
  "2-tuple matches and binds"
  (hk-match
    (list
      :p-tuple
      (list (list :p-var "a") (list :p-var "b")))
    (hk-mk-tuple (list 10 20))
    (dict))
  {:a 10 :b 20})
 (hk-test
  "tuple arity mismatch fails"
  (hk-match
    (list
      :p-tuple
      (list (list :p-var "a") (list :p-var "b")))
    (hk-mk-tuple (list 10 20 30))
    (dict))
  nil)
 ;; ── List patterns ──
 (hk-test
  "[] pattern matches empty list"
  (hk-match (list :p-list (list)) (hk-mk-nil) (dict))
  (dict))
 (hk-test
  "[] pattern fails on non-empty"
  (hk-match (list :p-list (list)) (hk-mk-list (list 1)) (dict))
  nil)
 (hk-test
  "[a] pattern matches singleton"
  (hk-match
    (list :p-list (list (list :p-var "a")))
    (hk-mk-list (list 7))
    (dict))
  {:a 7})
 (hk-test
  "[a, b] pattern matches pair-list and binds"
  (hk-match
    (list
      :p-list
      (list (list :p-var "a") (list :p-var "b")))
    (hk-mk-list (list 1 2))
    (dict))
  {:a 1 :b 2})
 (hk-test
  "[a, b] fails on too-long list"
  (hk-match
    (list
      :p-list
      (list (list :p-var "a") (list :p-var "b")))
    (hk-mk-list (list 1 2 3))
    (dict))
  nil)
 ;; Cons-style infix pattern (which the parser produces as :p-con ":")
 (hk-test
  "cons (h:t) on non-empty list"
  (hk-match
    (list
      :p-con
      ":"
      (list (list :p-var "h") (list :p-var "t")))
    (hk-mk-list (list 1 2 3))
    (dict))
  {:h 1 :t (list ":" 2 (list ":" 3 (list "[]")))})
 (hk-test
  "cons fails on empty list"
  (hk-match
    (list
      :p-con
      ":"
      (list (list :p-var "h") (list :p-var "t")))
    (hk-mk-nil)
    (dict))
  nil)
 ;; ── as patterns ──
 (hk-test
  "as binds whole + sub-pattern"
  (hk-match
    (list
      :p-as
      "all"
      (list :p-con "Just" (list (list :p-var "x"))))
    (hk-mk-con "Just" (list 99))
    (dict))
  {:all (list "Just" 99) :x 99})
 (hk-test
  "as on wildcard binds whole"
  (hk-match
    (list :p-as "v" (list :p-wild))
    "anything"
    (dict))
  {:v "anything"})
 (hk-test
  "as fails when sub-pattern fails"
  (hk-match
    (list
      :p-as
      "n"
      (list :p-con "Just" (list (list :p-var "x"))))
    (hk-mk-con "Nothing" (list))
    (dict))
  nil)
 ;; ── lazy ~ pattern (eager equivalent for now) ──
 (hk-test
  "lazy pattern eager-matches its inner"
  (hk-match
    (list :p-lazy (list :p-var "y"))
    42
    (dict))
  {:y 42})
 ;; ── Source-driven: parse a real Haskell pattern, match a value ──
 (hk-test
  "parsed pattern: Just x against Just 5"
  (hk-match
    (hk-parse-pat-source "Just x")
    (hk-mk-con "Just" (list 5))
    (dict))
  {:x 5})
 (hk-test
  "parsed pattern: x : xs against [10, 20, 30]"
  (hk-match
    (hk-parse-pat-source "x : xs")
    (hk-mk-list (list 10 20 30))
    (dict))
  {:x 10 :xs (list ":" 20 (list ":" 30 (list "[]")))})
 (hk-test
  "parsed pattern: (a, b) against (1, 2)"
  (hk-match
    (hk-parse-pat-source "(a, b)")
    (hk-mk-tuple (list 1 2))
    (dict))
  {:a 1 :b 2})
 (hk-test
  "parsed pattern: n@(Just x) against Just 7"
  (hk-match
    (hk-parse-pat-source "n@(Just x)")
    (hk-mk-con "Just" (list 7))
    (dict))
  {:n (list "Just" 7) :x 7})
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/parse.sx
+++ b/lib/haskell/tests/parse.sx
@@ -3,8 +3,60 @@
 ;; Lightweight runner: each test checks actual vs expected with
 ;; structural (deep) equality and accumulates pass/fail counters.
 ;; Final value of this file is a summary dict with :pass :fail :fails.
-;; The hk-test / hk-deep=? helpers live in lib/haskell/testlib.sx
+
-;; and are preloaded by lib/haskell/test.sh.
+(define
  hk-deep=?
  (fn
    (a b)
    (cond
      ((= a b) true)
      ((and (dict? a) (dict? b))
        (let
          ((ak (keys a)) (bk (keys b)))
          (if
            (not (= (len ak) (len bk)))
            false
            (every?
              (fn
                (k)
                (and (has-key? b k) (hk-deep=? (get a k) (get b k))))
              ak))))
      ((and (list? a) (list? b))
        (if
          (not (= (len a) (len b)))
          false
          (let
            ((i 0) (ok true))
            (define
              hk-de-loop
              (fn
                ()
                (when
                  (and ok (< i (len a)))
                  (do
                    (when
                      (not (hk-deep=? (nth a i) (nth b i)))
                      (set! ok false))
                    (set! i (+ i 1))
                    (hk-de-loop)))))
            (hk-de-loop)
            ok)))
      (:else false))))
 (define hk-test-pass 0)
 (define hk-test-fail 0)
 (define hk-test-fails (list))
 (define
  hk-test
  (fn
    (name actual expected)
    (if
      (hk-deep=? actual expected)
      (set! hk-test-pass (+ hk-test-pass 1))
      (do
        (set! hk-test-fail (+ hk-test-fail 1))
        (append! hk-test-fails {:actual actual :expected expected :name name})))))
 ;; Convenience: tokenize and drop newline + eof tokens so tests focus
 ;; on meaningful content. Returns list of {:type :value} pairs.
--- a/lib/haskell/tests/parser-case-do.sx
+++ b/lib/haskell/tests/parser-case-do.sx
@@ -1,278 +0,0 @@
 ;; case-of and do-notation parser tests.
 ;; Covers the minimal patterns needed to make these meaningful: var,
 ;; wildcard, literal, constructor (with and without args), tuple, list.
 ;; ── Patterns (in case arms) ──
 (hk-test
  "wildcard pat"
  (hk-parse "case x of _ -> 0")
  (list
    :case
    (list :var "x")
    (list (list :alt (list :p-wild) (list :int 0)))))
 (hk-test
  "var pat"
  (hk-parse "case x of y -> y")
  (list
    :case
    (list :var "x")
    (list
      (list :alt (list :p-var "y") (list :var "y")))))
 (hk-test
  "0-arity constructor pat"
  (hk-parse "case x of\n  Nothing -> 0\n  Just y -> y")
  (list
    :case
    (list :var "x")
    (list
      (list :alt (list :p-con "Nothing" (list)) (list :int 0))
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list :var "y")))))
 (hk-test
  "int literal pat"
  (hk-parse "case n of\n  0 -> 1\n  _ -> n")
  (list
    :case
    (list :var "n")
    (list
      (list :alt (list :p-int 0) (list :int 1))
      (list :alt (list :p-wild) (list :var "n")))))
 (hk-test
  "string literal pat"
  (hk-parse "case s of\n  \"hi\" -> 1\n  _ -> 0")
  (list
    :case
    (list :var "s")
    (list
      (list :alt (list :p-string "hi") (list :int 1))
      (list :alt (list :p-wild) (list :int 0)))))
 (hk-test
  "tuple pat"
  (hk-parse "case p of (a, b) -> a")
  (list
    :case
    (list :var "p")
    (list
      (list
        :alt
        (list
          :p-tuple
          (list (list :p-var "a") (list :p-var "b")))
        (list :var "a")))))
 (hk-test
  "list pat"
  (hk-parse "case xs of\n  [] -> 0\n  [a] -> a")
  (list
    :case
    (list :var "xs")
    (list
      (list :alt (list :p-list (list)) (list :int 0))
      (list
        :alt
        (list :p-list (list (list :p-var "a")))
        (list :var "a")))))
 (hk-test
  "nested constructor pat"
  (hk-parse "case x of\n  Just (a, b) -> a\n  _ -> 0")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list
          :p-con
          "Just"
          (list
            (list
              :p-tuple
              (list (list :p-var "a") (list :p-var "b")))))
        (list :var "a"))
      (list :alt (list :p-wild) (list :int 0)))))
 (hk-test
  "constructor with multiple var args"
  (hk-parse "case t of Pair a b -> a")
  (list
    :case
    (list :var "t")
    (list
      (list
        :alt
        (list
          :p-con
          "Pair"
          (list (list :p-var "a") (list :p-var "b")))
        (list :var "a")))))
 ;; ── case-of shapes ──
 (hk-test
  "case with explicit braces"
  (hk-parse "case x of { Just y -> y ; Nothing -> 0 }")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list :var "y"))
      (list :alt (list :p-con "Nothing" (list)) (list :int 0)))))
 (hk-test
  "case scrutinee is a full expression"
  (hk-parse "case f x + 1 of\n  y -> y")
  (list
    :case
    (list
      :op
      "+"
      (list :app (list :var "f") (list :var "x"))
      (list :int 1))
    (list (list :alt (list :p-var "y") (list :var "y")))))
 (hk-test
  "case arm body is full expression"
  (hk-parse "case x of\n  Just y -> y + 1")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list :op "+" (list :var "y") (list :int 1))))))
 ;; ── do blocks ──
 (hk-test
  "do with two expressions"
  (hk-parse "do\n  putStrLn \"hi\"\n  return 0")
  (list
    :do
    (list
      (list
        :do-expr
        (list :app (list :var "putStrLn") (list :string "hi")))
      (list
        :do-expr
        (list :app (list :var "return") (list :int 0))))))
 (hk-test
  "do with bind"
  (hk-parse "do\n  x <- getLine\n  putStrLn x")
  (list
    :do
    (list
      (list :do-bind (list :p-var "x") (list :var "getLine"))
      (list
        :do-expr
        (list :app (list :var "putStrLn") (list :var "x"))))))
 (hk-test
  "do with let"
  (hk-parse "do\n  let y = 5\n  print y")
  (list
    :do
    (list
      (list
        :do-let
        (list (list :bind (list :p-var "y") (list :int 5))))
      (list
        :do-expr
        (list :app (list :var "print") (list :var "y"))))))
 (hk-test
  "do with multiple let bindings"
  (hk-parse "do\n  let x = 1\n      y = 2\n  print (x + y)")
  (list
    :do
    (list
      (list
        :do-let
        (list
          (list :bind (list :p-var "x") (list :int 1))
          (list :bind (list :p-var "y") (list :int 2))))
      (list
        :do-expr
        (list
          :app
          (list :var "print")
          (list :op "+" (list :var "x") (list :var "y")))))))
 (hk-test
  "do with bind using constructor pat"
  (hk-parse "do\n  Just x <- getMaybe\n  return x")
  (list
    :do
    (list
      (list
        :do-bind
        (list :p-con "Just" (list (list :p-var "x")))
        (list :var "getMaybe"))
      (list
        :do-expr
        (list :app (list :var "return") (list :var "x"))))))
 (hk-test
  "do with explicit braces"
  (hk-parse "do { x <- a ; y <- b ; return (x + y) }")
  (list
    :do
    (list
      (list :do-bind (list :p-var "x") (list :var "a"))
      (list :do-bind (list :p-var "y") (list :var "b"))
      (list
        :do-expr
        (list
          :app
          (list :var "return")
          (list :op "+" (list :var "x") (list :var "y")))))))
 ;; ── Mixing case/do inside expressions ──
 (hk-test
  "case inside let"
  (hk-parse "let f = \\x -> case x of\n                 Just y -> y\n                 _ -> 0\nin f 5")
  (list
    :let
    (list
      (list
        :bind
        (list :p-var "f")
        (list
          :lambda
          (list (list :p-var "x"))
          (list
            :case
            (list :var "x")
            (list
              (list
                :alt
                (list :p-con "Just" (list (list :p-var "y")))
                (list :var "y"))
              (list :alt (list :p-wild) (list :int 0)))))))
    (list :app (list :var "f") (list :int 5))))
 (hk-test
  "lambda containing do"
  (hk-parse "\\x -> do\n  y <- x\n  return y")
  (list
    :lambda
    (list (list :p-var "x"))
    (list
      :do
      (list
        (list :do-bind (list :p-var "y") (list :var "x"))
        (list
          :do-expr
          (list :app (list :var "return") (list :var "y")))))))
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/parser-decls.sx
+++ b/lib/haskell/tests/parser-decls.sx
@@ -1,273 +0,0 @@
 ;; Top-level declarations: function clauses, type signatures, data,
 ;; type, newtype, fixity. Driven by hk-parse-top which produces
 ;; a (:program DECLS) node.
 (define
  hk-prog
  (fn
    (&rest decls)
    (list :program decls)))
 ;; ── Function clauses & pattern bindings ──
 (hk-test
  "simple fun-clause"
  (hk-parse-top "f x = x + 1")
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list :op "+" (list :var "x") (list :int 1)))))
 (hk-test
  "nullary decl"
  (hk-parse-top "answer = 42")
  (hk-prog
    (list :fun-clause "answer" (list) (list :int 42))))
 (hk-test
  "multi-clause fn (separate defs for each pattern)"
  (hk-parse-top "fact 0 = 1\nfact n = n")
  (hk-prog
    (list :fun-clause "fact" (list (list :p-int 0)) (list :int 1))
    (list
      :fun-clause
      "fact"
      (list (list :p-var "n"))
      (list :var "n"))))
 (hk-test
  "constructor pattern in fn args"
  (hk-parse-top "fromJust (Just x) = x")
  (hk-prog
    (list
      :fun-clause
      "fromJust"
      (list (list :p-con "Just" (list (list :p-var "x"))))
      (list :var "x"))))
 (hk-test
  "pattern binding at top level"
  (hk-parse-top "(a, b) = pair")
  (hk-prog
    (list
      :pat-bind
      (list
        :p-tuple
        (list (list :p-var "a") (list :p-var "b")))
      (list :var "pair"))))
 ;; ── Type signatures ──
 (hk-test
  "single-name sig"
  (hk-parse-top "f :: Int -> Int")
  (hk-prog
    (list
      :type-sig
      (list "f")
      (list :t-fun (list :t-con "Int") (list :t-con "Int")))))
 (hk-test
  "multi-name sig"
  (hk-parse-top "f, g, h :: Int -> Bool")
  (hk-prog
    (list
      :type-sig
      (list "f" "g" "h")
      (list :t-fun (list :t-con "Int") (list :t-con "Bool")))))
 (hk-test
  "sig with type application"
  (hk-parse-top "f :: Maybe a -> a")
  (hk-prog
    (list
      :type-sig
      (list "f")
      (list
        :t-fun
        (list :t-app (list :t-con "Maybe") (list :t-var "a"))
        (list :t-var "a")))))
 (hk-test
  "sig with list type"
  (hk-parse-top "len :: [a] -> Int")
  (hk-prog
    (list
      :type-sig
      (list "len")
      (list
        :t-fun
        (list :t-list (list :t-var "a"))
        (list :t-con "Int")))))
 (hk-test
  "sig with tuple and right-assoc ->"
  (hk-parse-top "pair :: a -> b -> (a, b)")
  (hk-prog
    (list
      :type-sig
      (list "pair")
      (list
        :t-fun
        (list :t-var "a")
        (list
          :t-fun
          (list :t-var "b")
          (list
            :t-tuple
            (list (list :t-var "a") (list :t-var "b"))))))))
 (hk-test
  "sig + implementation together"
  (hk-parse-top "id :: a -> a\nid x = x")
  (hk-prog
    (list
      :type-sig
      (list "id")
      (list :t-fun (list :t-var "a") (list :t-var "a")))
    (list
      :fun-clause
      "id"
      (list (list :p-var "x"))
      (list :var "x"))))
 ;; ── data declarations ──
 (hk-test
  "data Maybe"
  (hk-parse-top "data Maybe a = Nothing | Just a")
  (hk-prog
    (list
      :data
      "Maybe"
      (list "a")
      (list
        (list :con-def "Nothing" (list))
        (list :con-def "Just" (list (list :t-var "a")))))))
 (hk-test
  "data Either"
  (hk-parse-top "data Either a b = Left a | Right b")
  (hk-prog
    (list
      :data
      "Either"
      (list "a" "b")
      (list
        (list :con-def "Left" (list (list :t-var "a")))
        (list :con-def "Right" (list (list :t-var "b")))))))
 (hk-test
  "data with no type parameters"
  (hk-parse-top "data Bool = True | False")
  (hk-prog
    (list
      :data
      "Bool"
      (list)
      (list
        (list :con-def "True" (list))
        (list :con-def "False" (list))))))
 (hk-test
  "recursive data type"
  (hk-parse-top "data Tree a = Leaf | Node (Tree a) a (Tree a)")
  (hk-prog
    (list
      :data
      "Tree"
      (list "a")
      (list
        (list :con-def "Leaf" (list))
        (list
          :con-def
          "Node"
          (list
            (list :t-app (list :t-con "Tree") (list :t-var "a"))
            (list :t-var "a")
            (list :t-app (list :t-con "Tree") (list :t-var "a"))))))))
 ;; ── type synonyms ──
 (hk-test
  "simple type synonym"
  (hk-parse-top "type Name = String")
  (hk-prog
    (list :type-syn "Name" (list) (list :t-con "String"))))
 (hk-test
  "parameterised type synonym"
  (hk-parse-top "type Pair a = (a, a)")
  (hk-prog
    (list
      :type-syn
      "Pair"
      (list "a")
      (list
        :t-tuple
        (list (list :t-var "a") (list :t-var "a"))))))
 ;; ── newtype ──
 (hk-test
  "newtype"
  (hk-parse-top "newtype Age = Age Int")
  (hk-prog (list :newtype "Age" (list) "Age" (list :t-con "Int"))))
 (hk-test
  "parameterised newtype"
  (hk-parse-top "newtype Wrap a = Wrap a")
  (hk-prog
    (list :newtype "Wrap" (list "a") "Wrap" (list :t-var "a"))))
 ;; ── fixity declarations ──
 (hk-test
  "infixl with precedence"
  (hk-parse-top "infixl 5 +:, -:")
  (hk-prog (list :fixity "l" 5 (list "+:" "-:"))))
 (hk-test
  "infixr"
  (hk-parse-top "infixr 9 .")
  (hk-prog (list :fixity "r" 9 (list "."))))
 (hk-test
  "infix (non-assoc) default prec"
  (hk-parse-top "infix ==")
  (hk-prog (list :fixity "n" 9 (list "=="))))
 (hk-test
  "fixity with backtick operator name"
  (hk-parse-top "infixl 7 `div`")
  (hk-prog (list :fixity "l" 7 (list "div"))))
 ;; ── Several decls combined ──
 (hk-test
  "mixed: data + sig + fn + type"
  (hk-parse-top "data Maybe a = Nothing | Just a\ntype Entry = Maybe Int\nf :: Entry -> Int\nf (Just x) = x\nf Nothing = 0")
  (hk-prog
    (list
      :data
      "Maybe"
      (list "a")
      (list
        (list :con-def "Nothing" (list))
        (list :con-def "Just" (list (list :t-var "a")))))
    (list
      :type-syn
      "Entry"
      (list)
      (list :t-app (list :t-con "Maybe") (list :t-con "Int")))
    (list
      :type-sig
      (list "f")
      (list :t-fun (list :t-con "Entry") (list :t-con "Int")))
    (list
      :fun-clause
      "f"
      (list (list :p-con "Just" (list (list :p-var "x"))))
      (list :var "x"))
    (list
      :fun-clause
      "f"
      (list (list :p-con "Nothing" (list)))
      (list :int 0))))
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/parser-expr.sx
+++ b/lib/haskell/tests/parser-expr.sx
@@ -1,258 +0,0 @@
 ;; Haskell expression parser tests.
 ;; hk-parse tokenises, runs layout, then parses. Output is an AST
 ;; whose head is a keyword tag (evaluates to its string name).
 ;; ── 1. Literals ──
 (hk-test "integer" (hk-parse "42") (list :int 42))
 (hk-test "float" (hk-parse "3.14") (list :float 3.14))
 (hk-test "string" (hk-parse "\"hi\"") (list :string "hi"))
 (hk-test "char" (hk-parse "'a'") (list :char "a"))
 ;; ── 2. Variables and constructors ──
 (hk-test "varid" (hk-parse "foo") (list :var "foo"))
 (hk-test "conid" (hk-parse "Nothing") (list :con "Nothing"))
 (hk-test "qvarid" (hk-parse "Data.Map.lookup") (list :var "Data.Map.lookup"))
 (hk-test "qconid" (hk-parse "Data.Map") (list :con "Data.Map"))
 ;; ── 3. Parens / unit / tuple ──
 (hk-test "parens strip" (hk-parse "(42)") (list :int 42))
 (hk-test "unit" (hk-parse "()") (list :con "()"))
 (hk-test
  "2-tuple"
  (hk-parse "(1, 2)")
  (list :tuple (list (list :int 1) (list :int 2))))
 (hk-test
  "3-tuple"
  (hk-parse "(x, y, z)")
  (list
    :tuple
    (list (list :var "x") (list :var "y") (list :var "z"))))
 ;; ── 4. Lists ──
 (hk-test "empty list" (hk-parse "[]") (list :list (list)))
 (hk-test
  "singleton list"
  (hk-parse "[1]")
  (list :list (list (list :int 1))))
 (hk-test
  "list of ints"
  (hk-parse "[1, 2, 3]")
  (list
    :list
    (list (list :int 1) (list :int 2) (list :int 3))))
 (hk-test
  "range"
  (hk-parse "[1..10]")
  (list :range (list :int 1) (list :int 10)))
 (hk-test
  "range with step"
  (hk-parse "[1, 3..10]")
  (list
    :range-step
    (list :int 1)
    (list :int 3)
    (list :int 10)))
 ;; ── 5. Application ──
 (hk-test
  "one-arg app"
  (hk-parse "f x")
  (list :app (list :var "f") (list :var "x")))
 (hk-test
  "multi-arg app is left-assoc"
  (hk-parse "f x y z")
  (list
    :app
    (list
      :app
      (list :app (list :var "f") (list :var "x"))
      (list :var "y"))
    (list :var "z")))
 (hk-test
  "app with con"
  (hk-parse "Just 5")
  (list :app (list :con "Just") (list :int 5)))
 ;; ── 6. Infix operators ──
 (hk-test
  "simple +"
  (hk-parse "1 + 2")
  (list :op "+" (list :int 1) (list :int 2)))
 (hk-test
  "precedence: * binds tighter than +"
  (hk-parse "1 + 2 * 3")
  (list
    :op
    "+"
    (list :int 1)
    (list :op "*" (list :int 2) (list :int 3))))
 (hk-test
  "- is left-assoc"
  (hk-parse "10 - 3 - 2")
  (list
    :op
    "-"
    (list :op "-" (list :int 10) (list :int 3))
    (list :int 2)))
 (hk-test
  ": is right-assoc"
  (hk-parse "a : b : c")
  (list
    :op
    ":"
    (list :var "a")
    (list :op ":" (list :var "b") (list :var "c"))))
 (hk-test
  "app binds tighter than op"
  (hk-parse "f x + g y")
  (list
    :op
    "+"
    (list :app (list :var "f") (list :var "x"))
    (list :app (list :var "g") (list :var "y"))))
 (hk-test
  "$ is lowest precedence, right-assoc"
  (hk-parse "f $ g x")
  (list
    :op
    "$"
    (list :var "f")
    (list :app (list :var "g") (list :var "x"))))
 ;; ── 7. Backticks (varid-as-operator) ──
 (hk-test
  "backtick operator"
  (hk-parse "x `mod` 3")
  (list :op "mod" (list :var "x") (list :int 3)))
 ;; ── 8. Unary negation ──
 (hk-test
  "unary -"
  (hk-parse "- 5")
  (list :neg (list :int 5)))
 (hk-test
  "unary - on application"
  (hk-parse "- f x")
  (list :neg (list :app (list :var "f") (list :var "x"))))
 (hk-test
  "- n + m → (- n) + m"
  (hk-parse "- 1 + 2")
  (list
    :op
    "+"
    (list :neg (list :int 1))
    (list :int 2)))
 ;; ── 9. Lambda ──
 (hk-test
  "lambda single param"
  (hk-parse "\\x -> x")
  (list :lambda (list (list :p-var "x")) (list :var "x")))
 (hk-test
  "lambda multi-param"
  (hk-parse "\\x y -> x + y")
  (list
    :lambda
    (list (list :p-var "x") (list :p-var "y"))
    (list :op "+" (list :var "x") (list :var "y"))))
 (hk-test
  "lambda body is full expression"
  (hk-parse "\\f -> f 1 + f 2")
  (list
    :lambda
    (list (list :p-var "f"))
    (list
      :op
      "+"
      (list :app (list :var "f") (list :int 1))
      (list :app (list :var "f") (list :int 2)))))
 ;; ── 10. if-then-else ──
 (hk-test
  "if basic"
  (hk-parse "if x then 1 else 2")
  (list :if (list :var "x") (list :int 1) (list :int 2)))
 (hk-test
  "if with infix cond"
  (hk-parse "if x == 0 then y else z")
  (list
    :if
    (list :op "==" (list :var "x") (list :int 0))
    (list :var "y")
    (list :var "z")))
 ;; ── 11. let-in ──
 (hk-test
  "let single binding"
  (hk-parse "let x = 1 in x")
  (list
    :let
    (list (list :bind (list :p-var "x") (list :int 1)))
    (list :var "x")))
 (hk-test
  "let two bindings (multi-line)"
  (hk-parse "let x = 1\n    y = 2\nin x + y")
  (list
    :let
    (list
      (list :bind (list :p-var "x") (list :int 1))
      (list :bind (list :p-var "y") (list :int 2)))
    (list :op "+" (list :var "x") (list :var "y"))))
 (hk-test
  "let with explicit braces"
  (hk-parse "let { x = 1 ; y = 2 } in x + y")
  (list
    :let
    (list
      (list :bind (list :p-var "x") (list :int 1))
      (list :bind (list :p-var "y") (list :int 2)))
    (list :op "+" (list :var "x") (list :var "y"))))
 ;; ── 12. Mixed / nesting ──
 (hk-test
  "nested application"
  (hk-parse "f (g x) y")
  (list
    :app
    (list
      :app
      (list :var "f")
      (list :app (list :var "g") (list :var "x")))
    (list :var "y")))
 (hk-test
  "lambda applied"
  (hk-parse "(\\x -> x + 1) 5")
  (list
    :app
    (list
      :lambda
      (list (list :p-var "x"))
      (list :op "+" (list :var "x") (list :int 1)))
    (list :int 5)))
 (hk-test
  "lambda + if"
  (hk-parse "\\n -> if n == 0 then 1 else n")
  (list
    :lambda
    (list (list :p-var "n"))
    (list
      :if
      (list :op "==" (list :var "n") (list :int 0))
      (list :int 1)
      (list :var "n"))))
 ;; ── 13. Precedence corners ──
 (hk-test
  ". is right-assoc (prec 9)"
  (hk-parse "f . g . h")
  (list
    :op
    "."
    (list :var "f")
    (list :op "." (list :var "g") (list :var "h"))))
 (hk-test
  "== is non-associative (single use)"
  (hk-parse "x == y")
  (list :op "==" (list :var "x") (list :var "y")))
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/lib/haskell/tests/parser-guards-where.sx
+++ b/lib/haskell/tests/parser-guards-where.sx
@@ -1,261 +0,0 @@
 ;; Guards and where-clauses — on fun-clauses, case alts, and
 ;; let-bindings (which now also accept funclause-style LHS like
 ;; `let f x = e` or `let f x | g = e | g = e`).
 (define
  hk-prog
  (fn (&rest decls) (list :program decls)))
 ;; ── Guarded fun-clauses ──
 (hk-test
  "simple guards (two branches)"
  (hk-parse-top "abs x | x < 0 = - x\n      | otherwise = x")
  (hk-prog
    (list
      :fun-clause
      "abs"
      (list (list :p-var "x"))
      (list
        :guarded
        (list
          (list
            :guard
            (list :op "<" (list :var "x") (list :int 0))
            (list :neg (list :var "x")))
          (list :guard (list :var "otherwise") (list :var "x")))))))
 (hk-test
  "three-way guard"
  (hk-parse-top "sign n | n > 0 = 1\n       | n < 0 = -1\n       | otherwise = 0")
  (hk-prog
    (list
      :fun-clause
      "sign"
      (list (list :p-var "n"))
      (list
        :guarded
        (list
          (list
            :guard
            (list :op ">" (list :var "n") (list :int 0))
            (list :int 1))
          (list
            :guard
            (list :op "<" (list :var "n") (list :int 0))
            (list :neg (list :int 1)))
          (list
            :guard
            (list :var "otherwise")
            (list :int 0)))))))
 (hk-test
  "mixed: one eq clause plus one guarded clause"
  (hk-parse-top "sign 0 = 0\nsign n | n > 0 = 1\n       | otherwise = -1")
  (hk-prog
    (list
      :fun-clause
      "sign"
      (list (list :p-int 0))
      (list :int 0))
    (list
      :fun-clause
      "sign"
      (list (list :p-var "n"))
      (list
        :guarded
        (list
          (list
            :guard
            (list :op ">" (list :var "n") (list :int 0))
            (list :int 1))
          (list
            :guard
            (list :var "otherwise")
            (list :neg (list :int 1))))))))
 ;; ── where on fun-clauses ──
 (hk-test
  "where with one binding"
  (hk-parse-top "f x = y + y\n  where y = x + 1")
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :where
        (list :op "+" (list :var "y") (list :var "y"))
        (list
          (list
            :fun-clause
            "y"
            (list)
            (list :op "+" (list :var "x") (list :int 1))))))))
 (hk-test
  "where with multiple bindings"
  (hk-parse-top "f x = y * z\n  where y = x + 1\n        z = x - 1")
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :where
        (list :op "*" (list :var "y") (list :var "z"))
        (list
          (list
            :fun-clause
            "y"
            (list)
            (list :op "+" (list :var "x") (list :int 1)))
          (list
            :fun-clause
            "z"
            (list)
            (list :op "-" (list :var "x") (list :int 1))))))))
 (hk-test
  "guards + where"
  (hk-parse-top "f x | x > 0 = y\n    | otherwise = 0\n  where y = 99")
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :where
        (list
          :guarded
          (list
            (list
              :guard
              (list :op ">" (list :var "x") (list :int 0))
              (list :var "y"))
            (list
              :guard
              (list :var "otherwise")
              (list :int 0))))
        (list
          (list :fun-clause "y" (list) (list :int 99)))))))
 ;; ── Guards in case alts ──
 (hk-test
  "case alt with guards"
  (hk-parse "case x of\n  Just y | y > 0 -> y\n         | otherwise -> 0\n  Nothing -> 0")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list
          :guarded
          (list
            (list
              :guard
              (list :op ">" (list :var "y") (list :int 0))
              (list :var "y"))
            (list
              :guard
              (list :var "otherwise")
              (list :int 0)))))
      (list :alt (list :p-con "Nothing" (list)) (list :int 0)))))
 (hk-test
  "case alt with where"
  (hk-parse "case x of\n  Just y -> y + z where z = 5\n  Nothing -> 0")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list
          :where
          (list :op "+" (list :var "y") (list :var "z"))
          (list
            (list :fun-clause "z" (list) (list :int 5)))))
      (list :alt (list :p-con "Nothing" (list)) (list :int 0)))))
 ;; ── let-bindings: funclause form, guards, where ──
 (hk-test
  "let with funclause shorthand"
  (hk-parse "let f x = x + 1 in f 5")
  (list
    :let
    (list
      (list
        :fun-clause
        "f"
        (list (list :p-var "x"))
        (list :op "+" (list :var "x") (list :int 1))))
    (list :app (list :var "f") (list :int 5))))
 (hk-test
  "let with guards"
  (hk-parse "let f x | x > 0 = x\n        | otherwise = 0\nin f 3")
  (list
    :let
    (list
      (list
        :fun-clause
        "f"
        (list (list :p-var "x"))
        (list
          :guarded
          (list
            (list
              :guard
              (list :op ">" (list :var "x") (list :int 0))
              (list :var "x"))
            (list
              :guard
              (list :var "otherwise")
              (list :int 0))))))
    (list :app (list :var "f") (list :int 3))))
 (hk-test
  "let funclause + where"
  (hk-parse "let f x = y where y = x + 1\nin f 7")
  (list
    :let
    (list
      (list
        :fun-clause
        "f"
        (list (list :p-var "x"))
        (list
          :where
          (list :var "y")
          (list
            (list
              :fun-clause
              "y"
              (list)
              (list :op "+" (list :var "x") (list :int 1)))))))
    (list :app (list :var "f") (list :int 7))))
 ;; ── Nested: where inside where (via recursive hk-parse-decl) ──
 (hk-test
  "where block can contain a type signature"
  (hk-parse-top "f x = y\n  where y :: Int\n        y = x")
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :where
        (list :var "y")
        (list
          (list :type-sig (list "y") (list :t-con "Int"))
          (list
            :fun-clause
            "y"
            (list)
            (list :var "x")))))))
 {:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}
--- a/Show More
+++ b/Show More