coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 7 Packages Projects Releases Wiki Activity

Persistent Lisp image for sx_eval: smart file reload + IO tracing

Browse Source 
sx_eval now accepts files (smart-loaded by mtime — unchanged files skip),
trace_io (harness-wrapped IO capture), mock (evaluated platform overrides),
and setup params. Definitions survive between calls. sx_harness_eval also
uses smart loading. sx_write_file can create new files.

New lib/hyperscript/debug.sx: mock DOM platform for instant hyperscript
testing — compile and execute HS expressions against simulated elements,
see every DOM mutation and wait in the IO trace.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-08 19:56:38 +00:00
parent 1f7f47b4c1
commit a9066c0653
2 changed files with 142 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

119
hosts/ocaml/bin/mcp_tree.ml
View File

@@ -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"];