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

sx-tools: WASM kernel updates, TW/CSSX rework, content refresh, new debugging tools

Browse Source 
Build tooling: updated OCaml bootstrapper, compile-modules, bundle.sh, sx-build-all.
WASM browser: rebuilt sx_browser.bc.js/wasm, sx-platform-2.js, .sxbc bytecode files.
CSSX/Tailwind: reworked cssx.sx templates and tw-layout, added tw-type support.
Content: refreshed essays, plans, geography, reactive islands, docs, demos, handlers.
New tools: bisect_sxbc.sh, test-spa.js, render-trace.sx, morph playwright spec.
Tests: added test-match.sx, test-examples.sx, updated test-tw.sx and web tests.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-02 11:31:57 +00:00
parent 9ed1100ef6
commit d40a9c6796
178 changed files with 13591 additions and 9110 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -199,11 +199,9 @@ let make_test_env () =
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
| [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"));
@@ -232,7 +230,12 @@ let make_test_env () =
bind "identical?" (fun args ->
match args with
| [a; b] -> Bool (a == b)
| [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 --- *)
@@ -456,17 +459,27 @@ let make_test_env () =
(match stack with _ :: rest -> Hashtbl.replace _scope_stacks name (List [] :: rest) | [] -> ()); Nil
| _ -> Nil);
bind "regex-find-all" (fun args ->
(* Stub: supports simple ~name pattern for component scanning *)
(* Stub: supports ~name patterns for component scanning *)
match args with
| [String pattern; String text] ->
let prefix = if String.length pattern > 2 && pattern.[0] = '(' then
(* Extract literal prefix from pattern like "(~[a-z/.-]+" → "~" *)
let s = String.sub pattern 1 (String.length pattern - 1) in
let p = try String.sub s 0 (String.index s '[')
with Not_found -> try String.sub s 0 (String.index s '(')
with Not_found -> s in
if String.length p > 0 then p else "~"
else pattern in
(* Extract the literal prefix from patterns like:
"(~[a-z/.-]+" → prefix "~", has_group=true
"\(~([a-zA-Z_]..." → prefix "(~", has_group=true *)
let prefix, has_group =
if String.length pattern >= 4 && pattern.[0] = '\\' && pattern.[1] = '(' then
(* Pattern like \(~(...) — literal "(" + "~" prefix, group after *)
let s = String.sub pattern 2 (String.length pattern - 2) in
let lit_end = try String.index s '(' with Not_found -> try String.index s '[' with Not_found -> String.length s in
let lit = String.sub s 0 lit_end in
("(" ^ lit, true)
else if String.length pattern > 2 && pattern.[0] = '(' then
let s = String.sub pattern 1 (String.length pattern - 1) in
let p = try String.sub s 0 (String.index s '[')
with Not_found -> try String.sub s 0 (String.index s '(')
with Not_found -> s in
((if String.length p > 0 then p else "~"), true)
else (pattern, false)
in
let results = ref [] in
let len = String.length text in
let plen = String.length prefix in
@@ -480,7 +493,12 @@ let make_test_env () =
|| c = '-' || c = '/' || c = '_' || c = '.' do
incr j
done;
results := String (String.sub text !i (!j - !i)) :: !results;
let full_match = String.sub text !i (!j - !i) in
(* If pattern has capture group, strip the literal prefix to simulate group 1 *)
let result = if has_group then
String.sub full_match plen (String.length full_match - plen)
else full_match in
results := String result :: !results;
i := !j
end else incr i
done;
@@ -870,6 +888,76 @@ let make_test_env () =
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
(* ====================================================================== *)
@@ -1054,6 +1142,7 @@ let run_spec_tests env test_files =
in
(* 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/ *)
@@ -1074,6 +1163,12 @@ let run_spec_tests env test_files =
load_module "content.sx" lib_dir;
load_module "types.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 "tw-type.sx" templates_dir;
load_module "cssx.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
@@ -1097,6 +1192,23 @@ let run_spec_tests env test_files =
load_module "cek.sx" sx_geo_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
alias "~reactive-islands/counter" "~reactive-islands/index/demo-counter";
alias "~reactive-islands/temperature" "~reactive-islands/index/demo-temperature";
alias "~reactive-islands/stopwatch" "~reactive-islands/index/demo-stopwatch";
alias "~reactive-islands/reactive-list" "~reactive-islands/index/demo-reactive-list";
alias "~reactive-islands/input-binding" "~reactive-islands/index/demo-input-binding";
alias "~reactive-islands/error-boundary" "~reactive-islands/index/demo-error-boundary";
alias "~reactive-islands/dynamic-class" "~reactive-islands/index/demo-dynamic-class";
alias "~reactive-islands/store-writer" "~reactive-islands/index/demo-store-writer";
alias "~reactive-islands/store-reader" "~reactive-islands/index/demo-store-reader";
alias "~marshes/demo-marsh-product" "~reactive-islands/marshes/demo-marsh-product";
alias "~marshes/demo-marsh-settle" "~reactive-islands/marshes/demo-marsh-settle";
(* 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
@@ -1111,10 +1223,10 @@ let run_spec_tests env test_files =
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 *)
(* 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"; expr; Env env]) (Env env) 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 *)