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

SX renderer: adapter-html.sx as sole renderer, conditions, pattern matching

Browse Source 
Evaluator: conditions/restarts, pattern matching, render-trace support.
adapter-html.sx: full SX-defined HTML renderer replacing native OCaml.
spec/render.sx: updated render mode helpers.
sx_browser.ml: use SX render-to-html instead of native.
sx_ref.ml: evaluator updates for conditions + match.
Bootstrap + transpiler updates for new forms.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-29 01:28:53 +00:00
parent 015781313c
commit e1ef883339
15 changed files with 3460 additions and 2320 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
hosts/ocaml/bin/integration_tests.ml
View File

@@ -407,7 +407,7 @@ let () =
let render_html src =
let exprs = Sx_parser.parse_all src in
let expr = match exprs with [e] -> e | _ -> Nil in
Sx_render.render_to_html expr env
Sx_render.sx_render_to_html env expr env
in
(* Helper: call SX render-to-html via the adapter *)

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

@@ -259,7 +259,14 @@ let setup_env () =
(* Load eval-rules *)
(try load_sx_file e (Filename.concat spec_dir "eval-rules.sx")
with exn -> Printf.eprintf "[mcp] Warning: eval-rules.sx load failed: %s\n%!" (Printexc.to_string exn));
Printf.eprintf "[mcp] SX tree-tools + harness + eval-rules loaded\n%!";
(* Load render pipeline — native OCaml renderer + HTML tag bindings *)
Sx_render.setup_render_env e;
List.iter (fun tag ->
ignore (Sx_types.env_bind e tag
(NativeFn ("html:" ^ tag, fun args -> List (Symbol tag :: args))))
) Sx_render.html_tags;
ignore (Sx_types.env_bind e "island?" (NativeFn ("island?", fun args -> match args with [Island _] -> Bool true | _ -> Bool false)));
Printf.eprintf "[mcp] SX tree-tools + harness + eval-rules + render loaded\n%!";
env := e
(* ------------------------------------------------------------------ *)
@@ -277,7 +284,9 @@ let parse_file path =
List exprs
let parse_path_str s =
(* Parse SX path string: "(0 3 2)" or "0 3 2" → SX list of numbers *)
(* Parse SX path string: "(0 3 2)" or "(0,3,2)" or "0 3 2" → SX list of numbers.
Commas are unquote in SX, so strip them before parsing. *)
let s = String.map (fun c -> if c = ',' then ' ' else c) s in
let exprs = Sx_parser.parse_all s in
match exprs with
| [List items] ->
@@ -1375,10 +1384,65 @@ let rec handle_tool name args =
) Nil exprs in
text_result (Sx_runtime.value_to_str result)
| "sx_guard" ->
let expr_str = args |> member "expr" |> to_string in
let file = try Some (args |> member "file" |> to_string) with _ -> None in
let e = !env in
(match file with
| Some f -> (try load_sx_file e f with _ -> ())
| None -> ());
let exprs = Sx_parser.parse_all expr_str in
let conditions = ref [] in
(* Evaluate with error recovery — catch Eval_error, log it, return placeholder *)
let result = ref Nil in
(try
result := List.fold_left (fun _acc expr ->
Sx_ref.eval_expr expr (Env e)
) Nil exprs
with Eval_error msg ->
let enhanced = Sx_ref.enhance_error_with_trace msg in
conditions := enhanced :: !conditions;
result := String ("<error: " ^ msg ^ ">"));
let cond_lines = match !conditions with
| [] -> ""
| cs -> "\n\nConditions signaled:\n" ^
String.concat "\n" (List.rev_map (fun c -> " - " ^ c) cs) in
text_result (Sx_runtime.value_to_str !result ^ cond_lines)
| "sx_render_trace" ->
let expr_str = args |> member "expr" |> to_string in
let file = try Some (args |> member "file" |> to_string) with _ -> None in
let e = !env in
(match file with
| Some f -> (try load_sx_file e f with _ -> ())
| None -> ());
let exprs = Sx_parser.parse_all expr_str in
let expr = match exprs with [e] -> e | _ -> List (Symbol "do" :: exprs) in
let trace = Buffer.create 2048 in
let truncate s n = if String.length s > n then String.sub s 0 n ^ "..." else s in
let expr_str = truncate (Sx_runtime.value_to_str expr) 60 in
let kind = match expr with
| Nil -> "nil" | Bool _ -> "bool" | Number _ -> "number"
| String _ -> "string" | Symbol _ -> "symbol" | Keyword _ -> "keyword"
| RawHTML _ -> "raw-html"
| List (Symbol s :: _) | ListRef { contents = Symbol s :: _ } ->
if List.mem s Sx_render.html_tags then "element:" ^ s
else if List.mem s ["if";"when";"cond";"case";"let";"let*";"do";"begin";"map";"filter";"define";"defcomp"] then "form:" ^ s
else "call:" ^ s
| List _ -> "list" | _ -> "other" in
Buffer.add_string trace (Printf.sprintf "→ %s %s\n" kind expr_str);
let result = (try
Sx_render.sx_render_to_html e expr e
with Sx_types.Eval_error msg -> "ERROR: " ^ Sx_ref.enhance_error_with_trace msg) in
let result_str = truncate result 60 in
Buffer.add_string trace (Printf.sprintf "← %s\n" result_str);
text_result (Printf.sprintf "Result: %s\n\nRender trace:\n%s" result (Buffer.contents trace))
| "sx_trace" ->
let expr_str = args |> member "expr" |> to_string in
let max_steps = (try args |> member "max_steps" |> to_int with _ -> 200) in
let file = try Some (args |> member "file" |> to_string) with _ -> None in
let components_only = (try args |> member "components_only" |> to_bool with _ -> false) in
let e = !env in
(match file with
| Some f -> (try load_sx_file e f with _ -> ())
@@ -1389,6 +1453,29 @@ let rec handle_tool name args =
let steps = Buffer.create 2048 in
let step_count = ref 0 in
let truncate s n = if String.length s > n then String.sub s 0 n ^ "..." else s in
(* Track comp-trace depth for component-only mode *)
let comp_depth = ref 0 in
let prev_comp_depth = ref 0 in
let get_frame_type kont = match kont with
| List (CekFrame f :: _) -> f.cf_type
| List (Dict d :: _) ->
(match Hashtbl.find_opt d "type" with Some (String s) -> s | _ -> "?")
| _ -> "done" in
let count_comp_trace kont =
let n = ref 0 in
let k = ref kont in
(try while true do
(match !k with
| List (CekFrame f :: rest) ->
if f.cf_type = "comp-trace" then incr n;
k := List rest
| List (Dict d :: rest) ->
(match Hashtbl.find_opt d "type" with
| Some (String "comp-trace") -> incr n | _ -> ());
k := List rest
| _ -> raise Exit)
done with Exit -> ());
!n in
(try
while !step_count < max_steps do
let s = !state in
@@ -1396,44 +1483,56 @@ let rec handle_tool name args =
| CekState cs ->
incr step_count;
let n = !step_count in
if cs.cs_phase = "eval" then begin
let ctrl = cs.cs_control in
(match ctrl with
| Symbol sym_name ->
let resolved = (try
let v = Sx_ref.eval_expr ctrl cs.cs_env in
truncate (Sx_runtime.value_to_str v) 60
with _ -> "???") in
Buffer.add_string steps
(Printf.sprintf "%3d LOOKUP %s → %s\n" n sym_name resolved)
| List (hd :: _) ->
let head_str = truncate (Sx_runtime.value_to_str hd) 30 in
let ctrl_str = truncate (Sx_runtime.value_to_str ctrl) 80 in
Buffer.add_string steps
(Printf.sprintf "%3d CALL %s\n" n ctrl_str);
ignore head_str
| _ ->
Buffer.add_string steps
(Printf.sprintf "%3d LITERAL %s\n" n
(truncate (Sx_runtime.value_to_str ctrl) 60)))
if components_only then begin
let depth = count_comp_trace cs.cs_kont in
(if depth > !prev_comp_depth then begin
let indent = String.make (depth * 2) ' ' in
let ft = get_frame_type cs.cs_kont in
let name = (match cs.cs_kont with
| List (CekFrame f :: _) when f.cf_type = "comp-trace" ->
(match f.cf_name with String s -> s | _ -> "?")
| _ -> "?") in
Buffer.add_string steps
(Printf.sprintf "%s→ ENTER ~%s\n" indent name);
ignore ft
end else if depth < !prev_comp_depth then begin
let indent = String.make ((depth + 1) * 2) ' ' in
let val_str = if cs.cs_phase = "continue"
then truncate (Sx_runtime.value_to_str cs.cs_value) 60
else "..." in
Buffer.add_string steps
(Printf.sprintf "%s← EXIT → %s\n" indent val_str)
end);
prev_comp_depth := depth
end else begin
(* continue phase *)
let val_str = truncate (Sx_runtime.value_to_str cs.cs_value) 60 in
let kont = cs.cs_kont in
let frame_type = match kont with
| List (Dict d :: _) ->
(match Hashtbl.find_opt d "type" with
| Some (String s) -> s | _ -> "?")
| List (CekState ks :: _) ->
(match ks.cs_control with
| Dict d ->
(match Hashtbl.find_opt d "type" with
| Some (String s) -> s | _ -> "?")
| _ -> "?")
| _ -> "done" in
Buffer.add_string steps
(Printf.sprintf "%3d RETURN %s → %s\n" n val_str frame_type)
if cs.cs_phase = "eval" then begin
let ctrl = cs.cs_control in
(match ctrl with
| Symbol sym_name ->
let resolved = (try
let v = Sx_ref.eval_expr ctrl cs.cs_env in
truncate (Sx_runtime.value_to_str v) 60
with _ -> "???") in
Buffer.add_string steps
(Printf.sprintf "%3d LOOKUP %s → %s\n" n sym_name resolved)
| List (hd :: _) ->
let head_str = truncate (Sx_runtime.value_to_str hd) 30 in
let ctrl_str = truncate (Sx_runtime.value_to_str ctrl) 80 in
Buffer.add_string steps
(Printf.sprintf "%3d CALL %s\n" n ctrl_str);
ignore head_str
| _ ->
Buffer.add_string steps
(Printf.sprintf "%3d LITERAL %s\n" n
(truncate (Sx_runtime.value_to_str ctrl) 60)))
end else begin
let val_str = truncate (Sx_runtime.value_to_str cs.cs_value) 60 in
let ft = get_frame_type cs.cs_kont in
Buffer.add_string steps
(Printf.sprintf "%3d RETURN %s → %s\n" n val_str ft)
end
end;
ignore comp_depth;
(match Sx_ref.cek_terminal_p s with
| Bool true -> raise Exit
| _ -> ());
@@ -1443,7 +1542,8 @@ let rec handle_tool name args =
with
| Exit -> ()
| Eval_error msg ->
Buffer.add_string steps (Printf.sprintf "ERROR: %s\n" msg)
let enhanced = Sx_ref.enhance_error_with_trace msg in
Buffer.add_string steps (Printf.sprintf "ERROR: %s\n" enhanced)
| exn ->
Buffer.add_string steps (Printf.sprintf "ERROR: %s\n" (Printexc.to_string exn)));
let final_val = (match !state with
@@ -1714,10 +1814,17 @@ let tool_definitions = `List [
[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_trace" "Step-through SX evaluation showing each CEK machine step (symbol lookups, function calls, returns). Useful for debugging."
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"];
tool "sx_render_trace" "Render an SX expression to HTML with full dispatch tracing. Shows which render path each sub-expression takes."
[("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to render with tracing")]);
("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load for definitions")])] ["expr"];
tool "sx_trace" "Step-through SX evaluation showing each CEK machine step (symbol lookups, function calls, returns). Set components_only=true for component entry/exit only."
[("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to trace")]);
("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load for definitions")]);
("max_steps", `Assoc [("type", `String "integer"); ("description", `String "Max CEK steps to show (default: 200)")])] ["expr"];
("max_steps", `Assoc [("type", `String "integer"); ("description", `String "Max CEK steps to show (default: 200)")]);
("components_only", `Assoc [("type", `String "boolean"); ("description", `String "Show only component entry/exit events (default: false)")])] ["expr"];
tool "sx_explain" "Explain SX evaluation rules. Pass a form name (if, let, map, ...) or category (literal, special-form, higher-order, ...)."
[("name", `Assoc [("type", `String "string"); ("description", `String "Form name or category to explain")])] ["name"];
tool "sx_deps" "Dependency analysis for a component or file. Shows all referenced symbols and where they're defined."

61
hosts/ocaml/bin/run_tests.ml
View File

@@ -292,10 +292,15 @@ let make_test_env () =
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
@@ -354,20 +359,62 @@ let make_test_env () =
bind "cond-scheme?" (fun args ->
match args with
| [(List clauses | ListRef { contents = clauses })] ->
(match clauses with
| (List _ | ListRef _) :: _ -> Bool true
| _ -> Bool false)
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
List.iteri (fun i p ->
ignore (Sx_types.env_bind local p (if i < List.length a then List.nth a i else Nil))
) m.m_params;
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 ->
@@ -467,6 +514,8 @@ let make_test_env () =
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

2
hosts/ocaml/bin/sx_http.ml
View File

@@ -226,7 +226,7 @@ let sx_render_to_html expr env =
let result = Sx_ref.cek_call fn (List [expr; Env env]) in
match result with String s -> s | _ -> Sx_runtime.value_to_str result
else
Sx_render.render_to_html expr env
Sx_render.sx_render_to_html env expr env
(* ====================================================================== *)