(** Test runner — runs the SX spec test suite against the transpiled CEK evaluator.

    Provides the 5 platform functions required by test-framework.sx:
      try-call, report-pass, report-fail, push-suite, pop-suite

    Plus test helpers: sx-parse, cek-eval, env-*, equal?, etc.

    Usage:
      dune exec bin/run_tests.exe                    # foundation + spec tests
      dune exec bin/run_tests.exe -- test-primitives  # specific test
      dune exec bin/run_tests.exe -- --foundation     # foundation only *)

(* Modules accessed directly — library is unwrapped *)

open Sx_types
open Sx_parser
open Sx_primitives
open Sx_runtime
open Sx_ref

(* ====================================================================== *)
(* Test state                                                              *)
(* ====================================================================== *)

let pass_count = ref 0
let fail_count = ref 0
let suite_stack : string list ref = ref []
(* Test filter: when Some, only run tests (suite, name) in the set.
   Populated by --only-failing=FILE from lines like "FAIL: suite > name: error". *)
let suite_filter : (string * string, unit) Hashtbl.t option ref = ref None

(* ====================================================================== *)
(* Deep equality — SX structural comparison                                *)
(* ====================================================================== *)

let rec deep_equal a b =
  match a, b with
  | Nil, Nil -> true
  | Bool a, Bool b -> a = b
  | Number a, Number b -> a = b
  | String a, String b -> a = b
  | Symbol a, Symbol b -> a = b
  | Keyword a, Keyword b -> a = b
  | (List a | ListRef { contents = a }), (List b | ListRef { contents = b }) ->
    List.length a = List.length b &&
    List.for_all2 deep_equal a b
  | Dict a, Dict b ->
    let ka = Hashtbl.fold (fun k _ acc -> k :: acc) a [] in
    let kb = Hashtbl.fold (fun k _ acc -> k :: acc) b [] in
    List.length ka = List.length kb &&
    List.for_all (fun k ->
      Hashtbl.mem b k &&
      deep_equal
        (match Hashtbl.find_opt a k with Some v -> v | None -> Nil)
        (match Hashtbl.find_opt b k with Some v -> v | None -> Nil)) ka
  | Record a, Record b ->
    a.r_type.rt_uid = b.r_type.rt_uid &&
    Array.length a.r_fields = Array.length b.r_fields &&
    (let eq = ref true in
     for i = 0 to Array.length a.r_fields - 1 do
       if not (deep_equal a.r_fields.(i) b.r_fields.(i)) then eq := false
     done; !eq)
  | Lambda _, Lambda _ -> a == b  (* identity *)
  | NativeFn _, NativeFn _ -> a == b
  | _ -> false

(* ====================================================================== *)
(* Build evaluator environment with test platform functions                *)
(* ====================================================================== *)

let make_test_env () =
  let env = Sx_types.make_env () in

  let bind name fn =
    ignore (Sx_types.env_bind env name (NativeFn (name, fn)))
  in

  (* --- platform functions required by test-framework.sx --- *)

  bind "cek-try" (fun args ->
    match args with
    | [thunk; handler] ->
      (try Sx_ref.cek_call thunk Nil
       with Eval_error msg -> Sx_ref.cek_call handler (List [String msg]))
    | [thunk] ->
      (try let r = Sx_ref.cek_call thunk Nil in
        List [Symbol "ok"; r]
       with Eval_error msg -> List [Symbol "error"; String msg])
    | _ -> Nil);

  (* Two-phase try-call: first attempt runs in-process (fast, state-sharing).
     If a test hangs (detected by SIGALRM), retry it in a fork for safe timeout. *)
  let _test_timed_out = ref false in
  Sys.set_signal Sys.sigalrm (Sys.Signal_handle (fun _ ->
    _test_timed_out := true;
    (* Set step_limit to trigger check in VM instruction loop *)
    Sx_ref.step_limit := 1;
    (* Also raise to break native OCaml loops (HS parser etc.) *)
    raise (Eval_error "TIMEOUT: test exceeded 5s")));

  bind "try-call" (fun args ->
    match args with
    | [thunk] ->
      _test_timed_out := false;
      Sx_ref.step_limit := 0;
      Sx_ref.step_count := 0;
      ignore (Unix.alarm 5);
      (try
        let result = eval_expr (List [thunk]) (Env env) in
        ignore result;
        ignore (Unix.alarm 0);
        Sx_ref.step_limit := 0;
        let d = Hashtbl.create 2 in
        Hashtbl.replace d "ok" (Bool true);
        Dict d
      with
      | Eval_error msg ->
        ignore (Unix.alarm 0);
        Sx_ref.step_limit := 0;
        let d = Hashtbl.create 2 in
        Hashtbl.replace d "ok" (Bool false);
        Hashtbl.replace d "error" (String (if !_test_timed_out then "TIMEOUT: test exceeded 5s" else msg));
        Dict d
      | exn ->
        ignore (Unix.alarm 0);
        Sx_ref.step_limit := 0;
        let d = Hashtbl.create 2 in
        Hashtbl.replace d "ok" (Bool false);
        Hashtbl.replace d "error" (String (Printexc.to_string exn));
        Dict d)
    | _ -> raise (Eval_error "try-call: expected 1 arg"));

  bind "report-pass" (fun args ->
    match args with
    | [String name] ->
      incr pass_count;
      let ctx = String.concat " > " (List.rev !suite_stack) in
      Printf.printf "  PASS: %s > %s\n%!" ctx name;
      Nil
    | [v] ->
      incr pass_count;
      let ctx = String.concat " > " (List.rev !suite_stack) in
      Printf.printf "  PASS: %s > %s\n%!" ctx (Sx_types.inspect v);
      Nil
    | _ -> raise (Eval_error "report-pass: expected 1 arg"));

  bind "report-fail" (fun args ->
    match args with
    | [String name; String error] ->
      incr fail_count;
      let ctx = String.concat " > " (List.rev !suite_stack) in
      Printf.printf "  FAIL: %s > %s: %s\n%!" ctx name error;
      Nil
    | [name_v; error_v] ->
      incr fail_count;
      let ctx = String.concat " > " (List.rev !suite_stack) in
      Printf.printf "  FAIL: %s > %s: %s\n%!" ctx
        (Sx_types.value_to_string name_v)
        (Sx_types.value_to_string error_v);
      Nil
    | _ -> raise (Eval_error "report-fail: expected 2 args"));

  bind "push-suite" (fun args ->
    match args with
    | [String name] ->
      suite_stack := name :: !suite_stack;
      let indent = String.make ((List.length !suite_stack - 1) * 2) ' ' in
      Printf.printf "%sSuite: %s\n%!" indent name;
      Nil
    | [v] ->
      let name = Sx_types.value_to_string v in
      suite_stack := name :: !suite_stack;
      let indent = String.make ((List.length !suite_stack - 1) * 2) ' ' in
      Printf.printf "%sSuite: %s\n%!" indent name;
      Nil
    | _ -> raise (Eval_error "push-suite: expected 1 arg"));

  bind "pop-suite" (fun _args ->
    suite_stack := (match !suite_stack with _ :: t -> t | [] -> []);
    Nil);

  bind "test-allowed?" (fun args ->
    match !suite_filter with
    | None -> Bool true
    | Some filter ->
      let name = match args with
        | [String s] -> s
        | [v] -> Sx_types.value_to_string v
        | _ -> "" in
      let suite = match !suite_stack with [] -> "" | s :: _ -> s in
      Bool (Hashtbl.mem filter (suite, name)));

  (* --- Test helpers --- *)

  bind "sx-parse" (fun args ->
    match args with
    | [String s] -> List (parse_all s)
    | _ -> raise (Eval_error "sx-parse: expected string"));

  bind "sx-parse-loc" (fun args ->
    match args with
    | [String s] ->
      let cst = Sx_parser.parse_all_cst s in
      List (Sx_cst.cst_to_ast_loc s cst.nodes)
    | _ -> raise (Eval_error "sx-parse-loc: expected string"));

  bind "source-loc" (fun args ->
    match args with
    | [Dict d] ->
      let line = try Hashtbl.find d "line" with Not_found -> Nil in
      let col = try Hashtbl.find d "col" with Not_found -> Nil in
      let ld = Sx_types.make_dict () in
      Sx_types.dict_set ld "line" line;
      Sx_types.dict_set ld "col" col;
      Dict ld
    | _ -> Nil);

  (* Step 15: bytecode + CEK state serialization *)
  bind "bytecode-serialize" (fun args ->
    match args with
    | [v] -> String ("(sxbc 2 " ^ Sx_types.inspect v ^ ")")
    | _ -> raise (Eval_error "bytecode-serialize: expected 1 arg"));

  bind "bytecode-deserialize" (fun args ->
    match args with
    | [String s] ->
      let parsed = Sx_parser.parse_all s in
      (match parsed with
       | [List (Symbol "sxbc" :: Number _ :: payload :: _)] -> payload
       | _ -> raise (Eval_error "bytecode-deserialize: invalid sxbc format"))
    | _ -> raise (Eval_error "bytecode-deserialize: expected string"));

  bind "cek-serialize" (fun args ->
    match args with
    | [v] -> String ("(cek-state 1 " ^ Sx_types.inspect v ^ ")")
    | _ -> raise (Eval_error "cek-serialize: expected 1 arg"));

  bind "cek-deserialize" (fun args ->
    match args with
    | [String s] ->
      let parsed = Sx_parser.parse_all s in
      (match parsed with
       | [List (Symbol "cek-state" :: Number _ :: payload :: _)] -> payload
       | _ -> raise (Eval_error "cek-deserialize: invalid cek-state format"))
    | _ -> raise (Eval_error "cek-deserialize: expected string"));

  bind "sx-parse-one" (fun args ->
    match args with
    | [String s] ->
      let exprs = parse_all s in
      (match exprs with e :: _ -> e | [] -> Nil)
    | _ -> raise (Eval_error "sx-parse-one: expected string"));

  bind "cek-eval" (fun args ->
    match args with
    | [String s] ->
      let exprs = parse_all s in
      (match exprs with
       | e :: _ -> eval_expr e (Env env)
       | [] -> Nil)
    | _ -> raise (Eval_error "cek-eval: expected string"));

  bind "eval-expr-cek" (fun args ->
    match args with
    | [expr; e] -> eval_expr expr e
    | [expr] -> eval_expr expr (Env env)
    | _ -> raise (Eval_error "eval-expr-cek: expected 1-2 args"));

  bind "test-env" (fun _args -> Env (Sx_types.env_extend env));

  (* --- Environment operations --- *)

  (* Env operations — accept both Env and Dict *)
  let uw = Sx_runtime.unwrap_env in
  bind "env-get" (fun args ->
    match args with
    | [e; String k] -> Sx_types.env_get (uw e) k
    | [e; Keyword k] -> Sx_types.env_get (uw e) k
    | _ -> raise (Eval_error "env-get: expected env and string"));

  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
    | [Dict d; String k; v] -> Hashtbl.replace d k v; v
    | [Dict d; Keyword k; v] -> Hashtbl.replace d k v; v
    | [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 "make-env" (fun _args -> Env (Sx_types.make_env ()));

  bind "env-extend" (fun args ->
    match args with
    | [e] -> Env (Sx_types.env_extend (uw e))
    | _ -> raise (Eval_error "env-extend: expected env"));

  bind "env-merge" (fun args ->
    match args with
    | [a; b] -> Sx_runtime.env_merge a b
    | _ -> raise (Eval_error "env-merge: expected 2 envs"));

  (* --- Equality --- *)

  bind "equal?" (fun args ->
    match args with
    | [a; b] -> Bool (deep_equal a b)
    | _ -> raise (Eval_error "equal?: expected 2 args"));

  bind "identical?" (fun args ->
    match args with
    | [a; b] -> Bool (match a, b with
      | Number x, Number y -> x = y
      | String x, String y -> x = y
      | Bool x, Bool y -> x = y
      | Nil, Nil -> true
      | _ -> a == b)
    | _ -> raise (Eval_error "identical?: expected 2 args"));

  (* --- Continuation support --- *)

  bind "make-continuation" (fun args ->
    match args with
    | [f] ->
      let k v = sx_call f [v] in
      Continuation (k, None)
    | _ -> raise (Eval_error "make-continuation: expected 1 arg"));

  bind "continuation?" (fun args ->
    match args with
    | [Continuation _] -> Bool true
    | [_] -> Bool false
    | _ -> raise (Eval_error "continuation?: expected 1 arg"));

  bind "continuation-fn" (fun args ->
    match args with
    | [Continuation (f, _)] -> NativeFn ("continuation-fn-result", fun args ->
        match args with [v] -> f v | _ -> f Nil)
    | _ -> raise (Eval_error "continuation-fn: expected continuation"));

  (* --- Core builtins used by test framework / test code --- *)

  bind "assert" (fun args ->
    match args with
    | [cond] ->
      if not (sx_truthy cond) then raise (Eval_error "Assertion failed");
      Bool true
    | [cond; String msg] ->
      if not (sx_truthy cond) then raise (Eval_error ("Assertion error: " ^ msg));
      Bool true
    | [cond; msg] ->
      if not (sx_truthy cond) then
        raise (Eval_error ("Assertion error: " ^ Sx_types.value_to_string msg));
      Bool true
    | _ -> raise (Eval_error "assert: expected 1-2 args"));

  bind "append!" (fun args ->
    match args with
    | [ListRef r; v; Number n] when int_of_float n = 0 ->
      r := v :: !r; ListRef r  (* prepend *)
    | [ListRef r; v] -> r := !r @ [v]; ListRef r  (* append in place *)
    | [List items; v; Number n] when int_of_float n = 0 ->
      List (v :: items)  (* immutable prepend *)
    | [List items; v] -> List (items @ [v])  (* immutable fallback *)
    | _ -> raise (Eval_error "append!: expected list and value"));

  (* --- HTML Renderer (from sx_render.ml library module) --- *)
  Sx_render.setup_render_env env;

  (* HTML tag functions — bind all tags as native fns returning (tag ...args) *)
  List.iter (fun tag ->
    ignore (Sx_types.env_bind env tag
      (NativeFn ("html:" ^ tag, fun args -> List (Symbol tag :: args))))
  ) Sx_render.html_tags;
  bind "is-html-tag?" (fun args -> match args with [String s] -> Bool (Sx_render.is_html_tag s) | _ -> Bool false);

  (* Stubs needed by adapter-html.sx when loaded at test time *)
  bind "set-render-active!" (fun _args -> Nil);
  bind "render-active?" (fun _args -> Bool true);
  bind "trampoline" (fun args ->
    match args with
    | [Thunk (expr, e)] -> eval_expr expr (Env e)
    | [v] -> v
    | _ -> Nil);
  bind "eval-expr" (fun args ->
    match args with
    | [expr; e] ->
      (match e with
       | Dict _ -> Printf.eprintf "[EVAL-EXPR] env is Dict! expr=%s\n%!" (Sx_runtime.value_to_str expr)
       | Nil -> Printf.eprintf "[EVAL-EXPR] env is Nil! expr=%s\n%!" (Sx_runtime.value_to_str expr)
       | _ -> ());
      let ue = Sx_runtime.unwrap_env e in
      eval_expr expr (Env ue)
    | [expr] -> eval_expr expr (Env env)
    | _ -> raise (Eval_error "eval-expr: expected (expr env)"));
  bind "set-render-active!" (fun _args -> Nil);
  (* render-to-sx wrapper: if called with a string, parse and aser it *)
  bind "render-to-sx" (fun args ->
    match args with
    | [String src] ->
      let exprs = Sx_parser.parse_all src in
      let expr = match exprs with [e] -> e | es -> List (Symbol "do" :: es) in
      let result = eval_expr (List [Symbol "aser"; expr; Env env]) (Env env) in
      (match result with SxExpr s -> String s | String s -> String s | _ -> String (Sx_runtime.value_to_str result))
    | [expr; Env e] ->
      let result = eval_expr (List [Symbol "aser"; expr; Env e]) (Env e) in
      (match result with SxExpr s -> String s | String s -> String s | _ -> String (Sx_runtime.value_to_str result))
    | _ -> String "");
  (* Scope primitives — share the same scope stacks as sx_primitives.ml
     so that CEK evaluator's scope_push/scope_peek and SX-level scope-push!/scope-peek
     operate on the same table. *)
  let _scope_stacks = Sx_primitives._scope_stacks in
  bind "scope-push!" (fun args ->
    match args with
    | [String name; value] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      Hashtbl.replace _scope_stacks name (value :: stack); Nil
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      Hashtbl.replace _scope_stacks name (Nil :: stack); Nil
    | _ -> Nil);
  bind "scope-pop!" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
    | _ -> Nil);
  bind "scope-peek" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with v :: _ -> v | [] -> Nil)
    | _ -> Nil);
  let context_fn = (fun args ->
    match args with
    | String name :: rest ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with v :: _ -> v | [] -> (match rest with d :: _ -> d | [] -> Nil))
    | _ -> Nil) in
  bind "context" context_fn;
  Sx_primitives.register "context" context_fn;
  bind "scope-emit!" (fun args ->
    match args with
    | [String name; value] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with
       | List items :: rest ->
         Hashtbl.replace _scope_stacks name (List (items @ [value]) :: rest)
       | _ :: rest ->
         Hashtbl.replace _scope_stacks name (List [value] :: rest)
       | [] ->
         Hashtbl.replace _scope_stacks name [List [value]]);
      Nil
    | _ -> Nil);
  bind "emitted" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with List items :: _ -> List items | _ -> List [])
    | _ -> List []);
  bind "scope-emitted" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with List items :: _ -> List items | _ -> List [])
    | _ -> List []);
  bind "provide-push!" (fun args ->
    match args with
    | [String name; value] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      Hashtbl.replace _scope_stacks name (value :: stack); Nil
    | _ -> Nil);
  bind "provide-pop!" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
    | _ -> Nil);
  bind "cond-scheme?" (fun args ->
    match args with
    | [(List clauses | ListRef { contents = clauses })] ->
      Bool (List.for_all (fun c ->
        match c with
        | List l | ListRef { contents = l } -> List.length l = 2
        | _ -> false
      ) clauses)
    | _ -> Bool false);
  bind "expand-macro" (fun args ->
    match args with
    | [Macro m; (List a | ListRef { contents = a }); _] ->
      let local = Sx_types.env_extend m.m_closure in
      let rec bind_params ps as' =
        match ps, as' with
        | [], rest ->
          (match m.m_rest_param with
           | Some rp -> ignore (Sx_types.env_bind local rp (List rest))
           | None -> ())
        | p :: ps_rest, a :: as_rest ->
          ignore (Sx_types.env_bind local p a);
          bind_params ps_rest as_rest
        | remaining, [] ->
          List.iter (fun p -> ignore (Sx_types.env_bind local p Nil)) remaining
      in
      bind_params m.m_params a;
      eval_expr m.m_body (Env local)
    | _ -> raise (Eval_error "expand-macro: expected (macro args env)"));

  bind "cek-call" (fun args ->
    match args with
    | [fn_val; List call_args] -> Sx_ref.cek_call fn_val (List call_args)
    | [fn_val; ListRef { contents = call_args }] -> Sx_ref.cek_call fn_val (List call_args)
    | [fn_val; Nil] -> Sx_ref.cek_call fn_val (List [])
    | [fn_val] -> Sx_ref.cek_call fn_val (List [])
    | _ -> Nil);
  bind "cek-run" (fun args ->
    match args with
    | [state] -> Sx_ref.cek_run state
    | _ -> Nil);
  bind "without-io-hook" (fun args ->
    match args with
    | [thunk] ->
      let saved_hook = !Sx_types._cek_io_suspend_hook in
      let saved_resolver = !Sx_types._cek_io_resolver in
      Sx_types._cek_io_suspend_hook := None;
      Sx_types._cek_io_resolver := None;
      (try
        let r = Sx_ref.cek_call thunk Nil in
        Sx_types._cek_io_suspend_hook := saved_hook;
        Sx_types._cek_io_resolver := saved_resolver;
        r
      with e ->
        Sx_types._cek_io_suspend_hook := saved_hook;
        Sx_types._cek_io_resolver := saved_resolver;
        raise e)
    | _ -> Nil);
  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 [Number lo; _] -> Number lo | _ -> Number 0.0);
  bind "try-rerender-page" (fun _args -> Nil);
  bind "collect!" (fun args ->
    match args with
    | [String name; value] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with
       | List items :: rest ->
         if List.mem value items then Nil
         else (Hashtbl.replace _scope_stacks name (List (items @ [value]) :: rest); Nil)
       | _ ->
         Hashtbl.replace _scope_stacks name (List [value] :: stack); Nil)
    | _ -> Nil);
  bind "collected" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with List items :: _ -> List items | _ -> List [])
    | _ -> List []);
  bind "clear-collected!" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with _ :: rest -> Hashtbl.replace _scope_stacks name (List [] :: rest) | [] -> ()); Nil
    | _ -> Nil);
  (* regex-find-all now provided by sx_primitives.ml *)
  bind "callable?" (fun args ->
    match args with
    | [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true
    | _ -> Bool false);
  bind "make-sx-expr" (fun args -> match args with [String s] -> SxExpr s | _ -> raise (Eval_error "make-sx-expr: expected string"));
  bind "sx-expr-source" (fun args -> match args with [SxExpr s] -> String s | [String s] -> String s | _ -> raise (Eval_error "sx-expr-source: expected sx-expr or string"));
  bind "sx-expr?" (fun args -> match args with [SxExpr _] -> Bool true | _ -> Bool false);
  bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
  bind "call-lambda" (fun args ->
    match args with
    | [Lambda _ as f; (List a | ListRef { contents = a })] ->
      let l = match f with Lambda l -> l | _ -> assert false in
      let local = Sx_types.env_extend l.l_closure in
      let rec bind_ps ps as' = match ps, as' with
        | [], _ -> () | p :: pr, a :: ar -> ignore (Sx_types.env_bind local p a); bind_ps pr ar
        | p :: pr, [] -> ignore (Sx_types.env_bind local p Nil); bind_ps pr [] in
      bind_ps l.l_params a;
      eval_expr l.l_body (Env local)
    | [Lambda _ as f; (List a | ListRef { contents = a }); Env e] ->
      let l = match f with Lambda l -> l | _ -> assert false in
      let local = Sx_types.env_merge l.l_closure e in
      let rec bind_ps ps as' = match ps, as' with
        | [], _ -> () | p :: pr, a :: ar -> ignore (Sx_types.env_bind local p a); bind_ps pr ar
        | p :: pr, [] -> ignore (Sx_types.env_bind local p Nil); bind_ps pr [] in
      bind_ps l.l_params a;
      eval_expr l.l_body (Env local)
    | _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));

  (* Declarative type/effect forms — no-ops at runtime *)
  bind "deftype" (fun _args -> Nil);
  bind "defeffect" (fun _args -> Nil);
  bind "register-special-form!" (fun args ->
    match args with
    | [String name; fn_val] ->
      (* Don't let SX modules override OCaml-registered defhandler/defisland *)
      if name = "defhandler" || name = "defisland" then Nil
      else (ignore (Sx_ref.register_special_form (String name) fn_val); Nil)
    | _ -> Nil);

  (* defhandler — register handler as handler:name in eval env.
     Mirrors sx_server.ml's defhandler special form. *)
  ignore (Sx_ref.register_special_form (String "defhandler") (NativeFn ("defhandler", fun sf_args ->
    let raw_args, eval_env = match sf_args with
      | [List a; Env e] | [ListRef { contents = a }; Env e] -> (a, e)
      | _ -> ([], env) in
    match raw_args with
    | name_sym :: rest ->
      let name = match name_sym with Symbol s -> s | String s -> s | _ -> Sx_types.inspect name_sym in
      let rec parse_opts acc = function
        | Keyword k :: v :: rest -> Hashtbl.replace acc k v; parse_opts acc rest
        | rest -> (acc, rest) in
      let opts = Hashtbl.create 4 in
      let (_, remaining) = parse_opts opts rest in
      let params, body_forms = match remaining with
        | List p :: rest -> (p, rest) | _ -> ([], []) in
      (* Wrap multiple body forms in (do ...) *)
      let body = match body_forms with
        | [] -> Nil | [b] -> b
        | forms -> List (Symbol "do" :: forms) in
      (* Extract &key param names for binding *)
      let key_params =
        let rec collect acc in_key = function
          | [] -> List.rev acc
          | Symbol "&key" :: rest -> collect acc true rest
          | Symbol "&rest" :: _ :: rest -> collect acc false rest
          | Symbol s :: rest when in_key -> collect (s :: acc) true rest
          | _ :: rest -> collect acc in_key rest
        in collect [] false params in
      let hdef = Hashtbl.create 8 in
      Hashtbl.replace hdef "__type" (String "handler");
      Hashtbl.replace hdef "name" (String name);
      Hashtbl.replace hdef "body" body;
      Hashtbl.replace hdef "params" (List (List.map (fun s -> String s) key_params));
      Hashtbl.replace hdef "closure" (Env eval_env);
      Hashtbl.replace hdef "method" (match Hashtbl.find_opt opts "method" with
        | Some (Keyword m) -> String m | Some v -> v | None -> String "get");
      ignore (Sx_types.env_bind eval_env ("handler:" ^ name) (Dict hdef));
      Dict hdef
    | _ -> Nil)));

  (* defisland — register island component. Stub: creates a component record. *)
  ignore (Sx_ref.register_special_form (String "defisland") (NativeFn ("defisland", fun sf_args ->
    let raw_args, eval_env = match sf_args with
      | [List a; Env e] | [ListRef { contents = a }; Env e] -> (a, e)
      | _ -> ([], env) in
    match raw_args with
    | name_sym :: rest ->
      let name = match name_sym with Symbol s -> s | String s -> s | _ -> Sx_types.inspect name_sym in
      let short_name = if String.length name > 1 && name.[0] = '~' then String.sub name 1 (String.length name - 1) else name in
      let params, body = match rest with
        | List p :: b :: _ -> (p, b) | List p :: [] -> (p, Nil) | _ -> ([], Nil) in
      let param_names = List.filter_map (fun p ->
        match p with Symbol s -> Some s | _ -> None) params in
      let has_children = List.exists (fun p ->
        match p with Symbol "&rest" -> true | _ -> false) params in
      let island = Island {
        i_name = short_name; i_params = param_names;
        i_has_children = has_children;
        i_body = body; i_closure = eval_env; i_file = None; i_compiled = None;
      } in
      ignore (Sx_types.env_bind eval_env name island);
      island
    | _ -> Nil)));

  (* IO registry — spec-level defio populates *io-registry* in evaluator.
     Bind accessor functions + __io-registry alias for backward compat. *)
  ignore (Sx_types.env_bind env "__io-registry" Sx_ref._io_registry_);
  bind "io-registered?" (fun args -> match args with [String n] -> Sx_ref.io_registered_p (String n) | _ -> Bool false);
  bind "io-lookup" (fun args -> match args with [String n] -> Sx_ref.io_lookup (String n) | _ -> Nil);
  bind "io-names" (fun _args -> Sx_ref.io_names ());
  bind "io-register!" (fun args -> match args with [String n; spec] -> Sx_ref.io_register_b (String n) spec | _ -> Nil);

  (* Foreign registry — spec-level define-foreign populates *foreign-registry*.
     Bind accessor functions so test-foreign.sx can inspect the registry. *)
  ignore (Sx_types.env_bind env "*foreign-registry*" Sx_ref._foreign_registry_);
  bind "foreign-registered?" (fun args -> match args with [String n] -> Sx_ref.foreign_registered_p (String n) | _ -> Bool false);
  bind "foreign-lookup" (fun args -> match args with [String n] -> Sx_ref.foreign_lookup (String n) | _ -> Nil);
  bind "foreign-names" (fun _args -> Sx_ref.foreign_names ());
  bind "foreign-register!" (fun args -> match args with [String n; spec] -> Sx_ref.foreign_register_b (String n) spec | _ -> Nil);
  bind "foreign-resolve-binding" (fun args -> match args with [String s] -> Sx_ref.foreign_resolve_binding (String s) | _ -> Nil);
  bind "foreign-check-args" (fun args ->
    let to_list = function List l -> List l | ListRef r -> List !r | v -> v in
    match args with
    | [String n; (List _ | ListRef _ as p); (List _ | ListRef _ as a)] ->
      Sx_ref.foreign_check_args (String n) (to_list p) (to_list a)
    | _ -> Nil);
  bind "foreign-build-lambda" (fun args -> match args with [spec] -> Sx_ref.foreign_build_lambda spec | _ -> Nil);

  (* Initialize CEK call forward ref — needed by with-capabilities and foreign-dispatch *)
  Sx_types._cek_call_ref := Sx_ref.cek_call;

  (* --- Primitives for canonical.sx / content tests --- *)
  bind "contains-char?" (fun args ->
    match args with
    | [String s; String c] when String.length c = 1 ->
      Bool (String.contains s c.[0])
    | _ -> Bool false);
  bind "escape-string" (fun args ->
    match args with
    | [String s] ->
      let buf = Buffer.create (String.length s + 4) in
      String.iter (fun c -> match c with
        | '"' -> Buffer.add_string buf "\\\""
        | '\\' -> Buffer.add_string buf "\\\\"
        | '\n' -> Buffer.add_string buf "\\n"
        | '\t' -> Buffer.add_string buf "\\t"
        | c -> Buffer.add_char buf c) s;
      String (Buffer.contents buf)
    | _ -> raise (Eval_error "escape-string: expected string"));
  bind "sha3-256" (fun args ->
    match args with
    | [String s] ->
      (* Stub: use a simple hash for testing — not real SHA3 *)
      let h = Hashtbl.hash s in
      String (Printf.sprintf "%064x" (abs h))
    | _ -> raise (Eval_error "sha3-256: expected string"));

  (* --- Missing primitives referenced by tests --- *)

  bind "upcase" (fun args ->
    match args with
    | [String s] -> String (String.uppercase_ascii s)
    | _ -> raise (Eval_error "upcase: expected string"));

  bind "downcase" (fun args ->
    match args with
    | [String s] -> String (String.lowercase_ascii s)
    | _ -> raise (Eval_error "downcase: expected string"));

  bind "make-keyword" (fun args ->
    match args with
    | [String s] -> Keyword s
    | _ -> raise (Eval_error "make-keyword: expected string"));

  bind "string-length" (fun args ->
    match args with
    | [String s] -> Number (float_of_int (String.length s))
    | _ -> raise (Eval_error "string-length: expected string"));

  bind "dict-get" (fun args ->
    match args with
    | [Dict d; String k] -> Sx_types.dict_get d k
    | [Dict d; Keyword k] -> Sx_types.dict_get d k
    | _ -> raise (Eval_error "dict-get: expected dict and key"));

  bind "apply" (fun args ->
    match args with
    | f :: rest ->
      let all_args = match List.rev rest with
        | List last :: prefix -> List.rev prefix @ last
        | _ -> rest
      in
      sx_call f all_args
    | _ -> raise (Eval_error "apply: expected function and args"));

  (* --- Type system helpers (for --full tests) --- *)

  bind "test-prim-types" (fun _args ->
    let d = Hashtbl.create 40 in
    List.iter (fun (k, v) -> Hashtbl.replace d k (String v)) [
      "+", "number"; "-", "number"; "*", "number"; "/", "number";
      "mod", "number"; "inc", "number"; "dec", "number";
      "abs", "number"; "min", "number"; "max", "number";
      "floor", "number"; "ceil", "number"; "round", "number";
      "str", "string"; "upper", "string"; "lower", "string";
      "trim", "string"; "join", "string"; "replace", "string";
      "format", "string"; "substr", "string";
      "=", "boolean"; "<", "boolean"; ">", "boolean";
      "<=", "boolean"; ">=", "boolean"; "!=", "boolean";
      "not", "boolean"; "nil?", "boolean"; "empty?", "boolean";
      "number?", "boolean"; "string?", "boolean"; "boolean?", "boolean";
      "list?", "boolean"; "dict?", "boolean"; "symbol?", "boolean";
      "keyword?", "boolean"; "contains?", "boolean"; "has-key?", "boolean";
      "starts-with?", "boolean"; "ends-with?", "boolean";
      "len", "number"; "first", "any"; "rest", "list";
      "last", "any"; "nth", "any"; "cons", "list";
      "append", "list"; "concat", "list"; "reverse", "list";
      "sort", "list"; "slice", "list"; "range", "list";
      "flatten", "list"; "keys", "list"; "vals", "list";
      "map-dict", "dict"; "assoc", "dict"; "dissoc", "dict";
      "merge", "dict"; "dict", "dict";
      "get", "any"; "type-of", "string";
    ];
    Dict d);

  bind "test-prim-param-types" (fun _args ->
    let d = Hashtbl.create 10 in
    let pos name typ =
      let d2 = Hashtbl.create 2 in
      Hashtbl.replace d2 "positional" (List [List [String name; String typ]]);
      Hashtbl.replace d2 "rest-type" Nil;
      Dict d2
    in
    let pos_rest name typ rt =
      let d2 = Hashtbl.create 2 in
      Hashtbl.replace d2 "positional" (List [List [String name; String typ]]);
      Hashtbl.replace d2 "rest-type" (String rt);
      Dict d2
    in
    Hashtbl.replace d "+" (pos_rest "a" "number" "number");
    Hashtbl.replace d "-" (pos_rest "a" "number" "number");
    Hashtbl.replace d "*" (pos_rest "a" "number" "number");
    Hashtbl.replace d "/" (pos_rest "a" "number" "number");
    Hashtbl.replace d "inc" (pos "n" "number");
    Hashtbl.replace d "dec" (pos "n" "number");
    Hashtbl.replace d "upper" (pos "s" "string");
    Hashtbl.replace d "lower" (pos "s" "string");
    Hashtbl.replace d "keys" (pos "d" "dict");
    Hashtbl.replace d "vals" (pos "d" "dict");
    Dict d);

  (* --- Component accessors --- *)

  bind "component-param-types" (fun _args -> Nil);

  bind "component-set-param-types!" (fun _args -> Nil);
  bind "component-file" (fun args -> match args with [v] -> component_file v | _ -> Nil);
  bind "component-set-file!" (fun args -> match args with [v; f] -> component_set_file v f | _ -> Nil);

  bind "component-params" (fun args ->
    match args with
    | [Component c] -> List (List.map (fun s -> String s) c.c_params)
    | [Island i] -> List (List.map (fun s -> String s) i.i_params)
    | _ -> Nil);

  bind "component-body" (fun args ->
    match args with
    | [Component c] -> c.c_body
    | [Island i] -> i.i_body
    | _ -> Nil);

  bind "component-has-children" (fun args ->
    match args with
    | [Component c] -> Bool c.c_has_children
    | [Island i] -> Bool i.i_has_children
    | _ -> Bool false);

  bind "component-affinity" (fun args ->
    match args with
    | [Component c] -> String c.c_affinity
    | [Island _] -> String "client"
    | _ -> String "auto");

  (* --- Parser test helpers --- *)

  bind "keyword-name" (fun args ->
    match args with
    | [Keyword k] -> String k
    | _ -> raise (Eval_error "keyword-name: expected keyword"));

  bind "symbol-name" (fun args ->
    match args with
    | [Symbol s] -> String s
    | _ -> raise (Eval_error "symbol-name: expected symbol"));

  bind "sx-serialize" (fun args ->
    match args with
    | [v] -> String (Sx_types.inspect v)
    | _ -> raise (Eval_error "sx-serialize: expected 1 arg"));

  (* --- make-symbol --- *)

  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: expected 1 arg"));

  (* --- CEK stepping / introspection --- *)

  bind "make-cek-state" (fun args ->
    match args with
    | [ctrl; env'; kont] -> Sx_ref.make_cek_state ctrl env' kont
    | _ -> raise (Eval_error "make-cek-state: expected 3 args"));

  bind "cek-step" (fun args ->
    match args with
    | [state] -> Sx_ref.cek_step state
    | _ -> raise (Eval_error "cek-step: expected 1 arg"));

  bind "cek-phase" (fun args ->
    match args with
    | [state] -> Sx_ref.cek_phase state
    | _ -> raise (Eval_error "cek-phase: expected 1 arg"));

  bind "cek-value" (fun args ->
    match args with
    | [state] -> Sx_ref.cek_value state
    | _ -> raise (Eval_error "cek-value: expected 1 arg"));

  bind "cek-terminal?" (fun args ->
    match args with
    | [state] -> Sx_ref.cek_terminal_p state
    | _ -> raise (Eval_error "cek-terminal?: expected 1 arg"));

  bind "cek-kont" (fun args ->
    match args with
    | [state] -> Sx_ref.cek_kont state
    | _ -> raise (Eval_error "cek-kont: expected 1 arg"));

  bind "frame-type" (fun args ->
    match args with
    | [frame] -> Sx_ref.frame_type frame
    | _ -> raise (Eval_error "frame-type: expected 1 arg"));

  (* IO suspension primitives — inline until retranspile *)
  let is_suspended state =
    match get_val state (String "phase") with String "io-suspended" -> true | _ -> false in
  let step_loop state =
    let s = ref state in
    while not (match Sx_ref.cek_terminal_p !s with Bool true -> true | _ -> false)
       && not (is_suspended !s) do
      s := Sx_ref.cek_step !s
    done;
    !s in
  bind "cek-step-loop" (fun args ->
    match args with
    | [state] -> step_loop state
    | _ -> raise (Eval_error "cek-step-loop: expected 1 arg"));
  bind "cek-resume" (fun args ->
    match args with
    | [state; result] ->
      step_loop (Sx_ref.make_cek_value result (get_val state (String "env")) (get_val state (String "kont")))
    | _ -> raise (Eval_error "cek-resume: expected 2 args"));
  bind "cek-suspended?" (fun args ->
    match args with
    | [state] -> Bool (is_suspended state)
    | _ -> raise (Eval_error "cek-suspended?: expected 1 arg"));
  bind "cek-io-request" (fun args ->
    match args with
    | [state] -> get_val state (String "request")
    | _ -> raise (Eval_error "cek-io-request: expected 1 arg"));
  bind "make-cek-suspended" (fun args ->
    match args with
    | [req; env'; kont] ->
      let d = Hashtbl.create 4 in
      Hashtbl.replace d "phase" (String "io-suspended");
      Hashtbl.replace d "request" req;
      Hashtbl.replace d "env" env';
      Hashtbl.replace d "kont" kont;
      Dict d
    | _ -> raise (Eval_error "make-cek-suspended: expected 3 args"));

  (* --- Library registry --- *)
  let lib_registry = Hashtbl.create 16 in
  ignore (Sx_types.env_bind env "*library-registry*" (Dict lib_registry));
  bind "library-loaded?" (fun args ->
    match args with
    | [spec] -> Sx_ref.library_loaded_p spec
    | _ -> raise (Eval_error "library-loaded?: expected 1 arg"));
  bind "library-exports" (fun args ->
    match args with
    | [spec] -> Sx_ref.library_exports spec
    | _ -> raise (Eval_error "library-exports: expected 1 arg"));
  bind "register-library" (fun args ->
    match args with
    | [spec; exports] -> Sx_ref.register_library spec exports
    | _ -> raise (Eval_error "register-library: expected 2 args"));

  (* --- Strict mode --- *)
  (* *strict* is a plain value in the env, mutated via env_set by set-strict! *)
  ignore (Sx_types.env_bind env "*strict*" (Bool false));
  ignore (Sx_types.env_bind env "*prim-param-types*" Nil);

  bind "set-strict!" (fun args ->
    match args with
    | [v] ->
      Sx_ref._strict_ref := v;
      ignore (Sx_types.env_set env "*strict*" v); Nil
    | _ -> raise (Eval_error "set-strict!: expected 1 arg"));

  bind "set-prim-param-types!" (fun args ->
    match args with
    | [v] ->
      Sx_ref._prim_param_types_ref := v;
      ignore (Sx_types.env_set env "*prim-param-types*" v); Nil
    | _ -> raise (Eval_error "set-prim-param-types!: expected 1 arg"));

  bind "value-matches-type?" (fun args ->
    match args with
    | [v; String expected] -> Sx_ref.value_matches_type_p v (String expected)
    | _ -> raise (Eval_error "value-matches-type?: expected value and type string"));

  (* Request primitives — stubs for test environment *)
  let _test_state : (string, value) Hashtbl.t = Hashtbl.create 16 in
  bind "now" (fun args ->
    let fmt = match args with String f :: _ -> f | _ -> "%Y-%m-%d %H:%M:%S" in
    let open Unix in let tm = localtime (gettimeofday ()) in
    let r = if fmt = "%H:%M:%S" then Printf.sprintf "%02d:%02d:%02d" tm.tm_hour tm.tm_min tm.tm_sec
    else Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec in
    String r);
  bind "state-get" (fun args -> match args with
    | String key :: rest -> let default = match rest with v :: _ -> v | [] -> Nil in
      (match Hashtbl.find_opt _test_state key with Some v -> v | None -> default)
    | _ -> Nil);
  bind "state-set!" (fun args -> match args with
    | String key :: value :: _ -> Hashtbl.replace _test_state key value; Nil | _ -> Nil);
  bind "state-clear!" (fun args -> match args with
    | [String key] -> Hashtbl.remove _test_state key; Nil | _ -> Nil);
  bind "request-method" (fun _args -> String "GET");
  bind "request-body" (fun _args -> String "");
  bind "request-form" (fun args -> match args with
    | String _ :: rest -> (match rest with v :: _ -> v | [] -> String "") | _ -> String "");
  bind "request-arg" (fun args -> match args with
    | String _ :: rest -> (match rest with v :: _ -> v | [] -> Nil) | _ -> Nil);
  bind "request-form-all" (fun _args -> Dict (Hashtbl.create 0));
  bind "request-args-all" (fun _args -> Dict (Hashtbl.create 0));
  bind "request-form-list" (fun _args -> List []);
  bind "request-json" (fun _args -> String "");
  bind "request-header" (fun args -> match args with
    | String _ :: rest -> (match rest with v :: _ -> v | [] -> String "") | _ -> String "");
  bind "request-headers-all" (fun _args -> Dict (Hashtbl.create 0));
  bind "request-content-type" (fun _args -> String "");
  bind "request-file-name" (fun _args -> String "");
  bind "into" (fun args -> match args with
    | [String "list"; Dict d] ->
      List (Hashtbl.fold (fun k v acc -> List [String k; v] :: acc) d [])
    | [String "dict"; List pairs] | [String "dict"; ListRef { contents = pairs }] ->
      let d = Hashtbl.create 8 in
      List.iter (fun pair -> match pair with
        | List [String k; v] | ListRef { contents = [String k; v] } -> Hashtbl.replace d k v
        | _ -> ()) pairs;
      Dict d
    | _ -> Nil);

  (* --- Stubs for offline/IO tests --- *)
  bind "log-info" (fun _args -> Nil);
  bind "log-warn" (fun _args -> Nil);
  bind "log-error" (fun _args -> Nil);
  bind "execute-action" (fun _args -> Nil);

  (* --- make-page-def for defpage tests --- *)
  bind "make-page-def" (fun args ->
    let convert_val = function Keyword k -> String k | v -> v in
    let make_pdef name slots =
      let d = Hashtbl.create 8 in
      Hashtbl.replace d "__type" (String "page");
      Hashtbl.replace d "name" (String name);
      (* Defaults for missing fields *)
      Hashtbl.replace d "stream" (Bool false);
      Hashtbl.replace d "shell" Nil;
      Hashtbl.replace d "fallback" Nil;
      Hashtbl.replace d "data" Nil;
      (* Override with actual slot values *)
      Hashtbl.iter (fun k v -> Hashtbl.replace d k (convert_val v)) slots;
      Dict d
    in
    match args with
    | [String name; Dict slots; _env] -> make_pdef name slots
    | [String name; Dict slots] -> make_pdef name slots
    | _ -> Nil);

  (* --- component-io-refs for deps.sx tests --- *)
  bind "component-io-refs" (fun args ->
    match args with
    | [Component c] ->
      (* Scan body for IO calls — look for known IO functions *)
      let rec scan = function
        | List (Symbol s :: _) when
          s = "fetch" || s = "fetch-data" || s = "query" || s = "action" ||
          s = "state-get" || s = "state-set!" ||
          s = "request-arg" || s = "request-form" || s = "request-method" || s = "now" ||
          s = "request-header" || s = "request-json" || s = "request-content-type" ||
          s = "execute-action" || s = "submit-mutation" -> [s]
        | List items | ListRef { contents = items } -> List.concat_map scan items
        | _ -> []
      in
      let refs = scan c.c_body in
      let unique = List.sort_uniq String.compare refs in
      List (List.map (fun s -> String s) unique)
    | _ -> List []);
  bind "component-set-io-refs!" (fun _args -> Nil);

  (* --- Fragment binding for aser tests --- *)
  bind "<>" (fun args -> List args);

  (* --- component-deps / component-set-deps! for deps.sx --- *)
  let _comp_deps : (string, value) Hashtbl.t = Hashtbl.create 16 in
  bind "component-deps" (fun args ->
    match args with
    | [Component c] -> (match Hashtbl.find_opt _comp_deps c.c_name with Some v -> v | None -> Nil)
    | [Island i] -> (match Hashtbl.find_opt _comp_deps i.i_name with Some v -> v | None -> Nil)
    | _ -> Nil);
  bind "component-set-deps!" (fun args ->
    match args with
    | [Component c; v] -> Hashtbl.replace _comp_deps c.c_name v; Nil
    | [Island i; v] -> Hashtbl.replace _comp_deps i.i_name v; Nil
    | _ -> Nil);

  (* --- submit-mutation stub for offline tests --- *)
  bind "submit-mutation" (fun args ->
    match args with
    | _ :: _ -> String "confirmed"
    | _ -> Nil);

  env

(* ====================================================================== *)
(* Foundation tests (direct, no evaluator)                                 *)
(* ====================================================================== *)

let run_foundation_tests () =
  Printf.printf "=== SX OCaml Foundation Tests ===\n\n";

  let assert_eq name expected actual =
    if deep_equal expected actual then begin
      incr pass_count;
      Printf.printf "  PASS: %s\n" name
    end else begin
      incr fail_count;
      Printf.printf "  FAIL: %s — expected %s, got %s\n" name
        (Sx_types.inspect expected) (Sx_types.inspect actual)
    end
  in
  let assert_true name v =
    if sx_truthy v then begin
      incr pass_count;
      Printf.printf "  PASS: %s\n" name
    end else begin
      incr fail_count;
      Printf.printf "  FAIL: %s — expected truthy, got %s\n" name (Sx_types.inspect v)
    end
  in
  let call name args =
    match Hashtbl.find_opt primitives name with
    | Some f -> f args
    | None -> failwith ("Unknown primitive: " ^ name)
  in

  Printf.printf "Suite: parser\n";
  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 "+"; 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 [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));
  (match List.hd (parse_all "{:a 1 :b 2}") with
   | 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" (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)"))));

  Printf.printf "\nSuite: primitives\n";
  assert_eq "+" (Number 6.0) (call "+" [Number 1.0; Number 2.0; Number 3.0]);
  assert_eq "-" (Number 3.0) (call "-" [Number 5.0; Number 2.0]);
  assert_eq "*" (Number 12.0) (call "*" [Number 3.0; Number 4.0]);
  assert_eq "/" (Number 2.5) (call "/" [Number 5.0; Number 2.0]);
  assert_eq "mod" (Number 1.0) (call "mod" [Number 5.0; Number 2.0]);
  assert_eq "inc" (Number 6.0) (call "inc" [Number 5.0]);
  assert_eq "abs" (Number 5.0) (call "abs" [Number (-5.0)]);
  assert_true "=" (call "=" [Number 1.0; Number 1.0]);
  assert_true "!=" (call "!=" [Number 1.0; Number 2.0]);
  assert_true "<" (call "<" [Number 1.0; Number 2.0]);
  assert_true ">" (call ">" [Number 2.0; Number 1.0]);
  assert_true "nil?" (call "nil?" [Nil]);
  assert_true "number?" (call "number?" [Number 1.0]);
  assert_true "string?" (call "string?" [String "hi"]);
  assert_true "list?" (call "list?" [List [Number 1.0]]);
  assert_true "empty? list" (call "empty?" [List []]);
  assert_true "empty? string" (call "empty?" [String ""]);
  assert_eq "str" (String "hello42") (call "str" [String "hello"; Number 42.0]);
  assert_eq "upper" (String "HI") (call "upper" [String "hi"]);
  assert_eq "trim" (String "hi") (call "trim" [String "  hi  "]);
  assert_eq "join" (String "a,b,c") (call "join" [String ","; List [String "a"; String "b"; String "c"]]);
  assert_true "starts-with?" (call "starts-with?" [String "hello"; String "hel"]);
  assert_true "contains?" (call "contains?" [List [Number 1.0; Number 2.0; Number 3.0]; Number 2.0]);
  assert_eq "list" (List [Number 1.0; Number 2.0]) (call "list" [Number 1.0; Number 2.0]);
  assert_eq "len" (Number 3.0) (call "len" [List [Number 1.0; Number 2.0; Number 3.0]]);
  assert_eq "first" (Number 1.0) (call "first" [List [Number 1.0; Number 2.0]]);
  assert_eq "rest" (List [Number 2.0; Number 3.0]) (call "rest" [List [Number 1.0; Number 2.0; Number 3.0]]);
  assert_eq "nth" (Number 2.0) (call "nth" [List [Number 1.0; Number 2.0]; Number 1.0]);
  assert_eq "cons" (List [Number 0.0; Number 1.0]) (call "cons" [Number 0.0; List [Number 1.0]]);
  assert_eq "append" (List [Number 1.0; Number 2.0; Number 3.0])
    (call "append" [List [Number 1.0]; List [Number 2.0; Number 3.0]]);
  assert_eq "reverse" (List [Number 3.0; Number 2.0; Number 1.0])
    (call "reverse" [List [Number 1.0; Number 2.0; Number 3.0]]);
  assert_eq "range" (List [Number 0.0; Number 1.0; Number 2.0]) (call "range" [Number 3.0]);
  assert_eq "slice" (List [Number 2.0; Number 3.0])
    (call "slice" [List [Number 1.0; Number 2.0; Number 3.0]; Number 1.0]);
  assert_eq "type-of" (String "number") (call "type-of" [Number 1.0]);
  assert_eq "type-of nil" (String "nil") (call "type-of" [Nil]);

  Printf.printf "\nSuite: env\n";
  let e = Sx_types.make_env () in
  ignore (Sx_types.env_bind e "x" (Number 42.0));
  assert_eq "env-bind + get" (Number 42.0) (Sx_types.env_get e "x");
  assert_true "env-has" (Bool (Sx_types.env_has e "x"));
  let child = Sx_types.env_extend e in
  ignore (Sx_types.env_bind child "y" (Number 10.0));
  assert_eq "child sees parent" (Number 42.0) (Sx_types.env_get child "x");
  assert_eq "child own binding" (Number 10.0) (Sx_types.env_get child "y");
  ignore (Sx_types.env_set child "x" (Number 99.0));
  assert_eq "set! walks chain" (Number 99.0) (Sx_types.env_get e "x");

  Printf.printf "\nSuite: types\n";
  assert_true "sx_truthy true" (Bool (sx_truthy (Bool true)));
  assert_true "sx_truthy 0" (Bool (sx_truthy (Number 0.0)));
  assert_true "sx_truthy \"\"" (Bool (sx_truthy (String "")));
  assert_eq "not truthy nil" (Bool false) (Bool (sx_truthy Nil));
  assert_eq "not truthy false" (Bool false) (Bool (sx_truthy (Bool false)));
  let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = Sx_types.make_env (); l_name = None; l_compiled = None } in
  assert_true "is_lambda" (Bool (Sx_types.is_lambda (Lambda l)));
  ignore (Sx_types.set_lambda_name (Lambda l) "my-fn");
  assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l))


(* ====================================================================== *)
(* Spec test runner                                                        *)
(* ====================================================================== *)

(* Called after module loading to sync JIT globals with env *)
let _jit_refresh_globals : (unit -> unit) ref = ref (fun () -> ())

let run_spec_tests env test_files =
  (* Find project root: walk up from cwd until we find spec/tests *)
  let rec find_root dir =
    let candidate = Filename.concat dir "spec/tests" in
    if Sys.file_exists candidate then dir
    else
      let parent = Filename.dirname dir in
      if parent = dir then Sys.getcwd ()  (* reached filesystem root *)
      else find_root parent
  in
  let project_dir = find_root (Sys.getcwd ()) in
  let spec_tests_dir = Filename.concat project_dir "spec/tests" in
  let framework_path = Filename.concat spec_tests_dir "test-framework.sx" in

  if not (Sys.file_exists framework_path) then begin
    Printf.eprintf "test-framework.sx not found at %s\n" framework_path;
    Printf.eprintf "Run from the project root directory.\n";
    exit 1
  end;

  (* IO-aware evaluation: resolve library paths and handle import suspension *)
  let lib_base = Filename.concat project_dir "lib" in
  let spec_base = Filename.concat project_dir "spec" in
  let web_base = Filename.concat project_dir "web" in

  let resolve_library_path lib_spec =
    let parts = match lib_spec with List l | ListRef { contents = l } -> l | _ -> [] in
    match List.map (fun v -> match v with Symbol s -> s | String s -> s | _ -> "") parts with
    | ["sx"; name] ->
      let spec_path = Filename.concat spec_base (name ^ ".sx") in
      let lib_path = Filename.concat lib_base (name ^ ".sx") in
      let web_lib_path = Filename.concat (Filename.concat web_base "lib") (name ^ ".sx") in
      if Sys.file_exists spec_path then Some spec_path
      else if Sys.file_exists lib_path then Some lib_path
      else if Sys.file_exists web_lib_path then Some web_lib_path
      else None
    | ["web"; name] ->
      let path = Filename.concat web_base (name ^ ".sx") in
      let lib_path = Filename.concat (Filename.concat web_base "lib") (name ^ ".sx") in
      if Sys.file_exists path then Some path
      else if Sys.file_exists lib_path then Some lib_path
      else None
    | [prefix; name] ->
      let path = Filename.concat (Filename.concat project_dir prefix) (name ^ ".sx") in
      if Sys.file_exists path then Some path else None
    | _ -> None
  in

  (* Run CEK step loop, handling IO suspension for imports *)
  let rec eval_with_io expr env_val =
    let state = Sx_ref.make_cek_state expr env_val (List []) in
    run_with_io state
  and load_library_file path =
    let exprs = Sx_parser.parse_file path in
    List.iter (fun expr -> ignore (eval_with_io expr (Env env))) exprs
  and run_with_io state =
    let s = ref state in
    let is_terminal st = match Sx_ref.cek_terminal_p st with Bool true -> true | _ -> false in
    let is_suspended st = match Sx_runtime.get_val st (String "phase") with String "io-suspended" -> true | _ -> false in
    (* Check if kont has any handler frames — pure structural scan *)
    let kont_has_handler kont =
      let k = ref kont in
      let found = ref false in
      while (match !k with List (_::_) -> true | _ -> false) && not !found do
        (match !k with
         | List (frame :: rest) ->
           (match frame with
            | CekFrame f when f.cf_type = "handler" -> found := true
            | _ -> ());
           k := List rest
         | _ -> k := List [])
      done;
      !found in
    let rec loop () =
      while not (is_terminal !s) && not (is_suspended !s) do
        (try s := Sx_ref.cek_step !s
         with Eval_error msg ->
           let kont = Sx_ref.cek_kont !s in
           if kont_has_handler kont then
             (* Convert to CEK-level raise so guard/handler-bind can catch it *)
             let env = Sx_ref.cek_env !s in
             s := Sx_ref.make_cek_value (String msg) env
                    (Sx_ref.kont_push (Sx_ref.make_raise_eval_frame env (Bool false)) kont)
           else
             raise (Eval_error msg))
      done;
      if is_suspended !s then begin
        let request = Sx_runtime.get_val !s (String "request") in
        let req_list = match request with List l -> l | ListRef { contents = l } -> l | _ -> [] in
        let op = match req_list with
          | String o :: _ -> o
          | Symbol o :: _ -> o
          | _ -> (match Sx_runtime.get_val request (String "op") with String s -> s | _ -> "") in
        let response = match op with
          | "import" ->
            let lib_spec = Sx_runtime.get_val request (String "library") in
            if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then
              Nil
            else begin
              (match resolve_library_path lib_spec with
               | Some path ->
                 (try load_library_file path
                  with Sx_types.Eval_error msg ->
                    Printf.eprintf "[import] Warning loading %s: %s\n%!"
                      (Sx_runtime.value_to_str lib_spec) msg)
               | None -> ());  (* silently skip unresolvable libraries *)
              Nil
            end
          | "text-measure" ->
            (* Monospace approximation for tests *)
            let args = let a = Sx_runtime.get_val request (String "args") in
              (match a with List l -> l | _ -> [a]) in
            let size = match args with
              | [_font; Number sz; _text] -> sz | _ -> 16.0 in
            let text = match args with
              | [_font; _sz; String t] -> t | _ -> "" in
            let w = size *. 0.6 *. (float_of_int (String.length text)) in
            let d = Hashtbl.create 4 in
            Hashtbl.replace d "width" (Number w);
            Hashtbl.replace d "height" (Number size);
            Hashtbl.replace d "ascent" (Number (size *. 0.8));
            Hashtbl.replace d "descent" (Number (size *. 0.2));
            Dict d
          | "io-sleep" | "io-wait" | "io-settle" | "io-wait-for" -> Nil
          | "io-fetch" ->
            let args = match req_list with _ :: rest -> rest | _ -> [] in
            let format = match args with _ :: String f :: _ -> f | _ -> "text" in
            (match format with
             | "json" | "JSON" | "Object" ->
               let j = Hashtbl.create 2 in
               Hashtbl.replace j "foo" (Number 1.0); Dict j
             | "html" | "HTML" ->
               String "[object DocumentFragment]"
             | "Number" | "Int" | "Integer" | "Float" ->
               String "1.2"
             | "response" | "Response" ->
               let resp = Hashtbl.create 4 in
               Hashtbl.replace resp "ok" (Bool true);
               Hashtbl.replace resp "status" (Number 200.0);
               Hashtbl.replace resp "text" (String "yay");
               Dict resp
             | _ -> String "yay")
          | _ -> Nil
        in
        s := Sx_ref.cek_resume !s response;
        loop ()
      end else
        Sx_ref.cek_value !s
    in
    loop ()
  in

  let load_and_eval path =
    let ic = open_in path in
    let n = in_channel_length ic in
    let s = Bytes.create n in
    really_input ic s 0 n;
    close_in ic;
    let src = Bytes.to_string s in
    let exprs = parse_all src in
    List.iter (fun expr ->
      try ignore (eval_with_io expr (Env env))
      with Sx_types.Eval_error _ -> ()  (* skip expressions that fail during load *)
    ) exprs
  in

  (* Path-based name injection for unnamed defcomp/defisland (one-per-file) *)
  let def_keywords = ["defcomp"; "defisland"; "defmacro"; "define";
                      "defhandler"; "defstyle"; "deftype"; "defeffect";
                      "defrelation"; "deftest"; "defpage"] in
  let inject_path_name expr path base_dir =
    match expr with
    | Sx_types.List (Sx_types.Symbol kw :: rest) when List.mem kw def_keywords ->
      (match rest with
       | Sx_types.Symbol _ :: _ -> expr
       | _ ->
         let rel = if String.length path > String.length base_dir + 1
           then String.sub path (String.length base_dir + 1)
                  (String.length path - String.length base_dir - 1)
           else Filename.basename path in
         let stem = if Filename.check_suffix rel ".sx"
           then String.sub rel 0 (String.length rel - 3)
           else rel in
         let stem = let parts = String.split_on_char '/' stem in
           String.concat "/" (List.filter (fun p -> p <> "_islands") parts) in
         let name = if Filename.basename stem = "index"
           then let d = Filename.dirname stem in
                if d = "." then "index" else d
           else stem in
         let prefixed = if kw = "defcomp" || kw = "defisland"
           then "~" ^ name else name in
         Sx_types.List (Sx_types.Symbol kw :: Sx_types.Symbol prefixed :: rest))
    | _ -> expr
  in
  let load_with_path path base_dir =
    let ic = open_in path in
    let n = in_channel_length ic in
    let s = Bytes.create n in
    really_input ic s 0 n;
    close_in ic;
    let src = Bytes.to_string s in
    let exprs = parse_all src in
    List.iter (fun expr ->
      let expr' = inject_path_name expr path base_dir in
      try ignore (eval_with_io expr' (Env env))
      with Sx_types.Eval_error _ -> ()
    ) exprs
  in
  let rec load_dir_recursive dir base_dir =
    if Sys.file_exists dir && Sys.is_directory dir then
      let entries = Sys.readdir dir in
      Array.sort compare entries;
      Array.iter (fun name ->
        let path = Filename.concat dir name in
        if Sys.is_directory path then
          load_dir_recursive path base_dir
        else if Filename.check_suffix name ".sx" then
          (try load_with_path path base_dir
           with e -> Printf.eprintf "Warning: %s: %s\n%!" path (Printexc.to_string e))
      ) entries
  in
  let _ = load_dir_recursive in
  let _ = load_with_path in

  Printf.printf "\nLoading test framework...\n%!";
  load_and_eval framework_path;

  (* Load test harness (mock IO platform) *)
  let harness_path = Filename.concat (Filename.concat project_dir "spec") "harness.sx" in
  if Sys.file_exists harness_path then begin
    Printf.printf "Loading test harness...\n%!";
    (try load_and_eval harness_path
     with e -> Printf.eprintf "Warning: harness.sx: %s\n%!" (Printexc.to_string e))
  end;

  (* ================================================================== *)
  (* Mock DOM — host-* primitives for hyperscript behavioral tests      *)
  (* ================================================================== *)

  (* Mock DOM elements are SX Dicts with special keys:
     __mock_type: "element" | "event" | "classList" | "style" | "document"
     __mock_el:   back-reference to parent element (for classList/style)
     tagName, id, className, children, _listeners, attributes, style, ... *)

  let mock_el_counter = ref 0 in

  (* Physical-identity compare for mock elements via __host_handle. *)
  let mock_el_eq a b =
    match a, b with
    | Dict da, Dict db ->
      (match Hashtbl.find_opt da "__host_handle",
             Hashtbl.find_opt db "__host_handle" with
       | Some (Number ha), Some (Number hb) -> ha = hb
       | _ -> false)
    | _ -> false
  in

  let make_mock_element tag =
    incr mock_el_counter;
    let d = Hashtbl.create 16 in
    Hashtbl.replace d "__mock_type" (String "element");
    Hashtbl.replace d "__mock_id" (Number (float_of_int !mock_el_counter));
    Hashtbl.replace d "__host_handle" (Number (float_of_int !mock_el_counter));
    Hashtbl.replace d "tagName" (String (String.uppercase_ascii tag));
    Hashtbl.replace d "nodeName" (String (String.uppercase_ascii tag));
    Hashtbl.replace d "nodeType" (Number 1.0);
    Hashtbl.replace d "id" (String "");
    Hashtbl.replace d "className" (String "");
    Hashtbl.replace d "textContent" (String "");
    Hashtbl.replace d "innerHTML" (String "");
    Hashtbl.replace d "outerHTML" (String "");
    Hashtbl.replace d "value" (String "");
    Hashtbl.replace d "checked" (Bool false);
    Hashtbl.replace d "disabled" (Bool false);
    Hashtbl.replace d "open" (Bool false);
    Hashtbl.replace d "children" (List []);
    Hashtbl.replace d "childNodes" (List []);
    Hashtbl.replace d "parentElement" Nil;
    Hashtbl.replace d "parentNode" Nil;
    Hashtbl.replace d "_listeners" (Dict (Hashtbl.create 4));
    Hashtbl.replace d "attributes" (Dict (Hashtbl.create 4));
    Hashtbl.replace d "dataset" (Dict (Hashtbl.create 4));
    (* style is a sub-dict *)
    let style_d = Hashtbl.create 4 in
    Hashtbl.replace style_d "__mock_type" (String "style");
    Hashtbl.replace style_d "__mock_el" (Dict d);
    Hashtbl.replace d "style" (Dict style_d);
    (* classList is a sub-dict *)
    let cl_d = Hashtbl.create 4 in
    Hashtbl.replace cl_d "__mock_type" (String "classList");
    Hashtbl.replace cl_d "__mock_el" (Dict d);
    Hashtbl.replace d "classList" (Dict cl_d);
    Dict d
  in

  let mock_body = match make_mock_element "body" with Dict d -> d | _ -> assert false in
  Hashtbl.replace mock_body "tagName" (String "BODY");
  Hashtbl.replace mock_body "nodeName" (String "BODY");

  let mock_document =
    let d = Hashtbl.create 8 in
    Hashtbl.replace d "__mock_type" (String "document");
    Hashtbl.replace d "body" (Dict mock_body);
    Hashtbl.replace d "title" (String "");
    Dict d
  in

  (* Helper: get classes from className string *)
  let get_classes d =
    match Hashtbl.find_opt d "className" with
    | Some (String s) -> String.split_on_char ' ' s |> List.filter (fun s -> s <> "")
    | _ -> []
  in

  (* Helper: set className from class list *)
  let set_classes d classes =
    Hashtbl.replace d "className" (String (String.concat " " classes))
  in

  (* Helper: add child to parent *)
  let mock_append_child parent child =
    match parent, child with
    | Dict pd, Dict cd ->
      (* Remove from old parent first *)
      (match Hashtbl.find_opt cd "parentElement" with
       | Some (Dict old_parent) ->
         let old_kids = match Hashtbl.find_opt old_parent "children" with
           | Some (List l) -> List.filter (fun c -> not (mock_el_eq c child)) l | _ -> [] in
         Hashtbl.replace old_parent "children" (List old_kids);
         Hashtbl.replace old_parent "childNodes" (List old_kids)
       | _ -> ());
      let kids = match Hashtbl.find_opt pd "children" with
        | Some (List l) -> l | _ -> [] in
      Hashtbl.replace pd "children" (List (kids @ [child]));
      Hashtbl.replace pd "childNodes" (List (kids @ [child]));
      Hashtbl.replace cd "parentElement" parent;
      Hashtbl.replace cd "parentNode" parent;
      child
    | _ -> child
  in

  (* Minimal HTML parser for test mock.
     Parses an HTML string into mock child elements and appends them to `parent`.
     Handles: <tag attr="v" attr='v' attr=v attr>content</tag>, nested elements,
     self-closing tags, text content. No comments, CDATA, DOCTYPE, or entities. *)
  let parse_html_into parent_d html =
    let len = String.length html in
    let pos = ref 0 in
    let is_name_char c =
      (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
      (c >= '0' && c <= '9') || c = '-' || c = '_' || c = ':'
    in
    let skip_ws () =
      while !pos < len && (let c = html.[!pos] in c = ' ' || c = '\n' || c = '\t' || c = '\r') do
        incr pos
      done
    in
    let parse_name () =
      let start = !pos in
      while !pos < len && is_name_char html.[!pos] do incr pos done;
      String.sub html start (!pos - start)
    in
    let parse_attr_value () =
      if !pos >= len then ""
      else if html.[!pos] = '"' then begin
        incr pos;
        let start = !pos in
        while !pos < len && html.[!pos] <> '"' do incr pos done;
        let v = String.sub html start (!pos - start) in
        if !pos < len then incr pos;
        v
      end
      else if html.[!pos] = '\'' then begin
        incr pos;
        let start = !pos in
        while !pos < len && html.[!pos] <> '\'' do incr pos done;
        let v = String.sub html start (!pos - start) in
        if !pos < len then incr pos;
        v
      end
      else begin
        let start = !pos in
        while !pos < len && (let c = html.[!pos] in
               c <> ' ' && c <> '\t' && c <> '\n' && c <> '\r'
               && c <> '>' && c <> '/') do
          incr pos
        done;
        String.sub html start (!pos - start)
      end
    in
    let parse_attrs (elem : (string, Sx_types.value) Hashtbl.t) =
      skip_ws ();
      while !pos < len && html.[!pos] <> '>' && html.[!pos] <> '/' do
        let name = parse_name () in
        if name = "" then begin
          (* Avoid infinite loop on unexpected char *)
          if !pos < len then incr pos
        end else begin
          let value =
            if !pos < len && html.[!pos] = '=' then begin
              incr pos; parse_attr_value ()
            end else ""
          in
          let attrs = match Hashtbl.find_opt elem "attributes" with
            | Some (Dict a) -> a
            | _ -> let a = Hashtbl.create 4 in Hashtbl.replace elem "attributes" (Dict a); a in
          Hashtbl.replace attrs name (String value);
          if name = "id" then Hashtbl.replace elem "id" (String value);
          if name = "class" then Hashtbl.replace elem "className" (String value);
          if name = "value" then Hashtbl.replace elem "value" (String value);
          skip_ws ()
        end
      done
    in
    let void_tags = ["br"; "hr"; "img"; "input"; "meta"; "link"; "area";
                     "base"; "col"; "embed"; "source"; "track"; "wbr"] in
    let rec parse_children parent_elem =
      while !pos < len && not (!pos + 1 < len && html.[!pos] = '<' && html.[!pos + 1] = '/') do
        if !pos < len && html.[!pos] = '<' && !pos + 1 < len && is_name_char html.[!pos + 1] then
          parse_element parent_elem
        else if !pos < len && html.[!pos] = '<' then begin
          (* Unknown/comment — skip to next '>' *)
          while !pos < len && html.[!pos] <> '>' do incr pos done;
          if !pos < len then incr pos
        end
        else begin
          let start = !pos in
          while !pos < len && html.[!pos] <> '<' do incr pos done;
          let text = String.sub html start (!pos - start) in
          if String.trim text <> "" then begin
            let cur = match Hashtbl.find_opt parent_elem "textContent" with
              | Some (String s) -> s | _ -> "" in
            Hashtbl.replace parent_elem "textContent" (String (cur ^ text))
          end
        end
      done
    and parse_element parent_elem =
      incr pos;  (* skip '<' *)
      let tag = parse_name () in
      if tag = "" then () else begin
        let el = make_mock_element tag in
        let eld = match el with Dict d -> d | _ -> Hashtbl.create 0 in
        parse_attrs eld;
        skip_ws ();
        let self_closing =
          if !pos < len && html.[!pos] = '/' then begin incr pos; true end else false
        in
        if !pos < len && html.[!pos] = '>' then incr pos;
        let is_void = List.mem (String.lowercase_ascii tag) void_tags in
        if not self_closing && not is_void then begin
          parse_children eld;
          if !pos + 1 < len && html.[!pos] = '<' && html.[!pos + 1] = '/' then begin
            pos := !pos + 2;
            let _ = parse_name () in
            skip_ws ();
            if !pos < len && html.[!pos] = '>' then incr pos
          end
        end;
        ignore (mock_append_child (Dict parent_elem) el)
      end
    in
    pos := 0;
    parse_children parent_d
  in
  let _ = parse_html_into in

  (* Helper: remove child from parent *)
  let mock_remove_child parent child =
    match parent, child with
    | Dict pd, Dict cd ->
      let kids = match Hashtbl.find_opt pd "children" with
        | Some (List l) -> List.filter (fun c -> not (mock_el_eq c child)) l | _ -> [] in
      Hashtbl.replace pd "children" (List kids);
      Hashtbl.replace pd "childNodes" (List kids);
      Hashtbl.replace cd "parentElement" Nil;
      Hashtbl.replace cd "parentNode" Nil;
      child
    | _ -> child
  in

  (* Helper: querySelector - find element matching selector in tree *)
  let rec mock_matches el sel =
    match el with
    | Dict d ->
      let sel = String.trim sel in
      (* Compound selector: tag[attr=value] or tag.class or tag#id — split into parts *)
      if String.length sel > 1 &&
         ((sel.[0] >= 'a' && sel.[0] <= 'z') || (sel.[0] >= 'A' && sel.[0] <= 'Z')) &&
         (String.contains sel '[' || String.contains sel '.' || String.contains sel '#') then
        let i = ref 0 in
        let n = String.length sel in
        while !i < n && ((sel.[!i] >= 'a' && sel.[!i] <= 'z') || (sel.[!i] >= 'A' && sel.[!i] <= 'Z') || (sel.[!i] >= '0' && sel.[!i] <= '9') || sel.[!i] = '-') do incr i done;
        let tag_part = String.sub sel 0 !i in
        let rest_part = String.sub sel !i (n - !i) in
        (mock_matches el tag_part) && (mock_matches el rest_part)
      else if String.length sel > 0 && sel.[0] = '#' then
        let id = String.sub sel 1 (String.length sel - 1) in
        (match Hashtbl.find_opt d "id" with Some (String i) -> i = id | _ -> false)
      else if String.length sel > 0 && sel.[0] = '.' then
        let cls = String.sub sel 1 (String.length sel - 1) in
        List.mem cls (get_classes d)
      else if String.length sel > 0 && sel.[0] = '[' then
        (* [attr] or [attr="value"] *)
        let end_bracket = try String.index sel ']' with Not_found -> String.length sel - 1 in
        let inner = String.sub sel 1 (end_bracket - 1) in
        (match String.split_on_char '=' inner with
         | [attr] ->
           let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
           Hashtbl.mem attrs attr
         | [attr; v] ->
           let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
           let v = if String.length v >= 2 && v.[0] = '"' then String.sub v 1 (String.length v - 2) else v in
           (match Hashtbl.find_opt attrs attr with Some (String s) -> s = v | _ -> false)
         | _ -> false)
      else
        (* Tag name match *)
        (match Hashtbl.find_opt d "tagName" with
         | Some (String t) -> String.lowercase_ascii t = String.lowercase_ascii sel
         | _ -> false)
    | _ -> false
  in

  let split_selector sel =
    String.split_on_char ' ' sel
    |> List.filter (fun s -> String.length s > 0)
  in
  let rec mock_query_selector el sel =
    match split_selector sel with
    | [single] -> mock_query_selector_single el single
    | first :: rest ->
      (match mock_query_selector_single el first with
       | Nil -> Nil
       | found -> mock_query_selector found (String.concat " " rest))
    | [] -> Nil
  and mock_query_selector_single el sel =
    (* Handle tag:nth-of-type(N): find Nth child of same tag under parent *)
    let nth_match = try
      let idx = String.index sel ':' in
      let tag = String.sub sel 0 idx in
      let rest = String.sub sel idx (String.length sel - idx) in
      if String.length rest > String.length ":nth-of-type(" &&
         String.sub rest 0 (String.length ":nth-of-type(") = ":nth-of-type(" &&
         rest.[String.length rest - 1] = ')'
      then
        let n_str = String.sub rest (String.length ":nth-of-type(")
                      (String.length rest - String.length ":nth-of-type(" - 1) in
        (try Some (tag, int_of_string (String.trim n_str)) with _ -> None)
      else None
    with Not_found -> None in
    (match nth_match with
     | Some (tag, n) ->
       (* Walk tree; collect matching-tag elements in document order; return nth *)
       let found = ref [] in
       let rec walk node =
         match node with
         | Dict d ->
           let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
           List.iter (fun child ->
             if mock_matches child tag then found := child :: !found;
             walk child
           ) kids
         | _ -> ()
       in
       walk el;
       let matches = List.rev !found in
       (try List.nth matches (n - 1) with _ -> Nil)
     | None ->
       (match el with
        | Dict d ->
          let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
          let rec search = function
            | [] -> Nil
            | child :: rest ->
              if mock_matches child sel then child
              else match mock_query_selector_single child sel with
                | Nil -> search rest
                | found -> found
          in
          search kids
        | _ -> Nil))
  in

  let rec mock_query_all el sel =
    (* Handle comma-separated selector groups: "a, b, c" *)
    if String.contains sel ',' then
      let parts = String.split_on_char ',' sel
                  |> List.map String.trim
                  |> List.filter (fun s -> String.length s > 0) in
      let seen = ref [] in
      List.concat_map (fun part ->
        let results = mock_query_all el part in
        List.filter (fun r ->
          if List.memq r !seen then false
          else (seen := r :: !seen; true)
        ) results
      ) parts
    else
    match split_selector sel with
    | [single] -> mock_query_all_single el single
    | first :: rest ->
      let roots = mock_query_all_single el first in
      List.concat_map (fun r -> mock_query_all r (String.concat " " rest)) roots
    | [] -> []
  and mock_query_all_single el sel =
    match el with
    | Dict d ->
      let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
      List.concat_map (fun child ->
        (if mock_matches child sel then [child] else []) @ mock_query_all_single child sel
      ) kids
    | _ -> []
  in

  (* Helper: dispatch event with bubbling *)
  let rec mock_dispatch_event target event =
    match event with
    | Dict ev ->
      let cur_target = match Hashtbl.find_opt ev "target" with Some Nil | None -> target | Some x -> x in
      Hashtbl.replace ev "target" cur_target;
      Hashtbl.replace ev "currentTarget" target;
      (match target with
       | Dict td ->
         let listeners = match Hashtbl.find_opt td "_listeners" with Some (Dict l) -> l | _ -> Hashtbl.create 0 in
         let evt_type = match Hashtbl.find_opt ev "type" with Some (String t) -> t | _ -> "" in
         let fns = match Hashtbl.find_opt listeners evt_type with Some (List l) -> l | _ -> [] in
         List.iter (fun fn ->
           let stopped = match Hashtbl.find_opt ev "_stopImmediate" with Some (Bool true) -> true | _ -> false in
           if not stopped then
             (try ignore (Sx_ref.cek_call fn (List [Dict ev]))
              with _ -> ())
         ) fns;
         (* Bubble *)
         let bubbles = match Hashtbl.find_opt ev "bubbles" with Some (Bool true) -> true | _ -> false in
         let stopped = match Hashtbl.find_opt ev "_stopped" with Some (Bool true) -> true | _ -> false in
         if bubbles && not stopped then
           (match Hashtbl.find_opt td "parentElement" with
            | Some (Dict _ as parent) -> ignore (mock_dispatch_event parent (Dict ev))
            | _ -> ())
       | _ -> ());
      let dp = match Hashtbl.find_opt ev "defaultPrevented" with Some (Bool true) -> true | _ -> false in
      Bool (not dp)
    | _ -> Bool true
  in

  (* Register host-* primitives *)
  let reg name fn = Sx_primitives.register name fn in

  reg "host-global" (fun args ->
    match args with
    | [String "document"] -> mock_document
    | [String "window"] -> Nil  (* self-referential, not needed for tests *)
    | [String "console"] ->
      let d = Hashtbl.create 4 in
      Hashtbl.replace d "__mock_type" (String "console");
      Dict d
    | [String name] ->
      (* Check SX env for globally defined things like "tmp" used in HS tests *)
      (try Sx_types.env_get env name with _ -> Nil)
    | _ -> Nil);

  reg "host-get" (fun args ->
    match args with
    | [Nil; _] -> Nil
    | [String s; String "length"] -> Number (float_of_int (String.length s))
    | [List l; String "length"] -> Number (float_of_int (List.length l))
    | [ListRef { contents = l }; String "length"] -> Number (float_of_int (List.length l))
    | [List l; String "size"] -> Number (float_of_int (List.length l))
    | [ListRef { contents = l }; String "size"] -> Number (float_of_int (List.length l))
    | [Dict d; String "size"] when not (Hashtbl.mem d "__mock_type") ->
      Number (float_of_int (Hashtbl.length d))
    | [Dict d; String key] ->
      let mt = match Hashtbl.find_opt d "__mock_type" with Some (String t) -> t | _ -> "" in
      (* classList.length *)
      if mt = "classList" && key = "length" then
        let el = match Hashtbl.find_opt d "__mock_el" with Some (Dict e) -> e | _ -> d in
        Number (float_of_int (List.length (get_classes el)))
      else
        (match Hashtbl.find_opt d key with
         | Some v -> v
         | None ->
           (* For mock elements, return a truthy sentinel for method names
              so that guards like (host-get el "setAttribute") pass *)
           if mt = "element" then
             (match key with
              | "setAttribute" | "getAttribute" | "removeAttribute" | "hasAttribute"
              | "addEventListener" | "removeEventListener" | "dispatchEvent"
              | "appendChild" | "removeChild" | "insertBefore" | "replaceChild"
              | "querySelector" | "querySelectorAll" | "closest" | "matches"
              | "contains" | "compareDocumentPosition" | "cloneNode" | "remove" | "focus" | "blur" | "click"
              | "insertAdjacentHTML" | "prepend" | "showModal" | "show" | "close"
              | "getBoundingClientRect" | "getAnimations" | "scrollIntoView"
              | "scrollTo" | "scroll" | "reset" -> Bool true
              | "firstElementChild" ->
                let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
                (match kids with c :: _ -> c | [] -> Nil)
              | "lastElementChild" ->
                let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
                (match List.rev kids with c :: _ -> c | [] -> Nil)
              | "nextElementSibling" | "nextSibling" ->
                (match Hashtbl.find_opt d "parentElement" with
                 | Some (Dict p) ->
                   let kids = match Hashtbl.find_opt p "children" with Some (List l) -> l | _ -> [] in
                   let self = Dict d in
                   let rec find_next = function
                     | [] | [_] -> Nil
                     | a :: b :: _ when mock_el_eq a self -> b
                     | _ :: rest -> find_next rest in
                   find_next kids
                 | _ -> Nil)
              | "previousElementSibling" | "previousSibling" ->
                (match Hashtbl.find_opt d "parentElement" with
                 | Some (Dict p) ->
                   let kids = match Hashtbl.find_opt p "children" with Some (List l) -> l | _ -> [] in
                   let self = Dict d in
                   let rec find_prev prev = function
                     | [] -> Nil
                     | a :: _ when mock_el_eq a self -> prev
                     | a :: rest -> find_prev a rest in
                   find_prev Nil kids
                 | _ -> Nil)
              | "ownerDocument" -> mock_document
              | _ -> Nil)
           else if mt = "document" then
             (match key with
              | "createElement" | "createElementNS" | "createDocumentFragment"
              | "createTextNode" | "createComment" | "getElementById"
              | "querySelector" | "querySelectorAll" | "createEvent"
              | "addEventListener" | "removeEventListener" -> Bool true
              | "head" ->
                let head = Hashtbl.create 4 in
                Hashtbl.replace head "__mock_type" (String "element");
                Hashtbl.replace head "tagName" (String "HEAD");
                Dict head
              | "activeElement" -> Nil
              | _ -> Nil)
           else Nil)
    | [Dict d; Number n] ->
      (* Array index access *)
      let i = int_of_float n in
      (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))
    | _ -> Nil);

  (* Stringify a value for DOM string properties *)
  let rec dom_stringify = function
    | String s -> String s
    | Number n ->
      let i = int_of_float n in
      if float_of_int i = n then String (string_of_int i) else String (string_of_float n)
    | Bool true -> String "true"
    | Bool false -> String "false"
    | List l -> String (String.concat "," (List.map (fun v -> match dom_stringify v with String s -> s | _ -> "") l))
    | Nil -> String ""
    | Dict d ->
      (* Avoid `inspect` on circular mock-DOM dicts. Prefer outerHTML, fall
         back to a tag placeholder, then "[object Object]". *)
      (match Hashtbl.find_opt d "outerHTML" with
       | Some (String s) when String.length s > 0 -> String s
       | _ ->
         (match Hashtbl.find_opt d "__mock_type" with
          | Some (String "element") ->
            let tag = match Hashtbl.find_opt d "tagName" with
              | Some (String t) -> String.lowercase_ascii t | _ -> "div" in
            String ("<" ^ tag ^ ">")
          | _ -> String "[object Object]"))
    | v -> String (Sx_types.inspect v)
  in

  reg "host-set!" (fun args ->
    match args with
    | [Nil; _; _] -> Nil
    | [Dict d; String key; value] ->
      (* DOM string properties: coerce to string like a browser *)
      let stored = match key with
        | "innerHTML" | "textContent" | "outerHTML" | "value" | "innerText" ->
          dom_stringify value
        | _ -> value
      in
      Hashtbl.replace d key stored;
      (* Side effects for special keys *)
      (match key with
       | "className" ->
         (match Hashtbl.find_opt d "classList" with
          | Some (Dict _cl) -> () (* classes live in className *)
          | _ -> ())
       | "innerHTML" ->
         (* Setting innerHTML clears existing children, parses the HTML, and
            creates new mock child elements (approximating browser behavior). *)
         let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
         List.iter (fun c -> match c with Dict cd ->
           Hashtbl.replace cd "parentElement" Nil;
           Hashtbl.replace cd "parentNode" Nil | _ -> ()) kids;
         Hashtbl.replace d "children" (List []);
         Hashtbl.replace d "childNodes" (List []);
         Hashtbl.replace d "textContent" (String "");
         (match stored with
          | String s when String.contains s '<' ->
            parse_html_into d s;
            (* Strip tags for a best-effort textContent *)
            let buf = Buffer.create (String.length s) in
            let in_tag = ref false in
            String.iter (fun c ->
              if c = '<' then in_tag := true
              else if c = '>' then in_tag := false
              else if not !in_tag then Buffer.add_char buf c
            ) s;
            Hashtbl.replace d "textContent" (String (Buffer.contents buf))
          | String s -> Hashtbl.replace d "textContent" (String s)
          | _ -> Hashtbl.replace d "textContent" (String ""))
       | "textContent" ->
         (* Setting textContent clears children *)
         Hashtbl.replace d "children" (List []);
         Hashtbl.replace d "childNodes" (List [])
       | _ -> ());
      stored
    | [ListRef r; Number n; value] ->
      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
      else if idx = List.length lst then
        r := lst @ [value];
      value
    | [List _; Number _; _value] ->
      (* Immutable list — can't set, but don't crash *)
      Nil
    | _ -> Nil);

  reg "host-call" (fun args ->
    match args with
    | Nil :: String m :: rest ->
      (* Global function call *)
      (match m with
       | "setTimeout" -> (match rest with fn :: _ -> ignore (Sx_ref.cek_call fn (List [])); Nil | _ -> Nil)
       | "clearTimeout" -> Nil
       | _ -> Nil)
    | Dict d :: String "hasOwnProperty" :: [String k] ->
      Bool (Hashtbl.mem d k)
    | Dict d :: String m :: rest ->
      let mt = match Hashtbl.find_opt d "__mock_type" with Some (String t) -> t | _ -> "" in

      if mt = "document" then
        (* Document methods *)
        (match m with
         | "createElement" | "createElementNS" ->
           let tag = match rest with [String t] -> t | [_; String t] -> t | _ -> "div" in
           make_mock_element tag
         | "createDocumentFragment" ->
           let el = make_mock_element "fragment" in
           (match el with Dict d -> Hashtbl.replace d "nodeType" (Number 11.0); el | _ -> el)
         | "createTextNode" ->
           let text = match rest with [String t] -> t | _ -> "" in
           let d = Hashtbl.create 4 in
           Hashtbl.replace d "__mock_type" (String "text");
           Hashtbl.replace d "nodeType" (Number 3.0);
           Hashtbl.replace d "textContent" (String text);
           Hashtbl.replace d "data" (String text);
           Dict d
         | "createComment" ->
           let d = Hashtbl.create 4 in
           Hashtbl.replace d "__mock_type" (String "comment");
           Hashtbl.replace d "nodeType" (Number 8.0);
           Dict d
         | "getElementById" ->
           let id = match rest with [String i] -> i | _ -> "" in
           let body = match Hashtbl.find_opt d "body" with Some b -> b | None -> Nil in
           mock_query_selector body ("#" ^ id)
         | "querySelector" ->
           let sel = match rest with [String s] -> s | _ -> "" in
           let body = match Hashtbl.find_opt d "body" with Some b -> b | None -> Nil in
           mock_query_selector body sel
         | "querySelectorAll" ->
           let sel = match rest with [String s] -> s | _ -> "" in
           let body = match Hashtbl.find_opt d "body" with Some b -> b | None -> Nil in
           List (mock_query_all body sel)
         | "createEvent" ->
           let ev = Hashtbl.create 4 in
           Hashtbl.replace ev "__mock_type" (String "event");
           Dict ev
         | "addEventListener" | "removeEventListener" -> Nil
         | _ -> Nil)

      else if mt = "classList" then
        let el = match Hashtbl.find_opt d "__mock_el" with Some (Dict e) -> e | _ -> d in
        (match m with
         | "add" ->
           let classes = get_classes el in
           let new_classes = List.fold_left (fun acc a ->
             match a with String c when not (List.mem c acc) -> acc @ [c] | _ -> acc
           ) classes rest in
           set_classes el new_classes; Nil
         | "remove" ->
           let classes = get_classes el in
           let to_remove = List.filter_map (function String c -> Some c | _ -> None) rest in
           let new_classes = List.filter (fun c -> not (List.mem c to_remove)) classes in
           set_classes el new_classes; Nil
         | "toggle" ->
           (match rest with
            | [String cls] ->
              let classes = get_classes el in
              if List.mem cls classes then
                (set_classes el (List.filter (fun c -> c <> cls) classes); Bool false)
              else
                (set_classes el (classes @ [cls]); Bool true)
            | [String cls; Bool force] ->
              let classes = get_classes el in
              if force then
                (if not (List.mem cls classes) then set_classes el (classes @ [cls]); Bool true)
              else
                (set_classes el (List.filter (fun c -> c <> cls) classes); Bool false)
            | _ -> Nil)
         | "contains" ->
           (match rest with
            | [String cls] -> Bool (List.mem cls (get_classes el))
            | _ -> Bool false)
         | _ -> Nil)

      else if mt = "event" then
        (match m with
         | "preventDefault" -> Hashtbl.replace d "defaultPrevented" (Bool true); Nil
         | "stopPropagation" -> Hashtbl.replace d "_stopped" (Bool true); Nil
         | "stopImmediatePropagation" ->
           Hashtbl.replace d "_stopped" (Bool true);
           Hashtbl.replace d "_stopImmediate" (Bool true); Nil
         | _ -> Nil)

      else if mt = "style" then
        (match m with
         | "setProperty" ->
           (match rest with
            | [String prop; String value] -> Hashtbl.replace d prop (String value); Nil
            | [String prop; value] -> Hashtbl.replace d prop value; Nil
            | _ -> Nil)
         | "removeProperty" ->
           (match rest with [String prop] -> Hashtbl.remove d prop; Nil | _ -> Nil)
         | "getPropertyValue" ->
           (match rest with
            | [String prop] -> (match Hashtbl.find_opt d prop with Some v -> v | None -> String "")
            | _ -> String "")
         | _ -> Nil)

      else if mt = "console" then
        (* console.log/debug/error — no-op in tests *)
        Nil

      else
        (* Element methods *)
        (match m with
         | "setAttribute" ->
           (match rest with
            | [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 | 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);
              if name = "id" then Hashtbl.replace d "id" (String sv);
              if name = "class" then begin
                Hashtbl.replace d "className" (String sv);
              end;
              if name = "disabled" then Hashtbl.replace d "disabled" (Bool true);
              if name = "checked" then begin
                Hashtbl.replace d "defaultChecked" (Bool true);
                Hashtbl.replace d "checked" (Bool true);
              end;
              if name = "selected" then begin
                Hashtbl.replace d "defaultSelected" (Bool true);
                Hashtbl.replace d "selected" (Bool true);
              end;
              if name = "value" then begin
                (match Hashtbl.find_opt d "defaultValue" with
                 | Some _ -> ()
                 | None -> Hashtbl.replace d "defaultValue" (String sv));
                Hashtbl.replace d "value" (String sv);
              end;
              if name = "type" then Hashtbl.replace d "type" (String sv);
              if name = "style" then begin
                (* Parse CSS string into the style sub-dict *)
                let style_d = match Hashtbl.find_opt d "style" with Some (Dict s) -> s | _ ->
                  let s = Hashtbl.create 4 in Hashtbl.replace d "style" (Dict s); s in
                let parts = String.split_on_char ';' sv in
                List.iter (fun part ->
                  let part = String.trim part in
                  if String.length part > 0 then
                    match String.index_opt part ':' with
                    | Some i ->
                      let prop = String.trim (String.sub part 0 i) in
                      let value = String.trim (String.sub part (i+1) (String.length part - i - 1)) in
                      Hashtbl.replace style_d prop (String value)
                    | None -> ()
                ) parts
              end;
              Nil
            | _ -> Nil)
         | "getAttribute" ->
           (match rest with
            | [String name] ->
              let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
              (match Hashtbl.find_opt attrs name with Some v -> v | None -> Nil)
            | _ -> Nil)
         | "removeAttribute" ->
           (match rest with
            | [String name] ->
              let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
              Hashtbl.remove attrs name;
              if name = "disabled" then Hashtbl.replace d "disabled" (Bool false);
              Nil
            | _ -> Nil)
         | "hasAttribute" ->
           (match rest with
            | [String name] ->
              let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
              Bool (Hashtbl.mem attrs name)
            | _ -> Bool false)
         | "addEventListener" ->
           (match rest with
            | String evt_name :: fn :: _ ->
              let listeners = match Hashtbl.find_opt d "_listeners" with Some (Dict l) -> l | _ ->
                let l = Hashtbl.create 4 in Hashtbl.replace d "_listeners" (Dict l); l in
              let fns = match Hashtbl.find_opt listeners evt_name with Some (List l) -> l | _ -> [] in
              Hashtbl.replace listeners evt_name (List (fns @ [fn]));
              Nil
            | _ -> Nil)
         | "removeEventListener" ->
           (match rest with
            | [String evt_name; fn] ->
              let listeners = match Hashtbl.find_opt d "_listeners" with Some (Dict l) -> l | _ -> Hashtbl.create 0 in
              let fns = match Hashtbl.find_opt listeners evt_name with Some (List l) -> l | _ -> [] in
              Hashtbl.replace listeners evt_name (List (List.filter (fun f -> f != fn) fns));
              Nil
            | _ -> Nil)
         | "dispatchEvent" ->
           (match rest with [ev] -> mock_dispatch_event (Dict d) ev | _ -> Nil)
         | "appendChild" ->
           (match rest with [child] -> mock_append_child (Dict d) child | _ -> Nil)
         | "removeChild" ->
           (match rest with [child] -> mock_remove_child (Dict d) child | _ -> Nil)
         | "insertBefore" ->
           (match rest with
            | [new_child; ref_child] ->
              (* Remove from old parent *)
              (match new_child with
               | Dict cd -> (match Hashtbl.find_opt cd "parentElement" with
                 | Some (Dict p) -> ignore (mock_remove_child (Dict p) new_child) | _ -> ())
               | _ -> ());
              let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
              let idx = let rec find_idx i = function [] -> List.length kids | c :: _ when c == ref_child -> i | _ :: rest -> find_idx (i+1) rest in find_idx 0 kids in
              let before = List.filteri (fun i _ -> i < idx) kids in
              let after = List.filteri (fun i _ -> i >= idx) kids in
              let new_kids = before @ [new_child] @ after in
              Hashtbl.replace d "children" (List new_kids);
              Hashtbl.replace d "childNodes" (List new_kids);
              (match new_child with Dict cd ->
                Hashtbl.replace cd "parentElement" (Dict d);
                Hashtbl.replace cd "parentNode" (Dict d) | _ -> ());
              new_child
            | _ -> Nil)
         | "replaceChild" ->
           (match rest with
            | [new_child; old_child] ->
              let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
              let new_kids = List.map (fun c -> if c == old_child then new_child else c) kids in
              Hashtbl.replace d "children" (List new_kids);
              Hashtbl.replace d "childNodes" (List new_kids);
              (match new_child with Dict cd ->
                Hashtbl.replace cd "parentElement" (Dict d);
                Hashtbl.replace cd "parentNode" (Dict d) | _ -> ());
              (match old_child with Dict cd ->
                Hashtbl.replace cd "parentElement" Nil;
                Hashtbl.replace cd "parentNode" Nil | _ -> ());
              old_child
            | _ -> Nil)
         | "remove" ->
           (match Hashtbl.find_opt d "parentElement" with
            | Some (Dict p) -> ignore (mock_remove_child (Dict p) (Dict d)) | _ -> ());
           Nil
         | "querySelector" ->
           (match rest with [String sel] -> mock_query_selector (Dict d) sel | _ -> Nil)
         | "querySelectorAll" ->
           (match rest with [String sel] -> List (mock_query_all (Dict d) sel) | _ -> List [])
         | "closest" ->
           (match rest with
            | [String sel] ->
              let rec up = function
                | Dict e as el -> if mock_matches el sel then el else
                  (match Hashtbl.find_opt e "parentElement" with Some (Dict _ as p) -> up p | _ -> Nil)
                | _ -> Nil
              in up (Dict d)
            | _ -> Nil)
         | "compareDocumentPosition" ->
           (match rest with
            | [other] ->
              let self = Dict d in
              let body = Dict mock_body in
              let found_self = ref false in
              let found_other = ref false in
              let self_first = ref false in
              let rec walk node =
                if !found_self && !found_other then ()
                else begin
                  if mock_el_eq node self then begin
                    if not !found_other then self_first := true;
                    found_self := true
                  end;
                  if mock_el_eq node other then found_other := true;
                  (match node with
                   | Dict dd -> let kids = match Hashtbl.find_opt dd "children" with Some (List l) -> l | _ -> [] in
                     List.iter walk kids
                   | _ -> ())
                end
              in
              walk body;
              if !found_self && !found_other then
                Number (if !self_first then 4.0 else 2.0)
              else Number 0.0
            | _ -> Number 0.0)
         | "matches" ->
           (match rest with [String sel] -> Bool (mock_matches (Dict d) sel) | _ -> Bool false)
         | "contains" ->
           (match rest with
            | [target] ->
              let rec contains_check el =
                if el == target then true
                else match el with
                  | Dict dd -> let kids = match Hashtbl.find_opt dd "children" with Some (List l) -> l | _ -> [] in
                    List.exists contains_check kids
                  | _ -> false
              in Bool (contains_check (Dict d))
            | _ -> Bool false)
         | "cloneNode" ->
           let deep = match rest with [Bool b] -> b | _ -> false in
           let rec clone_el el = match el with Dict src ->
             let nd = Hashtbl.create 16 in
             Hashtbl.iter (fun k v ->
               if k <> "parentElement" && k <> "parentNode" && k <> "_listeners" && k <> "children" && k <> "childNodes" then
                 Hashtbl.replace nd k v
             ) src;
             Hashtbl.replace nd "parentElement" Nil;
             Hashtbl.replace nd "parentNode" Nil;
             Hashtbl.replace nd "_listeners" (Dict (Hashtbl.create 4));
             incr mock_el_counter;
             Hashtbl.replace nd "__mock_id" (Number (float_of_int !mock_el_counter));
             Hashtbl.replace nd "__host_handle" (Number (float_of_int !mock_el_counter));
             let new_style = Hashtbl.create 4 in
             (match Hashtbl.find_opt src "style" with
              | Some (Dict s) -> Hashtbl.iter (fun k v -> if k <> "__mock_el" then Hashtbl.replace new_style k v) s
              | _ -> ());
             Hashtbl.replace new_style "__mock_type" (String "style");
             Hashtbl.replace new_style "__mock_el" (Dict nd);
             Hashtbl.replace nd "style" (Dict new_style);
             let new_cl = Hashtbl.create 4 in
             Hashtbl.replace new_cl "__mock_type" (String "classList");
             Hashtbl.replace new_cl "__mock_el" (Dict nd);
             Hashtbl.replace nd "classList" (Dict new_cl);
             if deep then begin
               let kids = match Hashtbl.find_opt src "children" with Some (List l) -> l | _ -> [] in
               let cloned_kids = List.map (fun c -> match c with Dict _ -> clone_el c | _ -> c) kids in
               List.iter (fun c -> match c with Dict cd ->
                 Hashtbl.replace cd "parentElement" (Dict nd);
                 Hashtbl.replace cd "parentNode" (Dict nd) | _ -> ()) cloned_kids;
               Hashtbl.replace nd "children" (List cloned_kids);
               Hashtbl.replace nd "childNodes" (List cloned_kids)
             end else begin
               Hashtbl.replace nd "children" (List []);
               Hashtbl.replace nd "childNodes" (List [])
             end;
             Dict nd
           | _ -> el
           in
           (match rest with _ -> clone_el (Dict d))
         | "focus" | "blur" | "scrollIntoView" | "scrollTo" | "scroll" -> Nil
         | "click" ->
           let ev = Hashtbl.create 8 in
           Hashtbl.replace ev "__mock_type" (String "event");
           Hashtbl.replace ev "type" (String "click");
           Hashtbl.replace ev "bubbles" (Bool true);
           Hashtbl.replace ev "cancelable" (Bool true);
           Hashtbl.replace ev "defaultPrevented" (Bool false);
           Hashtbl.replace ev "_stopped" (Bool false);
           Hashtbl.replace ev "_stopImmediate" (Bool false);
           Hashtbl.replace ev "target" (Dict d);
           mock_dispatch_event (Dict d) (Dict ev)
         | "getAnimations" -> List []
         | "getBoundingClientRect" ->
           let r = Hashtbl.create 8 in
           Hashtbl.replace r "top" (Number 0.0); Hashtbl.replace r "left" (Number 0.0);
           Hashtbl.replace r "width" (Number 100.0); Hashtbl.replace r "height" (Number 100.0);
           Hashtbl.replace r "right" (Number 100.0); Hashtbl.replace r "bottom" (Number 100.0);
           Dict r
         | "insertAdjacentHTML" ->
           (* Position-aware insertion. Parse the new HTML into a scratch
              container, then splice the resulting children into the target
              position WITHOUT disturbing sibling nodes. *)
           (match rest with
            | [String pos_kind; value] ->
              let html = match dom_stringify value with String s -> s | _ -> "" in
              (* Parse new HTML into scratch container to get new child list.
                 For pure-text content, wrap into the target's innerHTML path. *)
              let scratch = make_mock_element "div" in
              let scratch_d = match scratch with Dict sd -> sd | _ -> Hashtbl.create 0 in
              if String.contains html '<' then parse_html_into scratch_d html;
              let new_kids = match Hashtbl.find_opt scratch_d "children" with Some (List l) -> l | _ -> [] in
              let prepend = pos_kind = "beforebegin" || pos_kind = "afterbegin" in
              let insert_into container_d index =
                List.iter (fun c -> match c with
                  | Dict cd ->
                    Hashtbl.replace cd "parentElement" (Dict container_d);
                    Hashtbl.replace cd "parentNode" (Dict container_d)
                  | _ -> ()) new_kids;
                let kids = match Hashtbl.find_opt container_d "children" with Some (List l) -> l | _ -> [] in
                let before = List.filteri (fun i _ -> i < index) kids in
                let after = List.filteri (fun i _ -> i >= index) kids in
                let all = before @ new_kids @ after in
                Hashtbl.replace container_d "children" (List all);
                Hashtbl.replace container_d "childNodes" (List all);
                (* Update container innerHTML based on position kind, not index *)
                let cur = match Hashtbl.find_opt container_d "innerHTML" with Some (String s) -> s | _ -> "" in
                let new_html = if prepend then html ^ cur else cur ^ html in
                Hashtbl.replace container_d "innerHTML" (String new_html);
                let buf = Buffer.create (String.length new_html) in
                let in_tag = ref false in
                String.iter (fun c ->
                  if c = '<' then in_tag := true
                  else if c = '>' then in_tag := false
                  else if not !in_tag then Buffer.add_char buf c
                ) new_html;
                Hashtbl.replace container_d "textContent" (String (Buffer.contents buf))
              in
              (match pos_kind with
               | "beforebegin" | "afterend" ->
                 (match Hashtbl.find_opt d "parentElement" with
                  | Some (Dict pd) ->
                    let siblings = match Hashtbl.find_opt pd "children" with Some (List l) -> l | _ -> [] in
                    let rec find_idx i = function
                      | [] -> List.length siblings
                      | x :: _ when mock_el_eq x (Dict d) -> i
                      | _ :: rest -> find_idx (i+1) rest
                    in
                    let self_idx = find_idx 0 siblings in
                    let insert_idx = if pos_kind = "beforebegin" then self_idx else self_idx + 1 in
                    insert_into pd insert_idx
                  | _ -> ())
               | "afterbegin" -> insert_into d 0
               | _ (* "beforeend" *) ->
                 let kids_len = match Hashtbl.find_opt d "children" with Some (List l) -> List.length l | _ -> 0 in
                 insert_into d kids_len);
              Nil
            | _ -> Nil)
         | "showModal" | "show" ->
           Hashtbl.replace d "open" (Bool true);
           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
           Hashtbl.replace attrs "open" (String ""); Nil
         | "close" ->
           Hashtbl.replace d "open" (Bool false);
           let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
           Hashtbl.remove attrs "open"; Nil
         | "prepend" ->
           (match rest with
            | [child] ->
              let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
              Hashtbl.replace d "children" (List (child :: kids));
              Hashtbl.replace d "childNodes" (List (child :: kids));
              (match child with Dict cd ->
                Hashtbl.replace cd "parentElement" (Dict d);
                Hashtbl.replace cd "parentNode" (Dict d) | _ -> ());
              Nil
            | _ -> Nil)
         | "reset" ->
           (* Reset form elements to their default values *)
           let get_attrs (dd : (string, Sx_types.value) Hashtbl.t) =
             match Hashtbl.find_opt dd "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0
           in
           let reset_input (ed : (string, Sx_types.value) Hashtbl.t) =
             let attrs = get_attrs ed in
             let typ = match Hashtbl.find_opt attrs "type" with Some (String t) -> String.lowercase_ascii t | _ -> "text" in
             if typ = "checkbox" || typ = "radio" then
               Hashtbl.replace ed "checked" (Bool (Hashtbl.mem attrs "checked"))
             else
               let dv = match Hashtbl.find_opt attrs "value" with Some v -> v | None -> String "" in
               Hashtbl.replace ed "value" dv
           in
           let reset_textarea (ed : (string, Sx_types.value) Hashtbl.t) =
             let attrs = get_attrs ed in
             let dv = match Hashtbl.find_opt attrs "value" with
               | Some v -> v
               | None -> (match Hashtbl.find_opt ed "textContent" with Some v -> v | None -> String "")
             in
             Hashtbl.replace ed "value" dv
           in
           let reset_select (ed : (string, Sx_types.value) Hashtbl.t) =
             let kids = match Hashtbl.find_opt ed "children" with Some (List l) -> l | _ -> [] in
             let v = List.fold_left (fun (acc : string) (k : Sx_types.value) ->
               match k with
               | Dict od ->
                 let a = get_attrs od in
                 let ov = match Hashtbl.find_opt a "value" with Some (String s) -> s | _ -> "" in
                 if acc = "" then ov
                 else if Hashtbl.mem a "selected" then ov
                 else acc
               | _ -> acc
             ) "" kids in
             Hashtbl.replace ed "value" (String v)
           in
           let rec reset_el (el : Sx_types.value) =
             match el with
             | Dict ed ->
               let tag = match Hashtbl.find_opt ed "tagName" with Some (String t) -> String.lowercase_ascii t | _ -> "" in
               if tag = "input" then reset_input ed
               else if tag = "textarea" then reset_textarea ed
               else if tag = "select" then reset_select ed
               else
                 let kids = match Hashtbl.find_opt ed "children" with Some (List l) -> l | _ -> [] in
                 List.iter reset_el kids
             | _ -> ()
           in
           reset_el (Dict d); Nil
         | _ -> Nil)
    | _ -> Nil);

  reg "host-new" (fun args ->
    match args with
    | [String "CustomEvent"; String typ] ->
      let ev = Hashtbl.create 8 in
      Hashtbl.replace ev "__mock_type" (String "event");
      Hashtbl.replace ev "type" (String typ);
      Hashtbl.replace ev "bubbles" (Bool false);
      Hashtbl.replace ev "cancelable" (Bool true);
      Hashtbl.replace ev "defaultPrevented" (Bool false);
      Hashtbl.replace ev "_stopped" (Bool false);
      Hashtbl.replace ev "_stopImmediate" (Bool false);
      Hashtbl.replace ev "target" Nil;
      Hashtbl.replace ev "detail" Nil;
      Dict ev
    | [String "CustomEvent"; String typ; Dict opts] ->
      let ev = Hashtbl.create 8 in
      Hashtbl.replace ev "__mock_type" (String "event");
      Hashtbl.replace ev "type" (String typ);
      Hashtbl.replace ev "bubbles" (match Hashtbl.find_opt opts "bubbles" with Some v -> v | None -> Bool false);
      Hashtbl.replace ev "cancelable" (match Hashtbl.find_opt opts "cancelable" with Some v -> v | None -> Bool true);
      Hashtbl.replace ev "defaultPrevented" (Bool false);
      Hashtbl.replace ev "_stopped" (Bool false);
      Hashtbl.replace ev "_stopImmediate" (Bool false);
      Hashtbl.replace ev "target" Nil;
      Hashtbl.replace ev "detail" (match Hashtbl.find_opt opts "detail" with Some v -> v | None -> Nil);
      Dict ev
    | [String "Event"; String typ] ->
      let ev = Hashtbl.create 8 in
      Hashtbl.replace ev "__mock_type" (String "event");
      Hashtbl.replace ev "type" (String typ);
      Hashtbl.replace ev "bubbles" (Bool false);
      Hashtbl.replace ev "defaultPrevented" (Bool false);
      Hashtbl.replace ev "_stopped" (Bool false);
      Hashtbl.replace ev "_stopImmediate" (Bool false);
      Dict ev
    | [String "Object"] ->
      Dict (Hashtbl.create 4)
    | _ -> Nil);

  reg "host-callback" (fun args ->
    match args with
    | [fn] ->
      (* Wrap SX function as a NativeFn that calls it via CEK *)
      (match fn with
       | NativeFn _ -> fn  (* already a native fn *)
       | Lambda _ | Component _ ->
         NativeFn ("host-callback", fun cb_args ->
           try Sx_ref.cek_call fn (List cb_args)
           with e -> Printf.eprintf "[mock] host-callback error: %s\n%!" (Printexc.to_string e); Nil)
       | _ -> NativeFn ("host-callback-noop", fun _ -> Nil))
    | _ -> NativeFn ("host-callback-noop", fun _ -> Nil));

  reg "host-typeof" (fun args ->
    match args with
    | [Nil] -> String "nil"
    | [Dict d] ->
      (match Hashtbl.find_opt d "__mock_type" with
       | Some (String "element") -> String "element"
       | Some (String "text") -> String "text"
       | Some (String "event") -> String "event"
       | Some (String "document") -> String "document"
       | _ -> String "object")
    | [String _] -> String "string"
    | [Number _] -> String "number"
    | [Bool _] -> String "boolean"
    | [NativeFn _] | [Lambda _] -> String "function"
    | _ -> String "nil");

  reg "host-await" (fun _args -> Nil);

  (* Minimal JSON parse/stringify used by hs-coerce (as JSON / as JSONString). *)
  let rec json_of_value = function
    | Nil -> `Null
    | Bool b -> `Bool b
    | Number n ->
      if Float.is_integer n && Float.abs n < 1e16
      then `Int (int_of_float n) else `Float n
    | String s -> `String s
    | List items -> `List (List.map json_of_value items)
    | Dict d ->
      let pairs = Hashtbl.fold (fun k v acc ->
        if String.length k >= 2 && String.sub k 0 2 = "__" then acc
        else (k, json_of_value v) :: acc) d [] in
      `Assoc (List.sort (fun (a, _) (b, _) -> compare a b) pairs)
    | _ -> `Null
  in
  let rec value_of_json = function
    | `Null -> Nil
    | `Bool b -> Bool b
    | `Int i -> Number (float_of_int i)
    | `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)
    | `Assoc pairs ->
      let d = Hashtbl.create (List.length pairs) in
      List.iter (fun (k, v) -> Hashtbl.replace d k (value_of_json v)) pairs;
      Dict d
    | `Tuple xs -> List (List.map value_of_json xs)
    | `Variant (name, arg) ->
      match arg with
      | Some v -> List [String name; value_of_json v]
      | None -> String name
  in
  reg "json-stringify" (fun args ->
    match args with
    | [v] -> String (Yojson.Safe.to_string (json_of_value v))
    | _ -> raise (Eval_error "json-stringify: expected 1 arg"));
  reg "json-parse" (fun args ->
    match args with
    | [String s] ->
      (try value_of_json (Yojson.Safe.from_string s)
       with _ -> raise (Eval_error ("json-parse: invalid JSON: " ^ s)))
    | _ -> raise (Eval_error "json-parse: expected string"));

  (* Reset mock body — called between tests via hs-cleanup! *)
  reg "mock-dom-reset!" (fun _args ->
    Hashtbl.replace mock_body "children" (List []);
    Hashtbl.replace mock_body "childNodes" (List []);
    Hashtbl.replace mock_body "innerHTML" (String "");
    Hashtbl.replace mock_body "textContent" (String "");
    Nil);

  (* IO resolution function — used by both run_with_io and _cek_io_suspend_hook *)
  let resolve_io request =
    let req_list = match request with List l -> l | ListRef { contents = l } -> l | _ -> [] in
    let op, args = match req_list with
      | String op :: rest -> op, rest
      | Symbol op :: rest -> op, rest
      | _ ->
        (match request with
         | Dict d ->
           let op = match Hashtbl.find_opt d "op" with Some (String s) -> s | _ -> "" in
           let a = match Hashtbl.find_opt d "args" with Some (List l) -> l | _ -> [] in
           op, a
         | _ -> "", [])
    in
    match op with
    | "io-sleep" | "io-wait" | "io-settle" | "io-wait-for" -> Nil
    | "io-fetch" ->
      let url = match args with String u :: _ -> u | _ -> "" in
      let format = match args with _ :: String f :: _ -> f | _ -> "text" in
      let body = "yay" in
      (match format with
       | "json" | "JSON" | "Object" ->
         let j = Hashtbl.create 2 in
         Hashtbl.replace j "foo" (Number 1.0); Dict j
       | "html" | "HTML" ->
         String "[object DocumentFragment]"
       | "Number" | "Int" | "Integer" | "Float" ->
         String "1.2"
       | "response" | "Response" ->
         let resp = Hashtbl.create 4 in
         Hashtbl.replace resp "ok" (Bool true);
         Hashtbl.replace resp "status" (Number 200.0);
         Hashtbl.replace resp "url" (String url);
         Hashtbl.replace resp "text" (String body);
         Dict resp
       | _ -> String body)
    | _ -> Nil
  in

  (* Use suspend hook (not resolver) — cek_run's resume has a propagation bug.
     The hook receives the suspended state and must return the final value. *)
  Sx_types._cek_io_resolver := None;
  Sx_types._cek_io_suspend_hook := Some (fun suspended ->
    let request = Sx_ref.cek_io_request suspended in
    let response = resolve_io request in
    (* Resume by manually stepping from the resumed state *)
    let resumed = Sx_ref.cek_resume suspended response in
    let is_terminal st = match Sx_ref.cek_terminal_p st with Bool true -> true | _ -> false in
    let is_suspended st = match Sx_runtime.get_val st (String "phase") with String "io-suspended" -> true | _ -> false in
    let s = ref resumed in
    while not (is_terminal !s) && not (is_suspended !s) do
      (try s := Sx_ref.cek_step !s
       with Sx_types.CekPerformRequest req ->
         let resp = resolve_io req in
         s := Sx_ref.cek_resume (Sx_ref.make_cek_suspended req (Sx_ref.cek_env !s) (Sx_ref.cek_kont !s)) resp)
    done;
    if is_suspended !s then
      let req2 = Sx_ref.cek_io_request !s in
      let resp2 = resolve_io req2 in
      Sx_ref.cek_value (Sx_ref.cek_resume !s resp2)
    else
      Sx_ref.cek_value !s);

  (* Load modules needed by tests *)
  let spec_dir = Filename.concat project_dir "spec" in
  let lib_dir = Filename.concat project_dir "lib" in
  let web_dir = Filename.concat project_dir "web" in
  let load_module name dir =
    let path = Filename.concat dir name in
    if Sys.file_exists path then begin
      Printf.printf "Loading %s...\n%!" name;
      (try load_and_eval path
       with e -> Printf.eprintf "Warning: %s: %s\n%!" name (Printexc.to_string e))
    end
  in
  (* R7RS compatibility library — minimal test version *)
  load_module "r7rs.sx" lib_dir;
  (* Render adapter for test-render-html.sx *)
  load_module "render.sx" spec_dir;
  load_module "canonical.sx" spec_dir;
  load_module "adapter-html.sx" web_dir;
  load_module "adapter-sx.sx" web_dir;
  (* Web modules for web/tests/ *)
  load_module "forms.sx" web_dir;
  load_module "engine.sx" web_dir;
  load_module "page-helpers.sx" web_dir;
  load_module "request-handler.sx" web_dir;
  load_module "router.sx" web_dir;
  load_module "deps.sx" web_dir;
  load_module "orchestration.sx" web_dir;
  (* Library modules for lib/tests/ *)
  load_module "bytecode.sx" lib_dir;
  load_module "compiler.sx" lib_dir;
  load_module "vm.sx" lib_dir;
  (* Rebind vm-execute-module and code-from-value to native OCaml implementations.
     The SX versions from vm.sx run bytecode step-by-step in the interpreter —
     far too slow for the test suite. Native versions use the compiled OCaml VM. *)
  (* Wrap SX vm-execute-module to seed empty globals with primitives + env.
     The SX VM resolves CALL_PRIM/GLOBAL_GET from globals — without seeding,
     even (+ 1 2) fails. We keep the SX version (not native Sx_vm) so
     suspension tests work (SX VM suspends via dict, native VM via exception). *)
  let sx_vm_execute = try Some (Sx_types.env_get env "vm-execute-module") with _ -> None in
  ignore (Sx_types.env_bind env "vm-execute-module" (NativeFn ("vm-execute-module", fun args ->
    match args with
    | [code; Dict globals] ->
      if Hashtbl.length globals = 0 then begin
        Hashtbl.iter (fun name fn ->
          Hashtbl.replace globals name (NativeFn (name, fn))
        ) Sx_primitives.primitives;
        let rec add_env e =
          Hashtbl.iter (fun id v ->
            let name = Sx_types.unintern id in
            if not (Hashtbl.mem globals name) then
              Hashtbl.replace globals name v) e.Sx_types.bindings;
          match e.Sx_types.parent with Some p -> add_env p | None -> ()
        in add_env env
      end;
      (* Use native VM for speed — much faster than SX step-by-step *)
      let c = Sx_vm.code_from_value code in
      (try Sx_vm.execute_module c globals
       with Sx_vm.VmSuspended (_request, _saved_vm) ->
         (* Fall back to SX version for suspension handling *)
         Hashtbl.remove globals "__io_request";
         match sx_vm_execute with
         | Some fn -> Sx_ref.cek_call fn (List [code; Dict globals])
         | None -> Nil)
    | _ ->
      match sx_vm_execute with
      | Some fn -> Sx_ref.cek_call fn (List args)
      | None -> Nil)));
  load_module "signals.sx" spec_dir;  (* core reactive primitives *)
  load_module "signals.sx" web_dir;   (* web extensions *)
  load_module "freeze.sx" lib_dir;
  load_module "content.sx" lib_dir;
  load_module "parser-combinators.sx" lib_dir;
  load_module "graphql.sx" lib_dir;
  load_module "graphql-exec.sx" lib_dir;
  (* DOM module — provides dom-* wrappers around host-* primitives *)
  let web_lib_dir = Filename.concat web_dir "lib" in
  load_module "dom.sx" web_lib_dir;
  load_module "browser.sx" web_lib_dir;
  (* browser.sx redefines json-parse/json-stringify as SX wrappers over
     host-global "JSON" — that returns Nil in the OCaml mock env, so the
     wrappers silently return Nil. Re-bind to the native primitives so
     hyperscript `as JSON` / `as JSONString` actually work in tests. *)
  (match Hashtbl.find_opt Sx_primitives.primitives "json-parse" with
   | Some fn -> ignore (Sx_types.env_bind env "json-parse" (NativeFn ("json-parse", fn)))
   | None -> ());
  (match Hashtbl.find_opt Sx_primitives.primitives "json-stringify" with
   | Some fn -> ignore (Sx_types.env_bind env "json-stringify" (NativeFn ("json-stringify", fn)))
   | None -> ());
  let hs_dir = Filename.concat lib_dir "hyperscript" in
  load_module "tokenizer.sx" hs_dir;
  load_module "parser.sx" hs_dir;
  load_module "compiler.sx" hs_dir;
  load_module "runtime.sx" hs_dir;
  load_module "integration.sx" hs_dir;
  load_module "htmx.sx" hs_dir;
  (* Override console-log to avoid str on circular mock DOM refs *)
  ignore (Sx_types.env_bind env "console-log" (NativeFn ("console-log", fun _ -> Nil)));
  ignore (Sx_types.env_bind env "console-debug" (NativeFn ("console-debug", fun _ -> Nil)));
  ignore (Sx_types.env_bind env "console-error" (NativeFn ("console-error", fun _ -> Nil)));
  (* promiseAString / promiseAnInt: upstream hyperscript tests use these to
     exercise promise awaiting. In the synchronous mock environment they
     resolve immediately to the expected value. *)
  ignore (Sx_types.env_bind env "promiseAString" (NativeFn ("promiseAString", fun _ -> String "foo")));
  ignore (Sx_types.env_bind env "promiseAnInt" (NativeFn ("promiseAnInt", fun _ -> Number 42.0)));
  (* eval-hs: compile hyperscript source to SX and evaluate it.
     Used by eval-only behavioral tests (comparisonOperator, mathOperator, etc.).
     Accepts optional ctx dict: {:me V :locals {:x V :y V ...}}. Catches
     hs-return raise and returns the payload. *)
  ignore (Sx_types.env_bind env "eval-hs" (NativeFn ("eval-hs", fun args ->
    let contains s sub = try ignore (String.index s sub.[0]); let rec check i j =
      if j >= String.length sub then true
      else if i >= String.length s then false
      else if s.[i] = sub.[j] then check (i+1) (j+1)
      else false in
      let rec scan i = if i > String.length s - String.length sub then false
        else if check i 0 then true else scan (i+1) in scan 0
      with _ -> false in
    let src, ctx = match args with
      | [String s] -> s, None
      | [String s; Dict d] -> s, Some d
      | _ -> raise (Eval_error "eval-hs: expected string [ctx-dict]")
    in
    let wrapped =
      let has_cmd = (String.length src > 4 &&
        (String.sub src 0 4 = "set " || String.sub src 0 4 = "put " ||
         String.sub src 0 4 = "get ")) ||
        (String.length src > 5 && String.sub src 0 5 = "pick ") ||
        contains src "return " || contains src "then " in
      if has_cmd then src else "return " ^ src
    in
    let sx_expr = eval_expr (List [Symbol "hs-to-sx-from-source"; String wrapped]) (Env env) in
    (* Build wrapper: (fn (me) (let ((it nil) (event nil) [locals...]) sx_expr))
       called with me-val. Catches hs-return raise. *)
    let me_val = match ctx with
      | Some d -> (match Hashtbl.find_opt d "me" with Some v -> v | None -> Nil)
      | None -> Nil
    in
    let local_bindings = match ctx with
      | Some d ->
        (match Hashtbl.find_opt d "locals" with
         | Some (Dict locals) ->
           Hashtbl.fold (fun k v acc ->
             List [Symbol k; List [Symbol "quote"; v]] :: acc
           ) locals []
         | _ -> [])
      | None -> []
    in
    let bindings = List [Symbol "it"; Nil]
                 :: List [Symbol "event"; Nil]
                 :: local_bindings in
    (* Wrap body in guard to catch hs-return raises and unwrap the payload. *)
    let guard_expr = List [
      Symbol "guard";
      List [
        Symbol "_e";
        List [
          Symbol "true";
          List [
            Symbol "if";
            List [Symbol "and";
              List [Symbol "list?"; Symbol "_e"];
              List [Symbol "="; List [Symbol "first"; Symbol "_e"]; String "hs-return"]];
            List [Symbol "nth"; Symbol "_e"; Number 1.0];
            List [Symbol "raise"; Symbol "_e"]]]];
      sx_expr
    ] in
    let wrapped_expr = List [Symbol "let"; List bindings; guard_expr] in
    let handler = List [Symbol "fn"; List [Symbol "me"]; wrapped_expr] in
    let call_expr = List [handler; List [Symbol "quote"; me_val]] in
    eval_expr call_expr (Env env))));
  load_module "types.sx" lib_dir;
  load_module "text-layout.sx" lib_dir;
  load_module "sx-swap.sx" lib_dir;
  (* Shared templates: TW styling engine *)
  let templates_dir = Filename.concat project_dir "shared/sx/templates" in
  load_module "tw.sx" templates_dir;
  load_module "tw-layout.sx" templates_dir;
  load_module "font.sx" templates_dir;
  load_module "tw-type.sx" templates_dir;
  (* SX docs site: components, handlers, demos *)
  let sx_comp_dir = Filename.concat project_dir "sx/sxc" in
  let sx_sx_dir = Filename.concat project_dir "sx/sx" in
  let sx_handlers_dir = Filename.concat project_dir "sx/sx/handlers" in
  let sx_islands_dir = Filename.concat project_dir "sx/sx/reactive-islands" in
  let sx_geo_dir = Filename.concat project_dir "sx/sx/geography" in
  (* Components + handlers *)
  load_module "examples.sx" sx_comp_dir;
  load_module "docs.sx" sx_sx_dir;
  load_module "examples.sx" sx_handlers_dir;
  load_module "ref-api.sx" sx_handlers_dir;
  load_module "reactive-api.sx" sx_handlers_dir;
  (* Island definitions *)
  load_module "index.sx" sx_islands_dir;
  load_module "demo.sx" sx_islands_dir;
  load_module "cek.sx" sx_geo_dir;
  (* Load one-per-file islands from _islands/ directories.
     Using sx_sx_dir as base matches the live server's naming:
     sx/sx/geography/<domain>/_islands/<stem>.sx -> ~geography/<domain>/<stem>. *)
  (* cek/: recursive load picks up content/demo/freeze page index.sx files
     (→ ~geography/cek/content etc.) plus _islands/*.sx (→ ~geography/cek/<stem>). *)
  load_dir_recursive (Filename.concat sx_geo_dir "cek") sx_sx_dir;
  let sx_reactive_dir = Filename.concat sx_geo_dir "reactive" in
  if Sys.file_exists (Filename.concat sx_reactive_dir "_islands") then
    load_dir_recursive (Filename.concat sx_reactive_dir "_islands") sx_sx_dir;
  let sx_reactive_runtime_dir = Filename.concat sx_geo_dir "reactive-runtime" in
  if Sys.file_exists (Filename.concat sx_reactive_runtime_dir "_islands") then
    load_dir_recursive (Filename.concat sx_reactive_runtime_dir "_islands") sx_sx_dir;
  let sx_marshes_dir = Filename.concat sx_geo_dir "marshes" in
  if Sys.file_exists (Filename.concat sx_marshes_dir "_islands") then
    load_dir_recursive (Filename.concat sx_marshes_dir "_islands") sx_sx_dir;
  (* scopes/, provide/, spreads/ _islands — defcomp demos referenced by test-examples *)
  let sx_scopes_dir = Filename.concat sx_geo_dir "scopes" in
  if Sys.file_exists (Filename.concat sx_scopes_dir "_islands") then
    load_dir_recursive (Filename.concat sx_scopes_dir "_islands") sx_sx_dir;
  let sx_provide_dir = Filename.concat sx_geo_dir "provide" in
  if Sys.file_exists (Filename.concat sx_provide_dir "_islands") then
    load_dir_recursive (Filename.concat sx_provide_dir "_islands") sx_sx_dir;
  let sx_spreads_dir = Filename.concat sx_geo_dir "spreads" in
  if Sys.file_exists (Filename.concat sx_spreads_dir "_islands") then
    load_dir_recursive (Filename.concat sx_spreads_dir "_islands") sx_sx_dir;
  load_module "reactive-runtime.sx" sx_sx_dir;

  (* Create short-name aliases for reactive-islands tests *)
  let alias short full =
    try let v = Sx_types.env_get env full in
      ignore (Sx_types.env_bind env short v)
    with _ -> () in
  let _ = alias in

  (* Determine test files — scan spec/tests/, lib/tests/, web/tests/ *)
  let lib_tests_dir = Filename.concat project_dir "lib/tests" in
  let web_tests_dir = Filename.concat project_dir "web/tests" in

  (* Pre-load test-handlers.sx so its mock definitions (reset-mocks!, helper, etc.)
     are available to test-examples.sx which loads before it alphabetically *)
  load_module "test-handlers.sx" web_tests_dir;

  (* Re-bind render-to-sx AFTER adapter-sx.sx has loaded, wrapping the SX version.
     The SX render-to-sx handles AST inputs; we add string→parse→aser support. *)
  let sx_render_to_sx = try Some (Sx_types.env_get env "render-to-sx") with _ -> None in
  ignore (Sx_types.env_bind env "render-to-sx" (NativeFn ("render-to-sx", fun args ->
    match args with
    | [String src] ->
      (* String input: parse then evaluate via aser (quote the parsed AST so aser sees raw structure) *)
      let exprs = Sx_parser.parse_all src in
      let expr = match exprs with [e] -> e | es -> List (Symbol "do" :: es) in
      let result = eval_expr (List [Symbol "aser"; List [Symbol "quote"; expr]; Env env]) (Env env) in
      (match result with SxExpr s -> String s | String s -> String s | _ -> String (Sx_runtime.value_to_str result))
    | _ ->
      (* AST input: delegate to the SX render-to-sx *)
      match sx_render_to_sx with
      | Some (NativeFn (_, f)) -> f args
      | Some (Lambda _ as fn) -> Sx_ref.cek_call fn (List args)
      | _ -> String "")));

  
  let files = if test_files = [] then begin
    (* Spec tests (core language — always run) *)
    let spec_entries = Sys.readdir spec_tests_dir in
    Array.sort String.compare spec_entries;
    let spec_files = Array.to_list spec_entries
      |> List.filter (fun f ->
        String.length f > 5 &&
        String.sub f 0 5 = "test-" &&
        Filename.check_suffix f ".sx" &&
        f <> "test-framework.sx")
      |> List.map (fun f -> Filename.concat spec_tests_dir f)
    in
    (* Web tests (orchestration, handlers) *)
    let web_files = if Sys.file_exists web_tests_dir then begin
      let entries = Sys.readdir web_tests_dir in
      Array.sort String.compare entries;
      Array.to_list entries
        |> List.filter (fun f ->
          String.length f > 5 &&
          String.sub f 0 5 = "test-" &&
          Filename.check_suffix f ".sx" &&
          f <> "test-handlers.sx" &&        (* pre-loaded above *)
          f <> "test-wasm-browser.sx" &&   (* browser-only, needs DOM primitives *)
          f <> "test-adapter-dom.sx" &&    (* browser-only, needs DOM renderer *)
          f <> "test-boot-helpers.sx" &&   (* browser-only, needs boot module *)
          f <> "test-layout.sx" &&         (* needs render-to-html begin+defcomp support *)
          f <> "test-cek-reactive.sx")     (* needs test-env/make-reactive-reset-frame infra *)
        |> List.map (fun f -> Filename.concat web_tests_dir f)
    end else [] in
    spec_files @ web_files
  end else
    (* Specific test files — search all test dirs *)
    List.map (fun name ->
      let name = if Filename.check_suffix name ".sx" then name else name ^ ".sx" in
      let spec_path = Filename.concat spec_tests_dir name in
      let lib_path = Filename.concat lib_tests_dir name in
      let web_path = Filename.concat web_tests_dir name in
      if Sys.file_exists spec_path then spec_path
      else if Sys.file_exists lib_path then lib_path
      else if Sys.file_exists web_path then web_path
      else Filename.concat spec_tests_dir name  (* will fail with "not found" *)
    ) test_files
  in

  (* Refresh JIT globals after all modules loaded — vm-execute-module,
     code-from-value, and other late-bound functions must be visible. *)
  !_jit_refresh_globals ();


  List.iter (fun path ->
    if Sys.file_exists path then begin
      let name = Filename.basename path in
      Printf.printf "\n%s\n" (String.make 60 '=');
      Printf.printf "Running %s\n" name;
      Printf.printf "%s\n%!" (String.make 60 '=');
      (try
        load_and_eval path
      with
      | Eval_error msg ->
        incr fail_count;
        Printf.printf "  ERROR in %s: %s\n%!" name msg
      | exn ->
        incr fail_count;
        Printf.printf "  ERROR in %s: %s\n%!" name (Printexc.to_string exn))
    end else
      Printf.eprintf "Test file not found: %s\n" path
  ) files


(* ====================================================================== *)
(* Main                                                                    *)
(* ====================================================================== *)

let () =
  let args = Array.to_list Sys.argv |> List.tl in
  let foundation_only = List.mem "--foundation" args in
  let jit_enabled = List.mem "--jit" args in
  (* --only-failing=PATH : read lines of form "FAIL: suite > name: ..." and
     restrict test runs to those (suite, name) pairs. *)
  List.iter (fun a ->
    let prefix = "--only-failing=" in
    if String.length a > String.length prefix
       && String.sub a 0 (String.length prefix) = prefix then begin
      let path = String.sub a (String.length prefix) (String.length a - String.length prefix) in
      let filter = Hashtbl.create 64 in
      let ic = open_in path in
      (try while true do
        let line = input_line ic in
        (* Match "  FAIL: <suite> > <name>: <err>" or "FAIL: <suite> > <name>: <err>" *)
        let line = String.trim line in
        if String.length line > 6 && String.sub line 0 6 = "FAIL: " then begin
          let rest = String.sub line 6 (String.length line - 6) in
          match String.index_opt rest '>' with
          | Some gt ->
            let suite = String.trim (String.sub rest 0 gt) in
            let after = String.sub rest (gt + 1) (String.length rest - gt - 1) in
            (match String.index_opt after ':' with
             | Some colon ->
               let name = String.trim (String.sub after 0 colon) in
               Hashtbl.replace filter (suite, name) ()
             | None -> ())
          | None -> ()
        end
      done with End_of_file -> ());
      close_in ic;
      Printf.eprintf "[filter] %d tests loaded from %s\n%!" (Hashtbl.length filter) path;
      suite_filter := Some filter
    end) args;
  let test_files = List.filter (fun a ->
    not (String.length a > 0 && a.[0] = '-')) args in

  (* Always run foundation tests *)
  run_foundation_tests ();

  if not foundation_only then begin
    Printf.printf "\n=== SX Spec Tests (CEK Evaluator + JIT) ===\n%!";
    let env = make_test_env () in
    (* Load compiler and enable JIT (opt-in via --jit flag) *)
    if jit_enabled then begin
    let globals = Hashtbl.create 512 in
    let rec env_to_globals e =
      Hashtbl.iter (fun id v ->
        let name = Sx_types.unintern id in
        if not (Hashtbl.mem globals name) then
          Hashtbl.replace globals name v) e.Sx_types.bindings;
      match e.Sx_types.parent with Some p -> env_to_globals p | None -> ()
    in
    env_to_globals env;
    (* Seed VM globals with native primitives — CALL_PRIM resolves from globals *)
    Hashtbl.iter (fun name fn ->
      Hashtbl.replace globals name (NativeFn (name, fn))
    ) Sx_primitives.primitives;
    _jit_refresh_globals := (fun () -> env_to_globals env);
    (try
      let compiler_path = if Sys.file_exists "lib/compiler.sx" then "lib/compiler.sx"
        else "../../lib/compiler.sx" in
      let ic = open_in compiler_path in
      let src = really_input_string ic (in_channel_length ic) in
      close_in ic; let _ = src in
      let exprs = Sx_parser.parse_all src in
      List.iter (fun e -> ignore (Sx_ref.eval_expr e (Env env))) exprs;
      env_to_globals env;
      Sx_runtime._jit_try_call_fn := Some (fun f args ->
        match f with
        | Lambda l ->
          (match l.l_compiled with
           | Some cl when not (Sx_vm.is_jit_failed cl) ->
             (* VmSuspended = IO perform, Eval_error "VM undefined" = missing
                special form. Both fall back to CEK safely — mark as failed
                so we don't retry. *)
             (try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
              with
              | Sx_vm.VmSuspended _ ->
                l.l_compiled <- Some Sx_vm.jit_failed_sentinel; None
              | Eval_error msg when String.length msg > 14
                  && String.sub msg 0 14 = "VM undefined: " ->
                l.l_compiled <- Some Sx_vm.jit_failed_sentinel; None)
           | Some _ -> None
           | None ->
             if l.l_name = None then None
             else begin
               l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
               (* Catch TIMEOUT during compile so the first test in a suite
                  doesn't time out just from JIT-compiling a large top-level
                  function. Sentinel is already set, so subsequent calls skip
                  JIT; this ensures the FIRST call falls back to CEK too. *)
               match (try Sx_vm.jit_compile_lambda l globals
                      with Eval_error msg when
                        String.length msg >= 7
                        && String.sub msg 0 7 = "TIMEOUT" -> None)
               with
               | Some cl -> l.l_compiled <- Some cl;
                 (try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
                  with
                  | Sx_vm.VmSuspended _ ->
                    l.l_compiled <- Some Sx_vm.jit_failed_sentinel; None
                  | Eval_error msg when String.length msg > 14
                      && String.sub msg 0 14 = "VM undefined: " ->
                    l.l_compiled <- Some Sx_vm.jit_failed_sentinel; None)
               | None -> None
             end)
        | _ -> None);
      Printf.printf "[jit] Compiler loaded, JIT enabled\n%!"
    with e ->
      Printf.printf "[jit] Compiler not loaded: %s\n%!" (Printexc.to_string e));
    end;
    Sx_runtime.jit_reset_counters ();
    run_spec_tests env test_files
  end;

  (* JIT statistics *)
  let jh = !(Sx_runtime._jit_hit) and jm = !(Sx_runtime._jit_miss) and js = !(Sx_runtime._jit_skip) in
  let total = jh + jm + js in
  if total > 0 then
    Printf.printf "\n[jit] calls=%d  hit=%d (%.1f%%)  miss=%d  skip=%d\n"
      total jh (100.0 *. float_of_int jh /. float_of_int (max 1 total)) jm js;

  (* Summary *)
  Printf.printf "\n%s\n" (String.make 60 '=');
  Printf.printf "Results: %d passed, %d failed\n" !pass_count !fail_count;
  Printf.printf "%s\n" (String.make 60 '=');
  if !fail_count > 0 then exit 1