diff --git a/hosts/ocaml/bin/mcp_tree.ml b/hosts/ocaml/bin/mcp_tree.ml index 9452d67c..16ecfee4 100644 --- a/hosts/ocaml/bin/mcp_tree.ml +++ b/hosts/ocaml/bin/mcp_tree.ml @@ -62,6 +62,34 @@ let load_sx_file e path = ignore (Sx_ref.eval_expr expr (Env e)) ) exprs +(* ------------------------------------------------------------------ *) +(* File mtime cache — like a running Lisp image, only reload changed *) +(* ------------------------------------------------------------------ *) + +let file_mtimes : (string, float) Hashtbl.t = Hashtbl.create 32 + +let smart_load_file e path = + let abs = if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path else path in + let cur_mtime = (Unix.stat abs).Unix.st_mtime in + let cached = try Some (Hashtbl.find file_mtimes abs) with Not_found -> None in + match cached with + | Some prev when prev >= cur_mtime -> false (* unchanged *) + | _ -> + load_sx_file e abs; + Hashtbl.replace file_mtimes abs cur_mtime; + true (* loaded *) + +let smart_load_files e paths = + let loaded = ref [] in + List.iter (fun path -> + try + if smart_load_file e path then + loaded := path :: !loaded + with exn -> + loaded := (Printf.sprintf "%s (error: %s)" path (Printexc.to_string exn)) :: !loaded + ) paths; + List.rev !loaded + (* JIT infrastructure — shared VM globals table, kept in sync via env_bind hook *) let _mcp_vm_globals : (string, value) Hashtbl.t = Hashtbl.create 2048 let _jit_warned : (string, bool) Hashtbl.t = Hashtbl.create 32 @@ -1633,12 +1661,12 @@ let handle_sx_harness_eval args = List.map (fun j -> Yojson.Safe.Util.to_string j) items | _ -> match file with Some f -> [f] | None -> [] in - (* Load each file *) - List.iter (fun f -> - try load_sx_file e f - with exn -> - warnings := Printf.sprintf "Warning: %s: %s" f (Printexc.to_string exn) :: !warnings - ) all_files; + (* Smart-load files — only re-evaluate if source changed *) + let reloaded = smart_load_files e all_files in + List.iter (fun r -> + if String.contains r '(' then (* error entries contain parens *) + warnings := Printf.sprintf "Warning: %s" r :: !warnings + ) reloaded; (* Run setup expression if provided *) (match setup_str with | Some s -> @@ -1649,11 +1677,14 @@ let handle_sx_harness_eval args = warnings := Printf.sprintf "Setup error: %s" (Printexc.to_string exn) :: !warnings ) setup_exprs | None -> ()); - (* Create harness with optional mock overrides *) + (* Create harness with optional mock overrides — evaluate so fn exprs become lambdas *) let mock_arg = match mock_str with | Some s -> let parsed = Sx_parser.parse_all s in - if parsed <> [] then List [Keyword "platform"; List.hd parsed] else List [] + if parsed <> [] then + let evaluated = Sx_ref.eval_expr (List.hd parsed) (Env e) in + List [Keyword "platform"; evaluated] + else List [] | None -> List [] in let session = Sx_ref.cek_call (env_get e "make-harness") mock_arg in @@ -1679,11 +1710,13 @@ let handle_sx_harness_eval args = let warn_str = if !warnings = [] then "" else "\n\nWarnings:\n" ^ String.concat "\n" (List.rev !warnings) in - text_result (Printf.sprintf "Result: %s%s%s" (Sx_types.inspect result) log_str warn_str) + let reload_str = if reloaded = [] then "" else + "\n\nReloaded: " ^ String.concat ", " (List.map Filename.basename reloaded) in + text_result (Printf.sprintf "Result: %s%s%s%s" (Sx_types.inspect result) log_str reload_str warn_str) let handle_sx_write_file args = let open Yojson.Safe.Util in - let file = require_file args "file" in + let file = args |> member "file" |> to_string in let source = args |> member "source" |> to_string in (* Validate by parsing as CST — preserves comments and formatting *) (try @@ -1880,12 +1913,62 @@ let handle_sx_comp_usage args = let handle_sx_eval args = let open Yojson.Safe.Util in let expr_str = args |> member "expr" |> to_string in - let exprs = Sx_parser.parse_all expr_str in let e = !env in + (* Smart-load files — only re-evaluate if source changed *) + let files_json = try args |> member "files" with _ -> `Null in + let file = try args |> member "file" |> to_string_option with _ -> None in + let all_files = match files_json with + | `List items -> List.map Yojson.Safe.Util.to_string items + | _ -> match file with Some f -> [f] | None -> [] + in + let reloaded = smart_load_files e all_files in + (* Optional IO tracing via harness *) + let trace_io = try args |> member "trace_io" |> to_bool with _ -> false in + let session = if trace_io then begin + let mock_str = try args |> member "mock" |> to_string_option with _ -> None in + let mock_arg = match mock_str with + | Some s -> + let parsed = Sx_parser.parse_all s in + if parsed <> [] then + let evaluated = Sx_ref.eval_expr (List.hd parsed) (Env e) in + List [Keyword "platform"; evaluated] + else List [] + | None -> List [] + in + let s = Sx_ref.cek_call (env_get e "make-harness") mock_arg in + ignore (call_sx "install-interceptors" [s; Env e]); + Some s + end else None in + (* Run setup if provided *) + let setup_str = try args |> member "setup" |> to_string_option with _ -> None in + (match setup_str with + | Some s -> + List.iter (fun expr -> ignore (Sx_ref.eval_expr expr (Env e))) (Sx_parser.parse_all s) + | None -> ()); + (* Evaluate *) + let exprs = Sx_parser.parse_all expr_str in let result = List.fold_left (fun _acc expr -> - Sx_ref.eval_expr expr (Env e) + try Sx_ref.eval_expr expr (Env e) + with exn -> String (Printf.sprintf "Error: %s" (Printexc.to_string exn)) ) Nil exprs in - text_result (Sx_runtime.value_to_str result) + (* Format output *) + let result_str = Sx_runtime.value_to_str result in + let reload_str = if reloaded = [] then "" else + "\n\nReloaded: " ^ String.concat ", " (List.map Filename.basename reloaded) in + let io_str = match session with + | Some s -> + let log = call_sx "harness-log" [s] in + (match log with + | List items | ListRef { contents = items } when items <> [] -> + "\n\nIO trace:\n" ^ String.concat "\n" (List.map (fun entry -> + let op = value_to_string (call_sx "get" [entry; String "op"]) in + let args_val = call_sx "get" [entry; String "args"] in + Printf.sprintf " %s(%s)" op (Sx_types.inspect args_val) + ) items) + | _ -> "\n\n(no IO calls)") + | None -> "" + in + text_result (result_str ^ reload_str ^ io_str) let handle_sx_guard args = let open Yojson.Safe.Util in @@ -2556,8 +2639,14 @@ let tool_definitions = `List [ [file_prop; path_prop] ["file"; "path"]; tool "sx_wrap_node" "Wrap node in a new form. Use _ as placeholder, e.g. \"(when cond _)\"." [file_prop; path_prop; ("wrapper", `Assoc [("type", `String "string"); ("description", `String "Wrapper with _ placeholder")])] ["file"; "path"; "wrapper"]; - tool "sx_eval" "Evaluate an SX expression. Environment has parser + tree-tools + primitives." - [("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to evaluate")])] ["expr"]; + tool "sx_eval" "Evaluate SX in the persistent image. Definitions survive between calls. Files are smart-loaded (only re-evaluated if source changed on disk). With trace_io=true, wraps in harness to capture all IO calls." + [("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to evaluate")]); + ("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load")]); + ("files", `Assoc [("type", `String "array"); ("items", `Assoc [("type", `String "string")]); ("description", `String "Multiple .sx files to load in order (smart reload — skips unchanged)")]); + ("setup", `Assoc [("type", `String "string"); ("description", `String "SX expression to run before main eval")]); + ("trace_io", `Assoc [("type", `String "boolean"); ("description", `String "Wrap in test harness to capture IO trace (default: false)")]); + ("mock", `Assoc [("type", `String "string"); ("description", `String "Mock platform overrides as SX dict (requires trace_io)")])] + ["expr"]; tool "sx_guard" "Evaluate with error recovery. Catches errors, shows component trace, and continues. Returns result + any conditions signaled." [("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to evaluate with error recovery")]); ("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load for definitions")])] ["expr"]; diff --git a/lib/hyperscript/debug.sx b/lib/hyperscript/debug.sx new file mode 100644 index 00000000..9d6bb807 --- /dev/null +++ b/lib/hyperscript/debug.sx @@ -0,0 +1,38 @@ +;; Hyperscript debug harness — mock DOM for instant testing +;; +;; Load once into the image, then repeatedly call hs-run. +;; All DOM ops are intercepted and logged via the test harness. + +;; ── Mock element ──────────────────────────────────────────────── + +(define + hs-mock-element + (fn + (tag id classes) + (let + ((cls-set (reduce (fn (d c) (dict-set d c true)) {} classes))) + {:children () :_hs-activated true :tag tag :classes cls-set :text "" :id id :attrs {}}))) + +;; ── Mock platform ─────────────────────────────────────────────── + +(define hs-mock-platform {:hs-wait (fn (ms) nil) :hs-wait-for (fn (target event) nil) :dom-get-attr (fn (el attr) (get (get el "attrs") attr)) :dom-has-class? (fn (el cls) (dict-has? (get el "classes") cls)) :dom-set-text (fn (el text) (dict-set! el "text" text) nil) :hs-settle (fn (el) nil) :dom-add-class (fn (el cls) (dict-set! (get el "classes") cls true) nil) :dom-query (fn (sel) nil) :dom-remove-class (fn (el cls) (dict-delete! (get el "classes") cls) nil) :dom-listen (fn (target event-name handler) (handler {:target target :type event-name})) :dom-set-attr (fn (el attr val) (dict-set! (get el "attrs") attr val) nil) :dom-query-all (fn (sel) ())}) + +;; ── Convenience runner ────────────────────────────────────────── + +(define + hs-run + (fn + (src) + (let + ((me (hs-mock-element "div" "test" ())) + (sx (hs-to-sx-from-source src))) + (let + ((handler (eval-expr (list (quote fn) (quote (me)) (list (quote let) (quote ((it nil) (event {:target me :type "click"}))) sx))))) + (handler me) + me)))) + +;; ── Element inspection ────────────────────────────────────────── + +(define hs-classes (fn (el) (keys (get el "classes")))) + +(define hs-has-class? (fn (el cls) (dict-has? (get el "classes") cls)))