rose-ash/hosts/ocaml/bin/run_tests.ml

(** 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 []

(* ====================================================================== *)
(* 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
  | 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);

  bind "try-call" (fun args ->
    match args with
    | [thunk] ->
      (try
        (* Call the thunk: it's a lambda with no params *)
        let result = eval_expr (List [thunk]) (Env env) in
        ignore result;
        let d = Hashtbl.create 2 in
        Hashtbl.replace d "ok" (Bool true);
        Dict d
      with
      | Eval_error msg ->
        let d = Hashtbl.create 2 in
        Hashtbl.replace d "ok" (Bool false);
        Hashtbl.replace d "error" (String msg);
        Dict d
      | exn ->
        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);

  (* --- 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-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
    | [e; String k; v] ->
      let ue = uw e in
      if k = "x" || k = "children" || k = "i" then
        Printf.eprintf "[env-bind!] '%s' env-id=%d bindings-before=%d\n%!" k (Obj.obj (Obj.repr ue) : int) (Hashtbl.length ue.Sx_types.bindings);
      Sx_types.env_bind ue k v
    | [e; Keyword k; v] -> Sx_types.env_bind (uw e) k v
    | _ -> raise (Eval_error "env-bind!: expected env, key, value"));

  bind "env-set!" (fun args ->
    match args with
    | [e; String k; v] -> Sx_types.env_set (uw e) k v
    | [e; Keyword k; v] -> Sx_types.env_set (uw e) k v
    | _ -> raise (Eval_error "env-set!: expected env, key, value"));

  bind "env-extend" (fun args ->
    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 (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] -> r := !r @ [v]; ListRef r  (* mutate in place *)
    | [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;

  (* 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);
  (* Scope primitives — use a local scope stacks table.
     Must match the same pattern as sx_server.ml's _scope_stacks. *)
  let _scope_stacks : (string, Sx_types.value list) Hashtbl.t = Hashtbl.create 8 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-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)"));

  (* Declarative type/effect forms — no-ops at runtime *)
  bind "deftype" (fun _args -> Nil);
  bind "defeffect" (fun _args -> Nil);

  (* --- 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"));

  (* --- 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"));

  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                                                        *)
(* ====================================================================== *)

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;

  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 ->
      ignore (eval_expr expr (Env env))
    ) exprs
  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;

  (* 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
  (* Render adapter for test-render-html.sx *)
  load_module "render.sx" spec_dir;
  load_module "adapter-html.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;
  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 "types.sx" lib_dir;

  (* Determine test files — scan spec/tests/ and lib/tests/ *)
  let lib_tests_dir = Filename.concat project_dir "lib/tests" in
  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
    spec_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
      if Sys.file_exists spec_path then spec_path
      else if Sys.file_exists lib_path then lib_path
      else Filename.concat spec_tests_dir name  (* will fail with "not found" *)
    ) test_files
  in

  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 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) ===\n%!";
    let env = make_test_env () in
    run_spec_tests env test_files
  end;

  (* 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