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

merge: architecture → hs-f (R7RS steps 4-6, IO suspension, JIT, language libs)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
Details

Browse Source 
Brings in 306 commits from architecture:
- R7RS: call/cc, raise/guard, records, parameters, syntax-rules, define-library/import
- IO suspension: perform/resume, third CEK phase
- JIT expansion: component/island JIT, OP_SWAP, exception handler stack, scope forms
- OCaml: HTML renderer, Python bridge, epoch protocol, sx_scope.ml
- Language libs: common-lisp, erlang, forth, apl, prolog, tcl, smalltalk, ruby

Conflict resolution: hs-f version kept for all hyperscript .sx files (superseding
architecture's smaller additions). Architecture's platform.py kept with hs-f's
domListen _driveAsync fix applied.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-06 18:54:06 +00:00
parent c5d9a8b789 8a009df4a3
commit eaab8db840
310 changed files with 80895 additions and 9309 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -37,7 +37,10 @@ let rec deep_equal a b =
match a, b with
| Nil, Nil -> true
| Bool a, Bool b -> a = b
| Integer a, Integer b -> a = b
| Number a, Number b -> a = b
| Integer a, Number b -> float_of_int a = b
| Number a, Integer b -> a = float_of_int b
| String a, String b -> a = b
| Symbol a, Symbol b -> a = b
| Keyword a, Keyword b -> a = b
@@ -226,7 +229,7 @@ let make_test_env () =
| [String s] ->
let parsed = Sx_parser.parse_all s in
(match parsed with
| [List (Symbol "sxbc" :: Number _ :: payload :: _)] -> payload
| [List (Symbol "sxbc" :: (Number _ | Integer _) :: payload :: _)] -> payload
| _ -> raise (Eval_error "bytecode-deserialize: invalid sxbc format"))
| _ -> raise (Eval_error "bytecode-deserialize: expected string"));
@@ -240,7 +243,7 @@ let make_test_env () =
| [String s] ->
let parsed = Sx_parser.parse_all s in
(match parsed with
| [List (Symbol "cek-state" :: Number _ :: payload :: _)] -> payload
| [List (Symbol "cek-state" :: (Number _ | Integer _) :: payload :: _)] -> payload
| _ -> raise (Eval_error "cek-deserialize: invalid cek-state format"))
| _ -> raise (Eval_error "cek-deserialize: expected string"));
@@ -320,7 +323,10 @@ let make_test_env () =
bind "identical?" (fun args ->
match args with
| [a; b] -> Bool (match a, b with
| Integer x, Integer y -> x = y
| Number x, Number y -> x = y
| Integer x, Number y -> float_of_int x = y
| Number x, Integer y -> x = float_of_int y
| String x, String y -> x = y
| Bool x, Bool y -> x = y
| Nil, Nil -> true
@@ -366,11 +372,15 @@ let make_test_env () =
bind "append!" (fun args ->
match args with
| [ListRef r; v; Number n] when int_of_float n = 0 ->
| [ListRef r; v; (Number n)] when int_of_float n = 0 ->
r := v :: !r; ListRef r (* prepend *)
| [ListRef r; v; (Integer 0)] ->
r := v :: !r; ListRef r (* prepend Integer index *)
| [ListRef r; v] -> r := !r @ [v]; ListRef r (* append in place *)
| [List items; v; Number n] when int_of_float n = 0 ->
| [List items; v; (Number n)] when int_of_float n = 0 ->
List (v :: items) (* immutable prepend *)
| [List items; v; (Integer 0)] ->
List (v :: items) (* immutable prepend Integer index *)
| [List items; v] -> List (items @ [v]) (* immutable fallback *)
| _ -> raise (Eval_error "append!: expected list and value"));
@@ -546,7 +556,10 @@ let make_test_env () =
bind "batch-begin!" (fun _args -> Sx_ref.batch_begin_b ());
bind "batch-end!" (fun _args -> Sx_ref.batch_end_b ());
bind "now-ms" (fun _args -> Number 1000.0);
bind "random-int" (fun args -> match args with [Number lo; _] -> Number lo | _ -> Number 0.0);
bind "random-int" (fun args -> match args with
| [Number lo; _] -> Number lo
| [Integer lo; _] -> Integer lo
| _ -> Integer 0);
bind "try-rerender-page" (fun _args -> Nil);
bind "collect!" (fun args ->
match args with
@@ -1107,6 +1120,47 @@ let make_test_env () =
| _ :: _ -> String "confirmed"
| _ -> Nil);
bind "values" (fun args ->
match args with
| [v] -> v
| vs ->
let d = Hashtbl.create 2 in
Hashtbl.replace d "_values" (Bool true);
Hashtbl.replace d "_list" (List vs);
Dict d);
bind "call-with-values" (fun args ->
match args with
| [producer; consumer] ->
let result = Sx_ref.cek_call producer (List []) in
let spread = (match result with
| Dict d when (match Hashtbl.find_opt d "_values" with Some (Bool true) -> true | _ -> false) ->
(match Hashtbl.find_opt d "_list" with Some (List l) -> l | _ -> [result])
| _ -> [result])
in
Sx_ref.cek_call consumer (List spread)
| _ -> raise (Eval_error "call-with-values: expected 2 args"));
bind "promise?" (fun args ->
match args with
| [v] -> Bool (Sx_ref.is_promise v)
| _ -> Bool false);
bind "make-promise" (fun args ->
match args with
| [v] ->
let d = Hashtbl.create 4 in
Hashtbl.replace d "_promise" (Bool true);
Hashtbl.replace d "forced" (Bool true);
Hashtbl.replace d "value" v;
Dict d
| _ -> Nil);
bind "force" (fun args ->
match args with
| [p] -> Sx_ref.force_promise p
| _ -> Nil);
env
(* ====================================================================== *)
@@ -1142,18 +1196,20 @@ let run_foundation_tests () =
in
Printf.printf "Suite: parser\n";
assert_eq "number" (Number 42.0) (List.hd (parse_all "42"));
assert_eq "number" (Integer 42) (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)"));
assert_eq "list" (List [Symbol "+"; Integer 1; Integer 2]) (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 [Integer 1; Integer 2; Integer 3]] ->
incr pass_count; Printf.printf " PASS: quote sugar\n"
| 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));
@@ -1161,7 +1217,7 @@ let run_foundation_tests () =
| 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 "comment" (Integer 42) (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)"))));
@@ -1978,6 +2034,10 @@ let run_spec_tests env test_files =
(match Hashtbl.find_opt d "children" with
| Some (List l) when i >= 0 && i < List.length l -> List.nth l i
| _ -> (match Hashtbl.find_opt d (string_of_int i) with Some v -> v | None -> Nil))
| [Dict d; Integer n] ->
(match Hashtbl.find_opt d "children" with
| Some (List l) when n >= 0 && n < List.length l -> List.nth l n
| _ -> (match Hashtbl.find_opt d (string_of_int n) with Some v -> v | None -> Nil))
| _ -> Nil);
(* Stringify a value for DOM string properties *)
@@ -2052,8 +2112,8 @@ let run_spec_tests env test_files =
Hashtbl.replace d "childNodes" (List [])
| _ -> ());
stored
| [ListRef r; Number n; value] ->
let idx = int_of_float n in
| [ListRef r; idx_v; value] when (match idx_v with Number _ | Integer _ -> true | _ -> false) ->
let idx = match idx_v with Number n -> int_of_float n | Integer n -> n | _ -> 0 in
let lst = !r in
if idx >= 0 && idx < List.length lst then
r := List.mapi (fun i v -> if i = idx then value else v) lst
@@ -2190,7 +2250,7 @@ let run_spec_tests env test_files =
| [String name; value] ->
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ ->
let a = Hashtbl.create 4 in Hashtbl.replace d "attributes" (Dict a); a in
let sv = match value with String s -> s | Number n ->
let sv = match value with String s -> s | Integer n -> string_of_int n | Number n ->
let i = int_of_float n in if float_of_int i = n then string_of_int i
else string_of_float n | _ -> Sx_types.inspect value in
Hashtbl.replace attrs name (String sv);
@@ -2632,6 +2692,7 @@ let run_spec_tests env test_files =
let rec json_of_value = function
| Nil -> `Null
| Bool b -> `Bool b
| Integer n -> `Int n
| Number n ->
if Float.is_integer n && Float.abs n < 1e16
then `Int (int_of_float n) else `Float n
@@ -2647,8 +2708,8 @@ let run_spec_tests env test_files =
let rec value_of_json = function
| `Null -> Nil
| `Bool b -> Bool b
| `Int i -> Number (float_of_int i)
| `Intlit s -> (try Number (float_of_string s) with _ -> String s)
| `Int i -> Integer i
| `Intlit s -> (try Integer (int_of_string s) with _ -> try Number (float_of_string s) with _ -> String s)
| `Float f -> Number f
| `String s -> String s
| `List xs -> List (List.map value_of_json xs)
@@ -2811,6 +2872,7 @@ let run_spec_tests env test_files =
match sx_vm_execute with
| Some fn -> Sx_ref.cek_call fn (List args)
| None -> Nil)));
load_module "stdlib.sx" spec_dir; (* pure SX stdlib: format etc. *)
load_module "signals.sx" spec_dir; (* core reactive primitives *)
load_module "signals.sx" web_dir; (* web extensions *)
load_module "freeze.sx" lib_dir;

25
hosts/ocaml/bin/sx_server.ml
View File

@@ -296,6 +296,10 @@ let read_blob () =
(* consume trailing newline *)
(try ignore (input_line stdin) with End_of_file -> ());
data
| [List [Symbol "blob"; Integer n]] ->
let data = read_exact_bytes n in
(try ignore (input_line stdin) with End_of_file -> ());
data
| _ -> raise (Eval_error ("read_blob: expected (blob N), got: " ^ line))
(** Batch IO mode — collect requests during aser-slot, resolve after. *)
@@ -357,6 +361,11 @@ let rec read_io_response () =
| [List (Symbol "io-response" :: Number n :: values)]
when int_of_float n = !current_epoch ->
(match values with [v] -> v | _ -> List values)
| [List [Symbol "io-response"; Integer n; value]]
when n = !current_epoch -> value
| [List (Symbol "io-response" :: Integer n :: values)]
when n = !current_epoch ->
(match values with [v] -> v | _ -> List values)
(* Legacy untagged: (io-response value) — accept for backwards compat *)
| [List [Symbol "io-response"; value]] -> value
| [List (Symbol "io-response" :: values)] ->
@@ -396,6 +405,12 @@ let read_batched_io_response () =
when int_of_float n = !current_epoch -> s
| [List [Symbol "io-response"; Number n; v]]
when int_of_float n = !current_epoch -> serialize_value v
| [List [Symbol "io-response"; Integer n; String s]]
when n = !current_epoch -> s
| [List [Symbol "io-response"; Integer n; SxExpr s]]
when n = !current_epoch -> s
| [List [Symbol "io-response"; Integer n; v]]
when n = !current_epoch -> serialize_value v
(* Legacy untagged *)
| [List [Symbol "io-response"; String s]]
| [List [Symbol "io-response"; SxExpr s]] -> s
@@ -959,6 +974,7 @@ let setup_io_bridges env =
bind "sleep" (fun args -> io_request "sleep" args);
bind "set-response-status" (fun args -> match args with
| [Number n] -> _pending_response_status := int_of_float n; Nil
| [Integer n] -> _pending_response_status := n; Nil
| _ -> Nil);
bind "set-response-header" (fun args -> io_request "set-response-header" args)
@@ -1361,6 +1377,7 @@ let rec dispatch env cmd =
| Bool true -> "true"
| Bool false -> "false"
| Number n -> Sx_types.format_number n
| Integer n -> string_of_int n
| String s -> "\"" ^ escape_sx_string s ^ "\""
| Symbol s -> s
| Keyword k -> ":" ^ k
@@ -1374,6 +1391,10 @@ let rec dispatch env cmd =
| Island i -> "~" ^ i.i_name
| SxExpr s -> s
| RawHTML s -> "\"" ^ escape_sx_string s ^ "\""
| Char n -> Sx_types.inspect (Char n)
| Eof -> Sx_types.inspect Eof
| Port _ -> Sx_types.inspect result
| Rational (n, d) -> Printf.sprintf "%d/%d" n d
| _ -> "nil"
in
send_ok_raw (raw_serialize result)
@@ -4450,6 +4471,8 @@ let site_mode () =
match exprs with
| [List [Symbol "epoch"; Number n]] ->
current_epoch := int_of_float n
| [List [Symbol "epoch"; Integer n]] ->
current_epoch := n
(* render-page: full SSR pipeline — URL → complete HTML *)
| [List [Symbol "render-page"; String path]] ->
(try match http_render_page env path [] with
@@ -4507,6 +4530,8 @@ let () =
(* Epoch marker: (epoch N) — set current epoch, read next command *)
| [List [Symbol "epoch"; Number n]] ->
current_epoch := int_of_float n
| [List [Symbol "epoch"; Integer n]] ->
current_epoch := n
| [cmd] -> dispatch env cmd
| _ -> send_error ("Expected single command, got " ^ string_of_int (List.length exprs))
end