Fix JIT closure isolation, SX wire format, server diagnostics
Root cause: _env_bind_hook mirrored ALL env_bind calls (including
lambda parameter bindings) to the shared VM globals table. Factory
functions like make-page-fn that return closures capturing different
values for the same param names (default-name, prefix, suffix) would
have the last call's values overwrite all previous closures' captured
state in globals. OP_GLOBAL_GET reads globals first, so all closures
returned the last factory call's values.
Fix: only sync root-env bindings (parent=None) to VM globals. Lambda
parameter bindings stay in their local env, found via vm_closure_env
fallback in OP_GLOBAL_GET.
Also in this commit:
- OP_CLOSURE propagates parent vm_closure_env to child closures
- Remove JIT globals injection (closure vars found via env chain)
- sx_server.ml: SX-Request header → returns text/sx (aser only)
- sx_server.ml: diagnostic endpoint GET /sx/_debug/{env,eval,route}
- sx_server.ml: page helper stubs for deep page rendering
- sx_server.ml: skip client-libs/ dir (browser-only definitions)
- adapter-html.sx: unknown components → HTML comment (not error)
- sx-platform.js: .sxbc fallback loader for bytecode modules
- Delete sx_http.ml (standalone HTTP server, unused)
- Delete stale .sxbc.json files (arity=0 bug, replaced by .sxbc)
- 7 new closure isolation tests in test-closure-isolation.sx
- mcp_tree.ml: emit arity + upvalue-count in .sxbc.json output
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1,5 +1,5 @@
|
||||
(executables
|
||||
(names run_tests debug_set sx_server sx_http integration_tests)
|
||||
(names run_tests debug_set sx_server integration_tests)
|
||||
(libraries sx unix))
|
||||
|
||||
(executable
|
||||
|
||||
@@ -1,518 +0,0 @@
|
||||
(** SX HTTP server — serves sx-docs directly from OCaml, no Python bridge.
|
||||
|
||||
Replaces: Quart + Hypercorn + ocaml_bridge.py + sx_router.py
|
||||
Keeps: Caddy (TLS termination, static files, reverse proxy)
|
||||
|
||||
Usage:
|
||||
sx_http.exe [--port 8013] [--static /path/to/shared/static]
|
||||
|
||||
Architecture:
|
||||
1. At startup: load all .sx components, pre-compute shell statics
|
||||
2. Per request: parse HTTP GET → route → eval page → render HTML
|
||||
3. No Python, no bridge, no serialization boundaries *)
|
||||
|
||||
open Sx_types
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Reuse sx_server infrastructure *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
(* Import make_server_env and rendering from sx_server.
|
||||
We can't directly share because OCaml doesn't support cross-executable
|
||||
linking. Instead, we duplicate the minimal setup and reuse library fns. *)
|
||||
|
||||
let escape_sx_string s =
|
||||
let buf = Buffer.create (String.length s + 16) in
|
||||
String.iter (function
|
||||
| '"' -> Buffer.add_string buf "\\\""
|
||||
| '\\' -> Buffer.add_string buf "\\\\"
|
||||
| '\n' -> Buffer.add_string buf "\\n"
|
||||
| '\r' -> Buffer.add_string buf "\\r"
|
||||
| '\t' -> Buffer.add_string buf "\\t"
|
||||
| c -> Buffer.add_char buf c) s;
|
||||
Buffer.contents buf
|
||||
|
||||
let rec serialize_value = function
|
||||
| Nil -> "nil"
|
||||
| Bool true -> "true"
|
||||
| Bool false -> "false"
|
||||
| Number n ->
|
||||
if Float.is_integer n then string_of_int (int_of_float n)
|
||||
else Printf.sprintf "%g" n
|
||||
| String s -> "\"" ^ escape_sx_string s ^ "\""
|
||||
| Symbol s -> s
|
||||
| Keyword k -> ":" ^ k
|
||||
| List items | ListRef { contents = items } ->
|
||||
"(" ^ String.concat " " (List.map serialize_value items) ^ ")"
|
||||
| Dict d ->
|
||||
let pairs = Hashtbl.fold (fun k v acc ->
|
||||
(Printf.sprintf ":%s %s" k (serialize_value v)) :: acc) d [] in
|
||||
"{" ^ String.concat " " pairs ^ "}"
|
||||
| RawHTML s -> "\"" ^ escape_sx_string s ^ "\""
|
||||
| SxExpr s -> s
|
||||
| _ -> "nil"
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Environment setup — mirrors make_server_env from sx_server.ml *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
(* IO bridge stubs — sx-docs has no IO callbacks, but the evaluator
|
||||
expects these symbols to exist. We stub them to raise clear errors. *)
|
||||
let setup_io_stubs env =
|
||||
let stub name =
|
||||
ignore (env_bind env name (NativeFn (name, fun _args ->
|
||||
raise (Eval_error (Printf.sprintf "IO primitive '%s' not available in sx_http" name)))))
|
||||
in
|
||||
stub "io-request";
|
||||
stub "helper";
|
||||
(* query/action/service: not needed for sx-docs *)
|
||||
stub "query";
|
||||
stub "action";
|
||||
stub "service"
|
||||
|
||||
let make_http_env () =
|
||||
let env = make_env () in
|
||||
Sx_render.setup_render_env env;
|
||||
(* Scope primitives — inline since Sx_scope was merged *)
|
||||
let _scope_stacks : (string, Sx_types.value list) Hashtbl.t = Hashtbl.create 8 in
|
||||
let bind name fn = ignore (Sx_types.env_bind env name (Sx_types.NativeFn (name, fn))) in
|
||||
bind "scope-push!" (fun args -> match args with
|
||||
| [String name; value] -> let s = try Hashtbl.find _scope_stacks name with Not_found -> [] in Hashtbl.replace _scope_stacks name (value :: s); Nil
|
||||
| [String name] -> let s = try Hashtbl.find _scope_stacks name with Not_found -> [] in Hashtbl.replace _scope_stacks name (Nil :: s); Nil
|
||||
| _ -> Nil);
|
||||
bind "scope-pop!" (fun args -> match args with
|
||||
| [String name] -> (match (try Hashtbl.find _scope_stacks name with Not_found -> []) with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
|
||||
| _ -> Nil);
|
||||
bind "scope-peek" (fun args -> match args with
|
||||
| [String name] -> (match (try Hashtbl.find _scope_stacks name with Not_found -> []) with v :: _ -> v | [] -> Nil)
|
||||
| _ -> Nil);
|
||||
bind "scope-emit!" (fun args -> match args with
|
||||
| [String name; value] ->
|
||||
let key = name ^ ":emitted" in
|
||||
let s = try Hashtbl.find _scope_stacks key with Not_found -> [] in
|
||||
Hashtbl.replace _scope_stacks key (value :: s); Nil
|
||||
| _ -> Nil);
|
||||
bind "scope-emitted" (fun args -> match args with
|
||||
| [String name] ->
|
||||
let key = name ^ ":emitted" in
|
||||
let items = try Hashtbl.find _scope_stacks key with Not_found -> [] in
|
||||
Hashtbl.replace _scope_stacks key []; List (List.rev items)
|
||||
| _ -> List []);
|
||||
bind "collect!" (fun args -> match args with
|
||||
| [String name; value] ->
|
||||
let key = name ^ ":collected" in
|
||||
let s = try Hashtbl.find _scope_stacks key with Not_found -> [] in
|
||||
Hashtbl.replace _scope_stacks key (value :: s); Nil
|
||||
| _ -> Nil);
|
||||
bind "collected" (fun args -> match args with
|
||||
| [String name] ->
|
||||
let key = name ^ ":collected" in
|
||||
let items = try Hashtbl.find _scope_stacks key with Not_found -> [] in
|
||||
Hashtbl.replace _scope_stacks key []; List (List.rev items)
|
||||
| _ -> List []);
|
||||
(* Declarative form stubs — no-ops at runtime *)
|
||||
bind "define-module" (fun _args -> Nil);
|
||||
bind "define-primitive" (fun _args -> Nil);
|
||||
bind "deftype" (fun _args -> Nil);
|
||||
bind "defeffect" (fun _args -> Nil);
|
||||
bind "deftest" (fun _args -> Nil);
|
||||
bind "defstyle" (fun _args -> Nil);
|
||||
bind "defhandler" (fun _args -> Nil);
|
||||
bind "defpage" (fun _args -> Nil);
|
||||
bind "defquery" (fun _args -> Nil);
|
||||
bind "defaction" (fun _args -> Nil);
|
||||
bind "defrelation" (fun _args -> Nil);
|
||||
(* Render stubs *)
|
||||
bind "set-render-active!" (fun _args -> Nil);
|
||||
bind "render-active?" (fun _args -> Bool true);
|
||||
bind "trampoline" (fun args -> match args with
|
||||
| [Thunk (expr, e)] -> Sx_ref.eval_expr expr (Env e)
|
||||
| [v] -> v | _ -> Nil);
|
||||
(* Setup all the standard primitives *)
|
||||
(* Evaluator bridge — needed for aser, macro expansion *)
|
||||
ignore (env_bind env "eval-expr" (NativeFn ("eval-expr", fun args ->
|
||||
match args with
|
||||
| [expr; Env e] -> Sx_ref.eval_expr expr (Env e)
|
||||
| [expr] -> Sx_ref.eval_expr expr (Env env)
|
||||
| _ -> Nil)));
|
||||
ignore (env_bind env "apply" (NativeFn ("apply", fun args ->
|
||||
match args with
|
||||
| [f; List a] -> Sx_ref.cek_call f (List a)
|
||||
| _ -> Nil)));
|
||||
ignore (env_bind env "macroexpand-1" (NativeFn ("macroexpand-1", fun args ->
|
||||
match args with
|
||||
| [expr; Env e] ->
|
||||
(try Sx_ref.eval_expr (List [Symbol "macroexpand-1-impl"; List [Symbol "quote"; expr]]) (Env e)
|
||||
with _ -> expr)
|
||||
| _ -> Nil)));
|
||||
(* Trampoline for HO primitives *)
|
||||
Sx_primitives._sx_trampoline_fn := (fun v ->
|
||||
match v with
|
||||
| Thunk (body, closure_env) -> Sx_ref.eval_expr body (Env closure_env)
|
||||
| other -> other);
|
||||
(* client? = false on server *)
|
||||
ignore (env_bind env "client?" (NativeFn ("client?", fun _ -> Bool false)));
|
||||
(* IO stubs *)
|
||||
setup_io_stubs env;
|
||||
(* Component introspection *)
|
||||
ignore (env_bind env "component-name" (NativeFn ("component-name", fun args ->
|
||||
match args with [Component c] -> String c.c_name | [Island i] -> String i.i_name | _ -> Nil)));
|
||||
ignore (env_bind env "component-params" (NativeFn ("component-params", fun args ->
|
||||
match args with
|
||||
| [Component c] -> List (List.map (fun s -> Symbol s) c.c_params)
|
||||
| [Island i] -> List (List.map (fun s -> Symbol s) i.i_params)
|
||||
| _ -> Nil)));
|
||||
ignore (env_bind env "component-body" (NativeFn ("component-body", fun args ->
|
||||
match args with [Component c] -> c.c_body | [Island i] -> i.i_body | _ -> Nil)));
|
||||
ignore (env_bind env "component-has-children?" (NativeFn ("component-has-children?", fun args ->
|
||||
match args with [Component c] -> Bool c.c_has_children | [Island i] -> Bool i.i_has_children | _ -> Bool false)));
|
||||
ignore (env_bind env "component-affinity" (NativeFn ("component-affinity", fun args ->
|
||||
match args with [Component c] -> String c.c_affinity | [Island _] -> String "client" | _ -> String "auto")));
|
||||
(* Spread attrs *)
|
||||
ignore (env_bind env "spread-attrs" (NativeFn ("spread-attrs", fun args ->
|
||||
match args with [Spread pairs] ->
|
||||
let d = Hashtbl.create 8 in
|
||||
List.iter (fun (k, v) -> Hashtbl.replace d k v) pairs; Dict d
|
||||
| _ -> Nil)));
|
||||
env
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* File loading *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let load_file env path =
|
||||
try
|
||||
let src = In_channel.with_open_text path In_channel.input_all in
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
List.iter (fun expr ->
|
||||
try ignore (Sx_ref.eval_expr expr (Env env))
|
||||
with e -> Printf.eprintf "[load] %s: %s\n%!" path (Printexc.to_string e)
|
||||
) exprs;
|
||||
Printf.eprintf "[load] %s (%d forms)\n%!" path (List.length exprs)
|
||||
with e ->
|
||||
Printf.eprintf "[load] failed %s: %s\n%!" path (Printexc.to_string e)
|
||||
|
||||
let load_dir env dir pattern =
|
||||
if Sys.file_exists dir && Sys.is_directory dir then
|
||||
Array.iter (fun f ->
|
||||
if Filename.check_suffix f pattern then
|
||||
load_file env (dir ^ "/" ^ f)
|
||||
) (Sys.readdir dir)
|
||||
|
||||
let load_all_components env project_dir =
|
||||
let spec = project_dir ^ "/spec" in
|
||||
let lib = project_dir ^ "/lib" in
|
||||
let web = project_dir ^ "/web" in
|
||||
let shared_sx = project_dir ^ "/shared/sx/templates" in
|
||||
let sx_sx = project_dir ^ "/sx/sx" in
|
||||
(* Core spec *)
|
||||
List.iter (fun f -> load_file env (spec ^ "/" ^ f)) [
|
||||
"parser.sx"; "primitives.sx"; "render.sx"; "evaluator.sx";
|
||||
];
|
||||
(* Libraries *)
|
||||
load_dir env lib ".sx";
|
||||
(* Web adapters *)
|
||||
load_dir env web ".sx";
|
||||
(* Shared templates *)
|
||||
load_dir env shared_sx ".sx";
|
||||
(* SX docs components *)
|
||||
load_dir env sx_sx ".sx"
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Shell statics — computed once at startup *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
type shell_static = {
|
||||
component_defs: string;
|
||||
component_hash: string;
|
||||
pages_sx: string;
|
||||
sx_css: string;
|
||||
asset_url: string;
|
||||
}
|
||||
|
||||
let compute_shell_statics env _project_dir =
|
||||
(* Serialize all components for client *)
|
||||
let buf = Buffer.create 65536 in
|
||||
Hashtbl.iter (fun _sym v ->
|
||||
match v with
|
||||
| Component c ->
|
||||
let ps = String.concat " " (
|
||||
"&key" :: c.c_params @
|
||||
(if c.c_has_children then ["&rest"; "children"] else []))
|
||||
in
|
||||
Buffer.add_string buf (Printf.sprintf "(defcomp ~%s (%s) %s)\n"
|
||||
c.c_name ps (serialize_value c.c_body))
|
||||
| Island i ->
|
||||
let ps = String.concat " " (
|
||||
"&key" :: i.i_params @
|
||||
(if i.i_has_children then ["&rest"; "children"] else []))
|
||||
in
|
||||
Buffer.add_string buf (Printf.sprintf "(defisland ~%s (%s) %s)\n"
|
||||
i.i_name ps (serialize_value i.i_body))
|
||||
| _ -> ()
|
||||
) env.bindings;
|
||||
let component_defs = Buffer.contents buf in
|
||||
let component_hash = Digest.string component_defs |> Digest.to_hex in
|
||||
(* Pages SX — collect defpage paths for client router *)
|
||||
(* For now, empty — client routing uses the pages script tag *)
|
||||
let pages_sx = "" in
|
||||
(* CSS — for now pass through empty, Caddy serves tw.css *)
|
||||
let sx_css = "" in
|
||||
{
|
||||
component_defs;
|
||||
component_hash;
|
||||
pages_sx;
|
||||
sx_css;
|
||||
asset_url = "/static";
|
||||
}
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* HTML rendering — same as sx_server.ml *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let sx_render_to_html expr env =
|
||||
if env_has env "render-to-html" then
|
||||
let fn = env_get env "render-to-html" in
|
||||
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.sx_render_to_html env expr env
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Page rendering — aser + SSR + shell in one pass *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let render_page env statics path =
|
||||
let t0 = Unix.gettimeofday () in
|
||||
(* Build the page AST: evaluate the URL path as an SX expression *)
|
||||
let path_expr = if path = "/" || path = "" || path = "/sx/" || path = "/sx" then "home"
|
||||
else begin
|
||||
(* /sx/(geography.(reactive)) → (geography (reactive)) *)
|
||||
let p = if String.length path > 4 && String.sub path 0 4 = "/sx/" then
|
||||
String.sub path 4 (String.length path - 4)
|
||||
else if String.length path > 1 && path.[0] = '/' then
|
||||
String.sub path 1 (String.length path - 1)
|
||||
else path
|
||||
in
|
||||
(* Convert dots to spaces for SX URL convention *)
|
||||
String.map (fun c -> if c = '.' then ' ' else c) p
|
||||
end
|
||||
in
|
||||
(* Evaluate page function to get component call *)
|
||||
let page_ast =
|
||||
try
|
||||
let exprs = Sx_parser.parse_all path_expr in
|
||||
let expr = match exprs with [e] -> e | _ -> List (List.map Fun.id exprs) in
|
||||
Sx_ref.eval_expr expr (Env env)
|
||||
with e ->
|
||||
Printf.eprintf "[route] eval failed for '%s': %s\n%!" path_expr (Printexc.to_string e);
|
||||
Nil
|
||||
in
|
||||
if page_ast = Nil then None
|
||||
else begin
|
||||
(* Wrap in layout: (~layouts/doc :path "/sx/..." page_ast) *)
|
||||
let nav_path = if String.sub path 0 4 = "/sx/" then path
|
||||
else "/sx" ^ path in
|
||||
let wrapped = List [
|
||||
Symbol "~layouts/doc"; Keyword "path"; String nav_path;
|
||||
page_ast
|
||||
] in
|
||||
(* Wrap in app-body *)
|
||||
let full_ast = List [
|
||||
Symbol "~shared:layout/app-body";
|
||||
Keyword "content"; wrapped
|
||||
] in
|
||||
let page_source = serialize_value full_ast in
|
||||
let t1 = Unix.gettimeofday () in
|
||||
(* Phase 1: aser — expand all components *)
|
||||
let expand_fn = NativeFn ("expand-components?", fun _args -> Bool true) in
|
||||
ignore (env_bind env "expand-components?" expand_fn);
|
||||
let body_result =
|
||||
let call = List [Symbol "aser";
|
||||
List [Symbol "quote"; full_ast];
|
||||
Env env] in
|
||||
Sx_ref.eval_expr call (Env env)
|
||||
in
|
||||
Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
|
||||
let body_str = match body_result with
|
||||
| String s | SxExpr s -> s
|
||||
| _ -> serialize_value body_result
|
||||
in
|
||||
let t2 = Unix.gettimeofday () in
|
||||
(* Phase 2: SSR — render expanded SX to HTML *)
|
||||
let body_html =
|
||||
try
|
||||
let body_exprs = Sx_parser.parse_all body_str in
|
||||
let body_expr = match body_exprs with
|
||||
| [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: body_exprs) in
|
||||
sx_render_to_html body_expr env
|
||||
with e ->
|
||||
Printf.eprintf "[ssr] render-to-html failed: %s\n%!" (Printexc.to_string e);
|
||||
""
|
||||
in
|
||||
let t3 = Unix.gettimeofday () in
|
||||
(* Phase 3: Shell — wrap in full HTML page *)
|
||||
let shell_args = [
|
||||
Keyword "title"; String "SX";
|
||||
Keyword "csrf"; String "";
|
||||
Keyword "page-sx"; String page_source;
|
||||
Keyword "body-html"; String body_html;
|
||||
Keyword "component-defs"; String statics.component_defs;
|
||||
Keyword "component-hash"; String statics.component_hash;
|
||||
Keyword "pages-sx"; String statics.pages_sx;
|
||||
Keyword "sx-css"; String statics.sx_css;
|
||||
Keyword "sx-css-classes"; String "";
|
||||
Keyword "asset-url"; String statics.asset_url;
|
||||
Keyword "sx-js-hash"; String "";
|
||||
Keyword "body-js-hash"; String "";
|
||||
Keyword "wasm-hash"; String "";
|
||||
Keyword "head-scripts"; Nil;
|
||||
Keyword "body-scripts"; Nil;
|
||||
Keyword "inline-css"; Nil;
|
||||
Keyword "inline-head-js"; Nil;
|
||||
Keyword "init-sx"; Nil;
|
||||
Keyword "use-wasm"; Bool (try Sys.getenv "SX_USE_WASM" = "1" with Not_found -> false);
|
||||
Keyword "meta-html"; String "";
|
||||
] in
|
||||
let shell_call = List (Symbol "~shared:shell/sx-page-shell" :: shell_args) in
|
||||
let html = sx_render_to_html shell_call env in
|
||||
let t4 = Unix.gettimeofday () in
|
||||
Printf.eprintf "[sx-http] %s route=%.3fs aser=%.3fs ssr=%.3fs shell=%.3fs total=%.3fs html=%d\n%!"
|
||||
path (t1 -. t0) (t2 -. t1) (t3 -. t2) (t4 -. t3) (t4 -. t0) (String.length html);
|
||||
Some html
|
||||
end
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* HTTP server *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let http_response ?(status=200) ?(content_type="text/html; charset=utf-8") body =
|
||||
let status_text = match status with
|
||||
| 200 -> "OK" | 404 -> "Not Found" | 500 -> "Internal Server Error"
|
||||
| _ -> "Unknown"
|
||||
in
|
||||
Printf.sprintf "HTTP/1.1 %d %s\r\nContent-Type: %s\r\nContent-Length: %d\r\nConnection: keep-alive\r\n\r\n%s"
|
||||
status status_text content_type (String.length body) body
|
||||
|
||||
let parse_request data =
|
||||
(* Extract method and path from "GET /path HTTP/1.1\r\n..." *)
|
||||
match String.split_on_char ' ' (String.trim (
|
||||
match String.index_opt data '\r' with
|
||||
| Some i -> String.sub data 0 i
|
||||
| None -> match String.index_opt data '\n' with
|
||||
| Some i -> String.sub data 0 i
|
||||
| None -> data
|
||||
)) with
|
||||
| method_ :: path :: _ -> Some (method_, path)
|
||||
| _ -> None
|
||||
|
||||
let handle_request env statics data =
|
||||
match parse_request data with
|
||||
| None -> http_response ~status:400 "Bad Request"
|
||||
| Some (method_, path) ->
|
||||
if method_ <> "GET" then
|
||||
http_response ~status:405 "Method Not Allowed"
|
||||
else begin
|
||||
let decoded = try
|
||||
let b = Buffer.create (String.length path) in
|
||||
let i = ref 0 in
|
||||
while !i < String.length path do
|
||||
if path.[!i] = '%' && !i + 2 < String.length path then begin
|
||||
let hex = String.sub path (!i + 1) 2 in
|
||||
Buffer.add_char b (Char.chr (int_of_string ("0x" ^ hex)));
|
||||
i := !i + 3
|
||||
end else begin
|
||||
Buffer.add_char b path.[!i];
|
||||
i := !i + 1
|
||||
end
|
||||
done;
|
||||
Buffer.contents b
|
||||
with _ -> path
|
||||
in
|
||||
(* Route: /sx/... or / → page render *)
|
||||
let is_sx_path = String.length decoded >= 4 && String.sub decoded 0 4 = "/sx/" in
|
||||
let is_home = decoded = "/" || decoded = "/sx/" in
|
||||
if is_home || is_sx_path then
|
||||
match render_page env statics decoded with
|
||||
| Some html -> http_response html
|
||||
| None -> http_response ~status:404 "<h1>404 Not Found</h1>"
|
||||
else
|
||||
http_response ~status:404 "<h1>404 Not Found</h1>"
|
||||
end
|
||||
|
||||
let serve env statics port =
|
||||
let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
|
||||
Unix.setsockopt sock Unix.SO_REUSEADDR true;
|
||||
Unix.bind sock (Unix.ADDR_INET (Unix.inet_addr_any, port));
|
||||
Unix.listen sock 128;
|
||||
Printf.eprintf "[sx-http] Listening on port %d\n%!" port;
|
||||
while true do
|
||||
let (client, _addr) = Unix.accept sock in
|
||||
(* Read request — simple: read up to 8KB, enough for any GET *)
|
||||
let buf = Bytes.create 8192 in
|
||||
let n = try Unix.read client buf 0 8192 with _ -> 0 in
|
||||
if n > 0 then begin
|
||||
let data = Bytes.sub_string buf 0 n in
|
||||
let response =
|
||||
try handle_request env statics data
|
||||
with e ->
|
||||
Printf.eprintf "[sx-http] Error: %s\n%!" (Printexc.to_string e);
|
||||
http_response ~status:500 "<h1>500 Internal Server Error</h1>"
|
||||
in
|
||||
let resp_bytes = Bytes.of_string response in
|
||||
let total = Bytes.length resp_bytes in
|
||||
let written = ref 0 in
|
||||
while !written < total do
|
||||
let n = Unix.write client resp_bytes !written (total - !written) in
|
||||
written := !written + n
|
||||
done
|
||||
end;
|
||||
Unix.close client
|
||||
done
|
||||
|
||||
|
||||
(* ====================================================================== *)
|
||||
(* Main *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let () =
|
||||
let port = ref 8014 in
|
||||
let project_dir = ref (try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
|
||||
try Sys.getenv "SX_ROOT" with Not_found ->
|
||||
if Sys.file_exists "/app/spec" then "/app"
|
||||
else Sys.getcwd ()) in
|
||||
(* Parse args *)
|
||||
let args = Array.to_list Sys.argv in
|
||||
let rec parse = function
|
||||
| "--port" :: p :: rest -> port := int_of_string p; parse rest
|
||||
| "--project" :: d :: rest -> project_dir := d; parse rest
|
||||
| _ :: rest -> parse rest
|
||||
| [] -> ()
|
||||
in
|
||||
parse (List.tl args);
|
||||
|
||||
Printf.eprintf "[sx-http] project_dir=%s\n%!" !project_dir;
|
||||
|
||||
(* Build environment *)
|
||||
let env = make_http_env () in
|
||||
|
||||
(* Load all components *)
|
||||
let t0 = Unix.gettimeofday () in
|
||||
load_all_components env !project_dir;
|
||||
let t1 = Unix.gettimeofday () in
|
||||
Printf.eprintf "[sx-http] Components loaded in %.3fs\n%!" (t1 -. t0);
|
||||
|
||||
(* Compute shell statics *)
|
||||
let statics = compute_shell_statics env !project_dir in
|
||||
let t2 = Unix.gettimeofday () in
|
||||
Printf.eprintf "[sx-http] Shell statics computed in %.3fs (defs=%d hash=%s)\n%!"
|
||||
(t2 -. t1) (String.length statics.component_defs) statics.component_hash;
|
||||
|
||||
(* Start HTTP server *)
|
||||
serve env statics !port
|
||||
@@ -669,11 +669,13 @@ let _shared_vm_globals : (string, Sx_types.value) Hashtbl.t = Hashtbl.create 204
|
||||
let env_to_vm_globals _env = _shared_vm_globals
|
||||
|
||||
let () =
|
||||
(* Hook env_bind globally so EVERY binding (from make_server_env, file loads,
|
||||
component defs, shell statics, etc.) is mirrored to vm globals.
|
||||
This eliminates the snapshot-staleness problem entirely. *)
|
||||
Sx_types._env_bind_hook := Some (fun _env name v ->
|
||||
Hashtbl.replace _shared_vm_globals name v)
|
||||
(* Hook env_bind so top-level bindings (defines, component defs, shell statics)
|
||||
are mirrored to vm globals. Only sync when binding in a root env (no parent)
|
||||
to avoid polluting globals with lambda parameter bindings, which would break
|
||||
closure isolation for factory functions like make-page-fn. *)
|
||||
Sx_types._env_bind_hook := Some (fun env name v ->
|
||||
if env.parent = None then
|
||||
Hashtbl.replace _shared_vm_globals name v)
|
||||
|
||||
let make_server_env () =
|
||||
let env = make_env () in
|
||||
@@ -1552,23 +1554,15 @@ let http_render_page env path headers =
|
||||
else begin
|
||||
let wrapped = List [Symbol "~layouts/doc"; Keyword "path"; String nav_path; page_ast] in
|
||||
if is_ajax then begin
|
||||
(* AJAX: render content fragment only — no shell *)
|
||||
(* AJAX: return SX wire format (aser output) with text/sx content type *)
|
||||
let body_result =
|
||||
let call = List [Symbol "aser"; List [Symbol "quote"; wrapped]; Env env] in
|
||||
Sx_ref.eval_expr call (Env env) in
|
||||
let body_str = match body_result with
|
||||
| String s | SxExpr s -> s | _ -> serialize_value body_result in
|
||||
let body_html = try
|
||||
let body_expr = match Sx_parser.parse_all body_str with
|
||||
| [e] -> e | [] -> Nil | es -> List (Symbol "<>" :: es) in
|
||||
let render_call = List [Symbol "render-to-html";
|
||||
List [Symbol "quote"; body_expr]; Env env] in
|
||||
(match Sx_ref.eval_expr render_call (Env env) with
|
||||
| String s | RawHTML s -> s | v -> Sx_runtime.value_to_str v)
|
||||
with e -> Printf.eprintf "[http-ajax] ssr error: %s\n%!" (Printexc.to_string e); "" in
|
||||
let t1 = Unix.gettimeofday () in
|
||||
Printf.eprintf "[sx-http] %s AJAX %.3fs html=%d\n%!" path (t1 -. t0) (String.length body_html);
|
||||
Some body_html
|
||||
Printf.eprintf "[sx-http] %s (SX) aser=%.3fs body=%d\n%!" path (t1 -. t0) (String.length body_str);
|
||||
Some body_str
|
||||
end else begin
|
||||
(* Full page: aser → SSR → shell *)
|
||||
let full_ast = List [Symbol "~shared:layout/app-body"; Keyword "content"; wrapped] in
|
||||
@@ -1894,7 +1888,8 @@ let http_load_files env files =
|
||||
rebind_host_extensions env
|
||||
|
||||
let http_setup_page_helpers env =
|
||||
(* Page helpers that Python normally provides. Minimal stubs for HTTP mode. *)
|
||||
(* Page helpers that Python normally provides. Minimal stubs for HTTP mode.
|
||||
These return empty/nil so pages render without hanging. *)
|
||||
let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
|
||||
(* highlight — passthrough without syntax coloring *)
|
||||
bind "highlight" (fun args ->
|
||||
@@ -1903,8 +1898,33 @@ let http_setup_page_helpers env =
|
||||
let escaped = escape_sx_string code in
|
||||
SxExpr (Printf.sprintf "(pre :class \"text-sm overflow-x-auto\" (code \"%s\"))" escaped)
|
||||
| _ -> Nil);
|
||||
(* component-source — stub *)
|
||||
bind "component-source" (fun _args -> String "")
|
||||
(* Stub all Python page helpers with nil/empty returns *)
|
||||
let stub name = bind name (fun _args -> Nil) in
|
||||
let stub_s name = bind name (fun _args -> String "") in
|
||||
stub_s "component-source";
|
||||
stub_s "handler-source";
|
||||
stub "primitives-data";
|
||||
stub "special-forms-data";
|
||||
stub "reference-data";
|
||||
stub "attr-detail-data";
|
||||
stub "header-detail-data";
|
||||
stub "event-detail-data";
|
||||
stub_s "read-spec-file";
|
||||
stub "bootstrapper-data";
|
||||
stub "bundle-analyzer-data";
|
||||
stub "routing-analyzer-data";
|
||||
stub "data-test-data";
|
||||
stub "run-spec-tests";
|
||||
stub "run-modular-tests";
|
||||
stub "streaming-demo-data";
|
||||
stub "affinity-demo-data";
|
||||
stub "optimistic-demo-data";
|
||||
stub "action:add-demo-item";
|
||||
stub "offline-demo-data";
|
||||
stub "prove-data";
|
||||
stub "page-helpers-demo-data";
|
||||
stub "spec-explorer-data";
|
||||
stub "spec-explorer-data-by-slug"
|
||||
|
||||
let http_mode port =
|
||||
let env = make_server_env () in
|
||||
@@ -1953,7 +1973,7 @@ let http_mode port =
|
||||
(* Files to skip — declarative metadata, not needed for rendering *)
|
||||
let skip_files = ["primitives.sx"; "types.sx"; "boundary.sx";
|
||||
"harness.sx"; "eval-rules.sx"; "vm-inline.sx"] in
|
||||
let skip_dirs = ["tests"; "test"; "plans"; "essays"; "spec"] in
|
||||
let skip_dirs = ["tests"; "test"; "plans"; "essays"; "spec"; "client-libs"] in
|
||||
let rec load_dir dir =
|
||||
if Sys.file_exists dir && Sys.is_directory dir then begin
|
||||
let entries = Sys.readdir dir in
|
||||
@@ -2132,12 +2152,15 @@ let http_mode port =
|
||||
in
|
||||
match work with
|
||||
| Some (fd, path, headers) ->
|
||||
let cache_key = if headers <> [] then "ajax:" ^ path else path in
|
||||
let is_ajax = headers <> [] in
|
||||
let cache_key = if is_ajax then "ajax:" ^ path else path in
|
||||
let response =
|
||||
try
|
||||
match http_render_page env path headers with
|
||||
| Some html ->
|
||||
let resp = http_response html in
|
||||
| Some body ->
|
||||
let ct = if is_ajax then "text/sx; charset=utf-8"
|
||||
else "text/html; charset=utf-8" in
|
||||
let resp = http_response ~content_type:ct body in
|
||||
Hashtbl.replace response_cache cache_key resp;
|
||||
resp
|
||||
| None -> http_response ~status:404 "<h1>Not Found</h1>"
|
||||
@@ -2163,6 +2186,51 @@ let http_mode port =
|
||||
if path = "/" then begin
|
||||
write_response fd (http_redirect "/sx/"); true
|
||||
end else
|
||||
(* Debug endpoint — runs on main thread, no render worker *)
|
||||
if String.length path > 11 && String.sub path 0 11 = "/sx/_debug/" then begin
|
||||
let cmd = String.sub path 11 (String.length path - 11) in
|
||||
let query_start = try String.index cmd '?' with Not_found -> String.length cmd in
|
||||
let action = String.sub cmd 0 query_start in
|
||||
let query = if query_start < String.length cmd - 1
|
||||
then String.sub cmd (query_start + 1) (String.length cmd - query_start - 1)
|
||||
else "" in
|
||||
let get_param key =
|
||||
let prefix = key ^ "=" in
|
||||
let parts = String.split_on_char '&' query in
|
||||
match List.find_opt (fun p -> String.length p >= String.length prefix
|
||||
&& String.sub p 0 (String.length prefix) = prefix) parts with
|
||||
| Some p -> url_decode (String.sub p (String.length prefix) (String.length p - String.length prefix))
|
||||
| None -> "" in
|
||||
let result = match action with
|
||||
| "env" ->
|
||||
let name = get_param "name" in
|
||||
(try
|
||||
let v = env_get env name in
|
||||
Printf.sprintf "%s = %s\n" name (Sx_runtime.value_to_str (Sx_runtime.type_of v))
|
||||
with _ -> Printf.sprintf "%s = UNDEFINED\n" name)
|
||||
| "eval" ->
|
||||
let expr_s = get_param "expr" in
|
||||
(try
|
||||
let exprs = Sx_parser.parse_all expr_s in
|
||||
let result = List.fold_left (fun _ e -> Sx_ref.eval_expr e (Env env)) Nil exprs in
|
||||
Sx_runtime.value_to_str result ^ "\n"
|
||||
with e -> Printf.sprintf "ERROR: %s\n" (Printexc.to_string e))
|
||||
| "route" ->
|
||||
let p = get_param "path" in
|
||||
(try
|
||||
let handler = env_get env "sx-handle-request" in
|
||||
let headers_dict = Hashtbl.create 0 in
|
||||
let r = Sx_ref.cek_call handler (List [String p; Dict headers_dict; Env env; Nil]) in
|
||||
match r with
|
||||
| Dict d ->
|
||||
let page_ast = match Hashtbl.find_opt d "page-ast" with Some v -> v | _ -> Nil in
|
||||
Printf.sprintf "page-ast: %s\n" (Sx_runtime.value_to_str page_ast)
|
||||
| _ -> Printf.sprintf "route returned: %s\n" (Sx_runtime.value_to_str r)
|
||||
with e -> Printf.sprintf "ERROR: %s\n" (Printexc.to_string e))
|
||||
| _ -> "Unknown debug command. Try: env?name=X, eval?expr=X, route?path=X\n"
|
||||
in
|
||||
write_response fd (http_response ~content_type:"text/plain; charset=utf-8" result); true
|
||||
end else
|
||||
let is_sx = path = "/sx/" || path = "/sx"
|
||||
|| (String.length path > 4 && String.sub path 0 4 = "/sx/") in
|
||||
if is_sx then begin
|
||||
|
||||
@@ -371,7 +371,7 @@ and run vm =
|
||||
frame.closure.vm_upvalues.(index)
|
||||
) in
|
||||
let cl = { vm_code = code; vm_upvalues = upvalues; vm_name = None;
|
||||
vm_env_ref = vm.globals; vm_closure_env = None } in
|
||||
vm_env_ref = vm.globals; vm_closure_env = frame.closure.vm_closure_env } in
|
||||
push vm (VmClosure cl)
|
||||
| 52 (* OP_CALL_PRIM *) ->
|
||||
let idx = read_u16 frame in
|
||||
@@ -578,32 +578,13 @@ let jit_compile_lambda (l : lambda) globals =
|
||||
let fn_expr = List [Symbol "fn"; param_syms; l.l_body] in
|
||||
let quoted = List [Symbol "quote"; fn_expr] in
|
||||
let result = Sx_ref.eval_expr (List [compile_fn; quoted]) (Env (make_env ())) in
|
||||
(* If the lambda has closure-captured variables, merge them into globals
|
||||
so the VM can find them via GLOBAL_GET. The compiler doesn't know
|
||||
about the enclosing scope, so closure vars get compiled as globals. *)
|
||||
let effective_globals =
|
||||
(* Use the LIVE globals table directly. Inject only truly local
|
||||
closure bindings (not already in globals) into the live table.
|
||||
This ensures GLOBAL_GET always sees the latest define values.
|
||||
Previous approach copied globals, creating a stale snapshot. *)
|
||||
let closure = l.l_closure in
|
||||
let count = ref 0 in
|
||||
let rec inject env =
|
||||
Hashtbl.iter (fun id v ->
|
||||
let name = Sx_types.unintern id in
|
||||
if not (Hashtbl.mem globals name) then begin
|
||||
Hashtbl.replace globals name v;
|
||||
incr count
|
||||
end
|
||||
) env.bindings;
|
||||
match env.parent with Some p -> inject p | None -> ()
|
||||
in
|
||||
if Hashtbl.length closure.bindings > 0 || closure.parent <> None then
|
||||
inject closure;
|
||||
if !count > 0 then
|
||||
Printf.eprintf "[jit] %s: injected %d closure bindings\n%!" fn_name !count;
|
||||
globals
|
||||
in
|
||||
(* Closure vars are accessible via vm_closure_env (set on the VmClosure
|
||||
at line ~617). OP_GLOBAL_GET falls back to vm_closure_env when vars
|
||||
aren't in globals. No injection into the shared globals table —
|
||||
that would break closure isolation for factory functions like
|
||||
make-page-fn where multiple closures capture different values
|
||||
for the same variable names. *)
|
||||
let effective_globals = globals in
|
||||
(match result with
|
||||
| Dict d when Hashtbl.mem d "bytecode" ->
|
||||
let outer_code = code_from_value result in
|
||||
@@ -798,7 +779,7 @@ let trace_run src globals =
|
||||
) in
|
||||
let inner_code = code_from_value code_val2 in
|
||||
let c = { vm_code = inner_code; vm_upvalues = upvalues; vm_name = None;
|
||||
vm_env_ref = vm.globals; vm_closure_env = None } in
|
||||
vm_env_ref = vm.globals; vm_closure_env = frame.closure.vm_closure_env } in
|
||||
push vm (VmClosure c)
|
||||
| 52 -> let idx = read_u16 frame in let argc = read_u8 frame in
|
||||
let name = match frame.closure.vm_code.vc_constants.(idx) with String s -> s | _ -> "" in
|
||||
|
||||
@@ -14,7 +14,7 @@
|
||||
// =========================================================================
|
||||
|
||||
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
|
||||
var SX_VERSION = "2026-03-28T22:04:02Z";
|
||||
var SX_VERSION = "2026-03-30T12:33:49Z";
|
||||
|
||||
function isNil(x) { return x === NIL || x === null || x === undefined; }
|
||||
function isSxTruthy(x) { return x !== false && !isNil(x); }
|
||||
@@ -1104,6 +1104,63 @@ PRIMITIVES["make-ho-setup-frame"] = makeHoSetupFrame;
|
||||
var makeCompTraceFrame = function(name, file) { return {"env": file, "type": "comp-trace", "name": name}; };
|
||||
PRIMITIVES["make-comp-trace-frame"] = makeCompTraceFrame;
|
||||
|
||||
// kont-collect-comp-trace
|
||||
var kontCollectCompTrace = function(kont) { return (isSxTruthy(isEmpty(kont)) ? [] : (function() {
|
||||
var frame = first(kont);
|
||||
return (isSxTruthy((frameType(frame) == "comp-trace")) ? cons({"file": get(frame, "file"), "name": get(frame, "name")}, kontCollectCompTrace(rest(kont))) : kontCollectCompTrace(rest(kont)));
|
||||
})()); };
|
||||
PRIMITIVES["kont-collect-comp-trace"] = kontCollectCompTrace;
|
||||
|
||||
// make-handler-frame
|
||||
var makeHandlerFrame = function(handlers, remaining, env) { return {"env": env, "type": "handler", "f": handlers, "remaining": remaining}; };
|
||||
PRIMITIVES["make-handler-frame"] = makeHandlerFrame;
|
||||
|
||||
// make-restart-frame
|
||||
var makeRestartFrame = function(restarts, remaining, env) { return {"env": env, "type": "restart", "f": restarts, "remaining": remaining}; };
|
||||
PRIMITIVES["make-restart-frame"] = makeRestartFrame;
|
||||
|
||||
// make-signal-return-frame
|
||||
var makeSignalReturnFrame = function(env, savedKont) { return {"env": env, "type": "signal-return", "f": savedKont}; };
|
||||
PRIMITIVES["make-signal-return-frame"] = makeSignalReturnFrame;
|
||||
|
||||
// find-matching-handler
|
||||
var findMatchingHandler = function(handlers, condition) { return (isSxTruthy(isEmpty(handlers)) ? NIL : (function() {
|
||||
var pair = first(handlers);
|
||||
return (function() {
|
||||
var pred = first(pair);
|
||||
var handlerFn = nth(pair, 1);
|
||||
return (isSxTruthy(cekCall(pred, [condition])) ? handlerFn : findMatchingHandler(rest(handlers), condition));
|
||||
})();
|
||||
})()); };
|
||||
PRIMITIVES["find-matching-handler"] = findMatchingHandler;
|
||||
|
||||
// kont-find-handler
|
||||
var kontFindHandler = function(kont, condition) { return (isSxTruthy(isEmpty(kont)) ? NIL : (function() {
|
||||
var frame = first(kont);
|
||||
return (isSxTruthy((frameType(frame) == "handler")) ? (function() {
|
||||
var match = findMatchingHandler(get(frame, "f"), condition);
|
||||
return (isSxTruthy(isNil(match)) ? kontFindHandler(rest(kont), condition) : match);
|
||||
})() : kontFindHandler(rest(kont), condition));
|
||||
})()); };
|
||||
PRIMITIVES["kont-find-handler"] = kontFindHandler;
|
||||
|
||||
// find-named-restart
|
||||
var findNamedRestart = function(restarts, name) { return (isSxTruthy(isEmpty(restarts)) ? NIL : (function() {
|
||||
var entry = first(restarts);
|
||||
return (isSxTruthy((first(entry) == name)) ? entry : findNamedRestart(rest(restarts), name));
|
||||
})()); };
|
||||
PRIMITIVES["find-named-restart"] = findNamedRestart;
|
||||
|
||||
// kont-find-restart
|
||||
var kontFindRestart = function(kont, name) { return (isSxTruthy(isEmpty(kont)) ? NIL : (function() {
|
||||
var frame = first(kont);
|
||||
return (isSxTruthy((frameType(frame) == "restart")) ? (function() {
|
||||
var match = findNamedRestart(get(frame, "f"), name);
|
||||
return (isSxTruthy(isNil(match)) ? kontFindRestart(rest(kont), name) : [match, frame, rest(kont)]);
|
||||
})() : kontFindRestart(rest(kont), name));
|
||||
})()); };
|
||||
PRIMITIVES["kont-find-restart"] = kontFindRestart;
|
||||
|
||||
// frame-type
|
||||
var frameType = function(f) { return get(f, "type"); };
|
||||
PRIMITIVES["frame-type"] = frameType;
|
||||
@@ -1200,7 +1257,7 @@ PRIMITIVES["*prim-param-types*"] = _primParamTypes_;
|
||||
PRIMITIVES["set-prim-param-types!"] = setPrimParamTypes_b;
|
||||
|
||||
// value-matches-type?
|
||||
var valueMatchesType_p = function(val, expectedType) { return (isSxTruthy((expectedType == "any")) ? true : (isSxTruthy((expectedType == "number")) ? isNumber(val) : (isSxTruthy((expectedType == "string")) ? isString(val) : (isSxTruthy((expectedType == "boolean")) ? boolean_p(val) : (isSxTruthy((expectedType == "nil")) ? isNil(val) : (isSxTruthy((expectedType == "list")) ? isList(val) : (isSxTruthy((expectedType == "dict")) ? isDict(val) : (isSxTruthy((expectedType == "lambda")) ? isLambda(val) : (isSxTruthy((expectedType == "symbol")) ? (typeOf(val) == "symbol") : (isSxTruthy((expectedType == "keyword")) ? (typeOf(val) == "keyword") : (isSxTruthy((isSxTruthy(isString(expectedType)) && endsWith(expectedType, "?"))) ? sxOr(isNil(val), valueMatchesType_p(val, slice(expectedType, 0, (stringLength(expectedType) - 1)))) : true))))))))))); };
|
||||
var valueMatchesType_p = function(val, expectedType) { return match(expectedType, ["any", true], ["number", isNumber(val)], ["string", isString(val)], ["boolean", boolean_p(val)], ["nil", isNil(val)], ["list", isList(val)], ["dict", isDict(val)], ["lambda", isLambda(val)], ["symbol", (typeOf(val) == "symbol")], ["keyword", (typeOf(val) == "keyword")], _((isSxTruthy((isSxTruthy(isString(expectedType)) && endsWith(expectedType, "?"))) ? sxOr(isNil(val), valueMatchesType_p(val, slice(expectedType, 0, (stringLength(expectedType) - 1)))) : true))); };
|
||||
PRIMITIVES["value-matches-type?"] = valueMatchesType_p;
|
||||
|
||||
// strict-check-args
|
||||
@@ -1334,6 +1391,9 @@ PRIMITIVES["sf-lambda"] = sfLambda;
|
||||
effectAnns[symbolName(nameSym)] = effectList;
|
||||
return envBind(env, "*effect-annotations*", effectAnns);
|
||||
})();
|
||||
}
|
||||
if (isSxTruthy(envHas(env, "*current-file*"))) {
|
||||
componentSetFile_b(comp, envGet(env, "*current-file*"));
|
||||
}
|
||||
envBind(env, symbolName(nameSym), comp);
|
||||
return comp;
|
||||
@@ -1388,6 +1448,9 @@ PRIMITIVES["parse-comp-params"] = parseCompParams;
|
||||
var hasChildren = nth(parsed, 1);
|
||||
return (function() {
|
||||
var island = makeIsland(compName, params, hasChildren, body, env);
|
||||
if (isSxTruthy(envHas(env, "*current-file*"))) {
|
||||
componentSetFile_b(island, envGet(env, "*current-file*"));
|
||||
}
|
||||
envBind(env, symbolName(nameSym), island);
|
||||
return island;
|
||||
})();
|
||||
@@ -1555,14 +1618,96 @@ PRIMITIVES["step-eval"] = stepEval;
|
||||
var args = rest(expr);
|
||||
return (isSxTruthy(!isSxTruthy(sxOr((typeOf(head) == "symbol"), (typeOf(head) == "lambda"), (typeOf(head) == "list")))) ? (isSxTruthy(isEmpty(expr)) ? makeCekValue([], env, kont) : makeCekState(first(expr), env, kontPush(makeMapFrame(NIL, rest(expr), [], env), kont))) : (isSxTruthy((typeOf(head) == "symbol")) ? (function() {
|
||||
var name = symbolName(head);
|
||||
return (isSxTruthy((name == "if")) ? stepSfIf(args, env, kont) : (isSxTruthy((name == "when")) ? stepSfWhen(args, env, kont) : (isSxTruthy((name == "cond")) ? stepSfCond(args, env, kont) : (isSxTruthy((name == "case")) ? stepSfCase(args, env, kont) : (isSxTruthy((name == "and")) ? stepSfAnd(args, env, kont) : (isSxTruthy((name == "or")) ? stepSfOr(args, env, kont) : (isSxTruthy((name == "let")) ? stepSfLet(args, env, kont) : (isSxTruthy((name == "let*")) ? stepSfLet(args, env, kont) : (isSxTruthy((name == "lambda")) ? stepSfLambda(args, env, kont) : (isSxTruthy((name == "fn")) ? stepSfLambda(args, env, kont) : (isSxTruthy((name == "define")) ? stepSfDefine(args, env, kont) : (isSxTruthy((name == "defcomp")) ? makeCekValue(sfDefcomp(args, env), env, kont) : (isSxTruthy((name == "defisland")) ? makeCekValue(sfDefisland(args, env), env, kont) : (isSxTruthy((name == "defmacro")) ? makeCekValue(sfDefmacro(args, env), env, kont) : (isSxTruthy((name == "begin")) ? stepSfBegin(args, env, kont) : (isSxTruthy((name == "do")) ? stepSfBegin(args, env, kont) : (isSxTruthy((name == "quote")) ? makeCekValue((isSxTruthy(isEmpty(args)) ? NIL : first(args)), env, kont) : (isSxTruthy((name == "quasiquote")) ? makeCekValue(qqExpand(first(args), env), env, kont) : (isSxTruthy((name == "->")) ? stepSfThreadFirst(args, env, kont) : (isSxTruthy((name == "set!")) ? stepSfSet(args, env, kont) : (isSxTruthy((name == "letrec")) ? stepSfLetrec(args, env, kont) : (isSxTruthy((name == "reset")) ? stepSfReset(args, env, kont) : (isSxTruthy((name == "shift")) ? stepSfShift(args, env, kont) : (isSxTruthy((name == "deref")) ? stepSfDeref(args, env, kont) : (isSxTruthy((name == "scope")) ? stepSfScope(args, env, kont) : (isSxTruthy((name == "provide")) ? stepSfProvide(args, env, kont) : (isSxTruthy((name == "context")) ? stepSfContext(args, env, kont) : (isSxTruthy((name == "emit!")) ? stepSfEmit(args, env, kont) : (isSxTruthy((name == "emitted")) ? stepSfEmitted(args, env, kont) : (isSxTruthy((name == "dynamic-wind")) ? makeCekValue(sfDynamicWind(args, env), env, kont) : (isSxTruthy((name == "map")) ? stepHoMap(args, env, kont) : (isSxTruthy((name == "map-indexed")) ? stepHoMapIndexed(args, env, kont) : (isSxTruthy((name == "filter")) ? stepHoFilter(args, env, kont) : (isSxTruthy((name == "reduce")) ? stepHoReduce(args, env, kont) : (isSxTruthy((name == "some")) ? stepHoSome(args, env, kont) : (isSxTruthy((name == "every?")) ? stepHoEvery(args, env, kont) : (isSxTruthy((name == "for-each")) ? stepHoForEach(args, env, kont) : (isSxTruthy(dictHas(_customSpecialForms, name)) ? makeCekValue((get(_customSpecialForms, name))(args, env), env, kont) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? (function() {
|
||||
return match(name, ["if", stepSfIf(args, env, kont)], ["when", stepSfWhen(args, env, kont)], ["cond", stepSfCond(args, env, kont)], ["case", stepSfCase(args, env, kont)], ["and", stepSfAnd(args, env, kont)], ["or", stepSfOr(args, env, kont)], ["let", stepSfLet(args, env, kont)], ["let*", stepSfLet(args, env, kont)], ["lambda", stepSfLambda(args, env, kont)], ["fn", stepSfLambda(args, env, kont)], ["define", stepSfDefine(args, env, kont)], ["defcomp", makeCekValue(sfDefcomp(args, env), env, kont)], ["defisland", makeCekValue(sfDefisland(args, env), env, kont)], ["defmacro", makeCekValue(sfDefmacro(args, env), env, kont)], ["begin", stepSfBegin(args, env, kont)], ["do", stepSfBegin(args, env, kont)], ["quote", makeCekValue((isSxTruthy(isEmpty(args)) ? NIL : first(args)), env, kont)], ["quasiquote", makeCekValue(qqExpand(first(args), env), env, kont)], ["->", stepSfThreadFirst(args, env, kont)], ["set!", stepSfSet(args, env, kont)], ["letrec", stepSfLetrec(args, env, kont)], ["reset", stepSfReset(args, env, kont)], ["shift", stepSfShift(args, env, kont)], ["deref", stepSfDeref(args, env, kont)], ["scope", stepSfScope(args, env, kont)], ["provide", stepSfProvide(args, env, kont)], ["context", stepSfContext(args, env, kont)], ["emit!", stepSfEmit(args, env, kont)], ["emitted", stepSfEmitted(args, env, kont)], ["handler-bind", stepSfHandlerBind(args, env, kont)], ["restart-case", stepSfRestartCase(args, env, kont)], ["signal-condition", stepSfSignal(args, env, kont)], ["invoke-restart", stepSfInvokeRestart(args, env, kont)], ["match", stepSfMatch(args, env, kont)], ["dynamic-wind", makeCekValue(sfDynamicWind(args, env), env, kont)], ["map", stepHoMap(args, env, kont)], ["map-indexed", stepHoMapIndexed(args, env, kont)], ["filter", stepHoFilter(args, env, kont)], ["reduce", stepHoReduce(args, env, kont)], ["some", stepHoSome(args, env, kont)], ["every?", stepHoEvery(args, env, kont)], ["for-each", stepHoForEach(args, env, kont)], _((isSxTruthy(dictHas(_customSpecialForms, name)) ? makeCekValue((get(_customSpecialForms, name))(args, env), env, kont) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? (function() {
|
||||
var mac = envGet(env, name);
|
||||
return makeCekState(expandMacro(mac, args, env), env, kont);
|
||||
})() : (isSxTruthy((isSxTruthy(_renderCheck) && _renderCheck(expr, env))) ? makeCekValue(_renderFn(expr, env), env, kont) : stepEvalCall(head, args, env, kont)))))))))))))))))))))))))))))))))))))))));
|
||||
})() : (isSxTruthy((isSxTruthy(_renderCheck) && _renderCheck(expr, env))) ? makeCekValue(_renderFn(expr, env), env, kont) : stepEvalCall(head, args, env, kont))))));
|
||||
})() : stepEvalCall(head, args, env, kont)));
|
||||
})(); };
|
||||
PRIMITIVES["step-eval-list"] = stepEvalList;
|
||||
|
||||
// match-find-clause
|
||||
var matchFindClause = function(val, clauses, env) { return (isSxTruthy(isEmpty(clauses)) ? NIL : (function() {
|
||||
var clause = first(clauses);
|
||||
var pattern = first(clause);
|
||||
var body = nth(clause, 1);
|
||||
var local = envExtend(env);
|
||||
return (isSxTruthy(matchPattern(pattern, val, local)) ? [local, body] : matchFindClause(val, rest(clauses), env));
|
||||
})()); };
|
||||
PRIMITIVES["match-find-clause"] = matchFindClause;
|
||||
|
||||
// match-pattern
|
||||
var matchPattern = function(pattern, value, env) { return (isSxTruthy((pattern == new Symbol("_"))) ? true : (isSxTruthy((isSxTruthy(isList(pattern)) && isSxTruthy((len(pattern) == 2)) && (first(pattern) == new Symbol("?")))) ? (function() {
|
||||
var pred = trampoline(evalExpr(nth(pattern, 1), env));
|
||||
return cekCall(pred, [value]);
|
||||
})() : (isSxTruthy((isSxTruthy(isList(pattern)) && isSxTruthy(!isSxTruthy(isEmpty(pattern))) && (first(pattern) == new Symbol("quote")))) ? (value == nth(pattern, 1)) : (isSxTruthy(symbol_p(pattern)) ? (envBind(env, symbolName(pattern), value), true) : (isSxTruthy((isSxTruthy(isList(pattern)) && isList(value))) ? (isSxTruthy(!isSxTruthy((len(pattern) == len(value)))) ? false : (function() {
|
||||
var pairs = zip(pattern, value);
|
||||
return isEvery(function(pair) { return matchPattern(first(pair), nth(pair, 1), env); }, pairs);
|
||||
})()) : (pattern == value)))))); };
|
||||
PRIMITIVES["match-pattern"] = matchPattern;
|
||||
|
||||
// step-sf-match
|
||||
var stepSfMatch = function(args, env, kont) { return (function() {
|
||||
var val = trampoline(evalExpr(first(args), env));
|
||||
var clauses = rest(args);
|
||||
return (function() {
|
||||
var result = matchFindClause(val, clauses, env);
|
||||
return (isSxTruthy(isNil(result)) ? error((String("match: no clause matched ") + String(inspect(val)))) : makeCekState(nth(result, 1), first(result), kont));
|
||||
})();
|
||||
})(); };
|
||||
PRIMITIVES["step-sf-match"] = stepSfMatch;
|
||||
|
||||
// step-sf-handler-bind
|
||||
var stepSfHandlerBind = function(args, env, kont) { return (function() {
|
||||
var handlerSpecs = first(args);
|
||||
var body = rest(args);
|
||||
var handlers = map(function(spec) { return [trampoline(evalExpr(first(spec), env)), trampoline(evalExpr(nth(spec, 1), env))]; }, handlerSpecs);
|
||||
return (isSxTruthy(isEmpty(body)) ? makeCekValue(NIL, env, kont) : makeCekState(first(body), env, kontPush(makeHandlerFrame(handlers, rest(body), env), kont)));
|
||||
})(); };
|
||||
PRIMITIVES["step-sf-handler-bind"] = stepSfHandlerBind;
|
||||
|
||||
// step-sf-restart-case
|
||||
var stepSfRestartCase = function(args, env, kont) { return (function() {
|
||||
var body = first(args);
|
||||
var restartSpecs = rest(args);
|
||||
var restarts = map(function(spec) { return [(isSxTruthy(symbol_p(first(spec))) ? symbolName(first(spec)) : first(spec)), nth(spec, 1), nth(spec, 2)]; }, restartSpecs);
|
||||
return makeCekState(body, env, kontPush(makeRestartFrame(restarts, [], env), kont));
|
||||
})(); };
|
||||
PRIMITIVES["step-sf-restart-case"] = stepSfRestartCase;
|
||||
|
||||
// step-sf-signal
|
||||
var stepSfSignal = function(args, env, kont) { return (function() {
|
||||
var condition = trampoline(evalExpr(first(args), env));
|
||||
var handlerFn = kontFindHandler(kont, condition);
|
||||
return (isSxTruthy(isNil(handlerFn)) ? error((String("Unhandled condition: ") + String(inspect(condition)))) : continueWithCall(handlerFn, [condition], env, [condition], kontPush(makeSignalReturnFrame(env, kont), kont)));
|
||||
})(); };
|
||||
PRIMITIVES["step-sf-signal"] = stepSfSignal;
|
||||
|
||||
// step-sf-invoke-restart
|
||||
var stepSfInvokeRestart = function(args, env, kont) { return (function() {
|
||||
var restartName = (function() {
|
||||
var rn = (isSxTruthy(symbol_p(first(args))) ? symbolName(first(args)) : trampoline(evalExpr(first(args), env)));
|
||||
return (isSxTruthy(symbol_p(rn)) ? symbolName(rn) : rn);
|
||||
})();
|
||||
var restartArg = (isSxTruthy((len(args) >= 2)) ? trampoline(evalExpr(nth(args, 1), env)) : NIL);
|
||||
var found = kontFindRestart(kont, restartName);
|
||||
return (isSxTruthy(isNil(found)) ? error((String("No restart named: ") + String(inspect(restartName)))) : (function() {
|
||||
var entry = first(found);
|
||||
var restartFrame = nth(found, 1);
|
||||
var restKont = nth(found, 2);
|
||||
return (function() {
|
||||
var params = nth(entry, 1);
|
||||
var body = nth(entry, 2);
|
||||
var restartEnv = envExtend(get(restartFrame, "env"));
|
||||
if (isSxTruthy(!isSxTruthy(isEmpty(params)))) {
|
||||
envBind(restartEnv, first(params), restartArg);
|
||||
}
|
||||
return makeCekState(body, restartEnv, restKont);
|
||||
})();
|
||||
})());
|
||||
})(); };
|
||||
PRIMITIVES["step-sf-invoke-restart"] = stepSfInvokeRestart;
|
||||
|
||||
// step-sf-if
|
||||
var stepSfIf = function(args, env, kont) { return makeCekState(first(args), env, kontPush(makeIfFrame(nth(args, 1), (isSxTruthy((len(args) > 2)) ? nth(args, 2) : NIL), env), kont)); };
|
||||
PRIMITIVES["step-sf-if"] = stepSfIf;
|
||||
@@ -1786,29 +1931,29 @@ PRIMITIVES["ho-swap-args"] = hoSwapArgs;
|
||||
var ordered = hoSwapArgs(hoType, evaled);
|
||||
return (function() {
|
||||
var f = first(ordered);
|
||||
return (isSxTruthy((hoType == "map")) ? (function() {
|
||||
return match(hoType, ["map", (function() {
|
||||
var coll = nth(ordered, 1);
|
||||
return (isSxTruthy(isEmpty(coll)) ? makeCekValue([], env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeMapFrame(f, rest(coll), [], env), kont)));
|
||||
})() : (isSxTruthy((hoType == "map-indexed")) ? (function() {
|
||||
})()], ["map-indexed", (function() {
|
||||
var coll = nth(ordered, 1);
|
||||
return (isSxTruthy(isEmpty(coll)) ? makeCekValue([], env, kont) : continueWithCall(f, [0, first(coll)], env, [], kontPush(makeMapIndexedFrame(f, rest(coll), [], env), kont)));
|
||||
})() : (isSxTruthy((hoType == "filter")) ? (function() {
|
||||
})()], ["filter", (function() {
|
||||
var coll = nth(ordered, 1);
|
||||
return (isSxTruthy(isEmpty(coll)) ? makeCekValue([], env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeFilterFrame(f, rest(coll), [], first(coll), env), kont)));
|
||||
})() : (isSxTruthy((hoType == "reduce")) ? (function() {
|
||||
})()], ["reduce", (function() {
|
||||
var init = nth(ordered, 1);
|
||||
var coll = nth(ordered, 2);
|
||||
return (isSxTruthy(isEmpty(coll)) ? makeCekValue(init, env, kont) : continueWithCall(f, [init, first(coll)], env, [], kontPush(makeReduceFrame(f, rest(coll), env), kont)));
|
||||
})() : (isSxTruthy((hoType == "some")) ? (function() {
|
||||
})()], ["some", (function() {
|
||||
var coll = nth(ordered, 1);
|
||||
return (isSxTruthy(isEmpty(coll)) ? makeCekValue(false, env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeSomeFrame(f, rest(coll), env), kont)));
|
||||
})() : (isSxTruthy((hoType == "every")) ? (function() {
|
||||
})()], ["every", (function() {
|
||||
var coll = nth(ordered, 1);
|
||||
return (isSxTruthy(isEmpty(coll)) ? makeCekValue(true, env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeEveryFrame(f, rest(coll), env), kont)));
|
||||
})() : (isSxTruthy((hoType == "for-each")) ? (function() {
|
||||
})()], ["for-each", (function() {
|
||||
var coll = nth(ordered, 1);
|
||||
return (isSxTruthy(isEmpty(coll)) ? makeCekValue(NIL, env, kont) : continueWithCall(f, [first(coll)], env, [], kontPush(makeForEachFrame(f, rest(coll), env), kont)));
|
||||
})() : error((String("Unknown HO type: ") + String(hoType))))))))));
|
||||
})()], _(error((String("Unknown HO type: ") + String(hoType)))));
|
||||
})();
|
||||
})(); };
|
||||
PRIMITIVES["ho-setup-dispatch"] = hoSetupDispatch;
|
||||
@@ -1850,15 +1995,15 @@ PRIMITIVES["step-ho-for-each"] = stepHoForEach;
|
||||
var frame = kontTop(kont);
|
||||
var restK = kontPop(kont);
|
||||
var ft = frameType(frame);
|
||||
return (isSxTruthy((ft == "if")) ? (isSxTruthy((isSxTruthy(value) && !isSxTruthy(isNil(value)))) ? makeCekState(get(frame, "then"), get(frame, "env"), restK) : (isSxTruthy(isNil(get(frame, "else"))) ? makeCekValue(NIL, env, restK) : makeCekState(get(frame, "else"), get(frame, "env"), restK))) : (isSxTruthy((ft == "when")) ? (isSxTruthy((isSxTruthy(value) && !isSxTruthy(isNil(value)))) ? (function() {
|
||||
return match(ft, ["if", (isSxTruthy((isSxTruthy(value) && !isSxTruthy(isNil(value)))) ? makeCekState(get(frame, "then"), get(frame, "env"), restK) : (isSxTruthy(isNil(get(frame, "else"))) ? makeCekValue(NIL, env, restK) : makeCekState(get(frame, "else"), get(frame, "env"), restK)))], ["when", (isSxTruthy((isSxTruthy(value) && !isSxTruthy(isNil(value)))) ? (function() {
|
||||
var body = get(frame, "body");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(isEmpty(body)) ? makeCekValue(NIL, fenv, restK) : (isSxTruthy((len(body) == 1)) ? makeCekState(first(body), fenv, restK) : makeCekState(first(body), fenv, kontPush(makeBeginFrame(rest(body), fenv), restK))));
|
||||
})() : makeCekValue(NIL, env, restK)) : (isSxTruthy((ft == "begin")) ? (function() {
|
||||
})() : makeCekValue(NIL, env, restK))], ["begin", (function() {
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : (isSxTruthy((len(remaining) == 1)) ? makeCekState(first(remaining), fenv, restK) : makeCekState(first(remaining), fenv, kontPush(makeBeginFrame(rest(remaining), fenv), restK))));
|
||||
})() : (isSxTruthy((ft == "let")) ? (function() {
|
||||
})()], ["let", (function() {
|
||||
var name = get(frame, "name");
|
||||
var remaining = get(frame, "remaining");
|
||||
var body = get(frame, "body");
|
||||
@@ -1869,7 +2014,7 @@ PRIMITIVES["step-ho-for-each"] = stepHoForEach;
|
||||
var vname = (isSxTruthy((typeOf(first(nextBinding)) == "symbol")) ? symbolName(first(nextBinding)) : first(nextBinding));
|
||||
return makeCekState(nth(nextBinding, 1), local, kontPush(makeLetFrame(vname, rest(remaining), body, local), restK));
|
||||
})());
|
||||
})() : (isSxTruthy((ft == "define")) ? (function() {
|
||||
})()], ["define", (function() {
|
||||
var name = get(frame, "name");
|
||||
var fenv = get(frame, "env");
|
||||
var hasEffects = get(frame, "has-effects");
|
||||
@@ -1880,25 +2025,25 @@ PRIMITIVES["step-ho-for-each"] = stepHoForEach;
|
||||
envBind(fenv, name, value);
|
||||
if (isSxTruthy(hasEffects)) {
|
||||
(function() {
|
||||
var effectNames = (isSxTruthy((typeOf(effectList) == "list")) ? map(function(e) { return (isSxTruthy((typeOf(e) == "symbol")) ? symbolName(e) : (String(e))); }, effectList) : [(String(effectList))]);
|
||||
var effectNames = map(function(e) { return (isSxTruthy((typeOf(e) == "symbol")) ? symbolName(e) : e); }, effectList);
|
||||
var effectAnns = (isSxTruthy(envHas(fenv, "*effect-annotations*")) ? envGet(fenv, "*effect-annotations*") : {});
|
||||
effectAnns[name] = effectNames;
|
||||
return envBind(fenv, "*effect-annotations*", effectAnns);
|
||||
})();
|
||||
}
|
||||
return makeCekValue(value, fenv, restK);
|
||||
})() : (isSxTruthy((ft == "set")) ? (function() {
|
||||
})()], ["set", (function() {
|
||||
var name = get(frame, "name");
|
||||
var fenv = get(frame, "env");
|
||||
envSet(fenv, name, value);
|
||||
return makeCekValue(value, env, restK);
|
||||
})() : (isSxTruthy((ft == "and")) ? (isSxTruthy(!isSxTruthy(value)) ? makeCekValue(value, env, restK) : (function() {
|
||||
})()], ["and", (isSxTruthy(!isSxTruthy(value)) ? makeCekValue(value, env, restK) : (function() {
|
||||
var remaining = get(frame, "remaining");
|
||||
return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, env, restK) : makeCekState(first(remaining), get(frame, "env"), (isSxTruthy((len(remaining) == 1)) ? restK : kontPush(makeAndFrame(rest(remaining), get(frame, "env")), restK))));
|
||||
})()) : (isSxTruthy((ft == "or")) ? (isSxTruthy(value) ? makeCekValue(value, env, restK) : (function() {
|
||||
})())], ["or", (isSxTruthy(value) ? makeCekValue(value, env, restK) : (function() {
|
||||
var remaining = get(frame, "remaining");
|
||||
return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(false, env, restK) : makeCekState(first(remaining), get(frame, "env"), (isSxTruthy((len(remaining) == 1)) ? restK : kontPush(makeOrFrame(rest(remaining), get(frame, "env")), restK))));
|
||||
})()) : (isSxTruthy((ft == "cond")) ? (function() {
|
||||
})())], ["cond", (function() {
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
var scheme_p = get(frame, "scheme");
|
||||
@@ -1910,18 +2055,18 @@ PRIMITIVES["step-ho-for-each"] = stepHoForEach;
|
||||
return (isSxTruthy(isElseClause(nextTest)) ? makeCekState(nth(nextClause, 1), fenv, restK) : makeCekState(nextTest, fenv, kontPush(makeCondFrame(nextClauses, fenv, true), restK)));
|
||||
})());
|
||||
})()) : (isSxTruthy(value) ? makeCekState(nth(remaining, 1), fenv, restK) : (function() {
|
||||
var next = slice(remaining, 2);
|
||||
var next = slice(remaining, 2, len(remaining));
|
||||
return (isSxTruthy((len(next) < 2)) ? makeCekValue(NIL, fenv, restK) : (function() {
|
||||
var nextTest = first(next);
|
||||
return (isSxTruthy(isElseClause(nextTest)) ? makeCekState(nth(next, 1), fenv, restK) : makeCekState(nextTest, fenv, kontPush(makeCondFrame(next, fenv, false), restK)));
|
||||
})());
|
||||
})()));
|
||||
})() : (isSxTruthy((ft == "case")) ? (function() {
|
||||
})()], ["case", (function() {
|
||||
var matchVal = get(frame, "match-val");
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(isNil(matchVal)) ? sfCaseStepLoop(value, remaining, fenv, restK) : sfCaseStepLoop(matchVal, remaining, fenv, restK));
|
||||
})() : (isSxTruthy((ft == "thread")) ? (function() {
|
||||
})()], ["thread", (function() {
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : (function() {
|
||||
@@ -1929,19 +2074,11 @@ PRIMITIVES["step-ho-for-each"] = stepHoForEach;
|
||||
var restForms = rest(remaining);
|
||||
var newKont = (isSxTruthy(isEmpty(rest(remaining))) ? restK : kontPush(makeThreadFrame(rest(remaining), fenv), restK));
|
||||
return (isSxTruthy((isSxTruthy((typeOf(form) == "list")) && isSxTruthy(!isSxTruthy(isEmpty(form))) && isSxTruthy((typeOf(first(form)) == "symbol")) && hoFormName_p(symbolName(first(form))))) ? makeCekState(cons(first(form), cons([new Symbol("quote"), value], rest(form))), fenv, newKont) : (function() {
|
||||
var result = (isSxTruthy((typeOf(form) == "list")) ? (function() {
|
||||
var f = trampoline(evalExpr(first(form), fenv));
|
||||
var rargs = map(function(a) { return trampoline(evalExpr(a, fenv)); }, rest(form));
|
||||
var allArgs = cons(value, rargs);
|
||||
return (isSxTruthy((isSxTruthy(isCallable(f)) && !isSxTruthy(isLambda(f)))) ? apply(f, allArgs) : (isSxTruthy(isLambda(f)) ? trampoline(callLambda(f, allArgs, fenv)) : error((String("-> form not callable: ") + String(inspect(f))))));
|
||||
})() : (function() {
|
||||
var f = trampoline(evalExpr(form, fenv));
|
||||
return (isSxTruthy((isSxTruthy(isCallable(f)) && !isSxTruthy(isLambda(f)))) ? f(value) : (isSxTruthy(isLambda(f)) ? trampoline(callLambda(f, [value], fenv)) : error((String("-> form not callable: ") + String(inspect(f))))));
|
||||
})());
|
||||
var result = threadInsertArg(form, value, fenv);
|
||||
return (isSxTruthy(isEmpty(restForms)) ? makeCekValue(result, fenv, restK) : makeCekValue(result, fenv, kontPush(makeThreadFrame(restForms, fenv), restK)));
|
||||
})());
|
||||
})());
|
||||
})() : (isSxTruthy((ft == "arg")) ? (function() {
|
||||
})()], ["arg", (function() {
|
||||
var f = get(frame, "f");
|
||||
var evaled = get(frame, "evaled");
|
||||
var remaining = get(frame, "remaining");
|
||||
@@ -1952,7 +2089,7 @@ PRIMITIVES["step-ho-for-each"] = stepHoForEach;
|
||||
var newEvaled = append(evaled, [value]);
|
||||
return (isSxTruthy(isEmpty(remaining)) ? ((isSxTruthy((isSxTruthy(_strict_) && hname)) ? strictCheckArgs(hname, newEvaled) : NIL), continueWithCall(f, newEvaled, fenv, rawArgs, restK)) : makeCekState(first(remaining), fenv, kontPush(makeArgFrame(f, newEvaled, rest(remaining), fenv, rawArgs, hname), restK)));
|
||||
})());
|
||||
})() : (isSxTruthy((ft == "dict")) ? (function() {
|
||||
})()], ["dict", (function() {
|
||||
var remaining = get(frame, "remaining");
|
||||
var results = get(frame, "results");
|
||||
var fenv = get(frame, "env");
|
||||
@@ -1968,48 +2105,48 @@ PRIMITIVES["step-ho-for-each"] = stepHoForEach;
|
||||
return makeCekState(nth(nextEntry, 1), fenv, kontPush(makeDictFrame(rest(remaining), append(completed, [[first(nextEntry)]]), fenv), restK));
|
||||
})());
|
||||
})();
|
||||
})() : (isSxTruthy((ft == "ho-setup")) ? (function() {
|
||||
})()], ["ho-setup", (function() {
|
||||
var hoType = get(frame, "ho-type");
|
||||
var remaining = get(frame, "remaining");
|
||||
var evaled = append(get(frame, "evaled"), [value]);
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(isEmpty(remaining)) ? hoSetupDispatch(hoType, evaled, fenv, restK) : makeCekState(first(remaining), fenv, kontPush(makeHoSetupFrame(hoType, rest(remaining), evaled, fenv), restK)));
|
||||
})() : (isSxTruthy((ft == "reset")) ? makeCekValue(value, env, restK) : (isSxTruthy((ft == "deref")) ? (function() {
|
||||
var val = value;
|
||||
})()], ["reset", makeCekValue(value, env, restK)], ["deref", (function() {
|
||||
var val = get(frame, "value");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(!isSxTruthy(isSignal(val))) ? makeCekValue(val, fenv, restK) : (isSxTruthy(hasReactiveResetFrame_p(restK)) ? reactiveShiftDeref(val, fenv, restK) : ((function() {
|
||||
var ctx = sxContext("sx-reactive", NIL);
|
||||
var ctx = getTrackingContext();
|
||||
return (isSxTruthy(ctx) ? (function() {
|
||||
var depList = get(ctx, "deps");
|
||||
var notifyFn = get(ctx, "notify");
|
||||
return (isSxTruthy(!isSxTruthy(contains(depList, val))) ? (append_b(depList, val), signalAddSub(val, notifyFn)) : NIL);
|
||||
})() : NIL);
|
||||
})(), makeCekValue(signalValue(val), fenv, restK))));
|
||||
})() : (isSxTruthy((ft == "reactive-reset")) ? (function() {
|
||||
})()], ["reactive-reset", (function() {
|
||||
var updateFn = get(frame, "update-fn");
|
||||
var first_p = get(frame, "first-render");
|
||||
if (isSxTruthy((isSxTruthy(updateFn) && !isSxTruthy(first_p)))) {
|
||||
cekCall(updateFn, [value]);
|
||||
}
|
||||
return makeCekValue(value, env, restK);
|
||||
})() : (isSxTruthy((ft == "scope")) ? (function() {
|
||||
})()], ["scope", (function() {
|
||||
var name = get(frame, "name");
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(isEmpty(remaining)) ? (scopePop(name), makeCekValue(value, fenv, restK)) : makeCekState(first(remaining), fenv, kontPush(makeScopeFrame(name, rest(remaining), fenv), restK)));
|
||||
})() : (isSxTruthy((ft == "provide")) ? (function() {
|
||||
})()], ["provide", (function() {
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : makeCekState(first(remaining), fenv, kontPush(makeProvideFrame(get(frame, "name"), get(frame, "value"), rest(remaining), fenv), restK)));
|
||||
})() : (isSxTruthy((ft == "scope-acc")) ? (function() {
|
||||
})()], ["scope-acc", (function() {
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : makeCekState(first(remaining), fenv, kontPush((function() {
|
||||
var newFrame = makeScopeAccFrame(get(frame, "name"), get(frame, "value"), rest(remaining), fenv);
|
||||
var newFrame = makeScopeAccFrame(get(frame, "name"), rest(remaining), fenv);
|
||||
newFrame["emitted"] = get(frame, "emitted");
|
||||
return newFrame;
|
||||
})(), restK)));
|
||||
})() : (isSxTruthy((ft == "map")) ? (function() {
|
||||
})()], ["map", (function() {
|
||||
var f = get(frame, "f");
|
||||
var remaining = get(frame, "remaining");
|
||||
var results = get(frame, "results");
|
||||
@@ -2023,7 +2160,7 @@ PRIMITIVES["step-ho-for-each"] = stepHoForEach;
|
||||
return continueWithCall(f, callArgs, fenv, [], kontPush(nextFrame, restK));
|
||||
})());
|
||||
})();
|
||||
})() : (isSxTruthy((ft == "filter")) ? (function() {
|
||||
})()], ["filter", (function() {
|
||||
var f = get(frame, "f");
|
||||
var remaining = get(frame, "remaining");
|
||||
var results = get(frame, "results");
|
||||
@@ -2033,27 +2170,34 @@ PRIMITIVES["step-ho-for-each"] = stepHoForEach;
|
||||
var newResults = (isSxTruthy(value) ? append(results, [currentItem]) : results);
|
||||
return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(newResults, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeFilterFrame(f, rest(remaining), newResults, first(remaining), fenv), restK)));
|
||||
})();
|
||||
})() : (isSxTruthy((ft == "reduce")) ? (function() {
|
||||
})()], ["reduce", (function() {
|
||||
var f = get(frame, "f");
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : continueWithCall(f, [value, first(remaining)], fenv, [], kontPush(makeReduceFrame(f, rest(remaining), fenv), restK)));
|
||||
})() : (isSxTruthy((ft == "for-each")) ? (function() {
|
||||
})()], ["for-each", (function() {
|
||||
var f = get(frame, "f");
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(NIL, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeForEachFrame(f, rest(remaining), fenv), restK)));
|
||||
})() : (isSxTruthy((ft == "some")) ? (function() {
|
||||
})()], ["some", (function() {
|
||||
var f = get(frame, "f");
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(value) ? makeCekValue(value, fenv, restK) : (isSxTruthy(isEmpty(remaining)) ? makeCekValue(false, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeSomeFrame(f, rest(remaining), fenv), restK))));
|
||||
})() : (isSxTruthy((ft == "every")) ? (function() {
|
||||
})()], ["every", (function() {
|
||||
var f = get(frame, "f");
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(!isSxTruthy(value)) ? makeCekValue(false, fenv, restK) : (isSxTruthy(isEmpty(remaining)) ? makeCekValue(true, fenv, restK) : continueWithCall(f, [first(remaining)], fenv, [], kontPush(makeEveryFrame(f, rest(remaining), fenv), restK))));
|
||||
})() : (isSxTruthy((ft == "comp-trace")) ? makeCekValue(value, env, restK) : error((String("Unknown frame type: ") + String(ft))))))))))))))))))))))))))))));
|
||||
})()], ["handler", (function() {
|
||||
var remaining = get(frame, "remaining");
|
||||
var fenv = get(frame, "env");
|
||||
return (isSxTruthy(isEmpty(remaining)) ? makeCekValue(value, fenv, restK) : makeCekState(first(remaining), fenv, kontPush(makeHandlerFrame(get(frame, "f"), rest(remaining), fenv), restK)));
|
||||
})()], ["restart", makeCekValue(value, env, restK)], ["signal-return", (function() {
|
||||
var savedKont = get(frame, "saved-kont");
|
||||
return makeCekValue(value, get(frame, "env"), savedKont);
|
||||
})()], ["comp-trace", makeCekValue(value, env, restK)], _(error((String("Unknown frame type: ") + String(ft)))));
|
||||
})());
|
||||
})(); };
|
||||
PRIMITIVES["step-continue"] = stepContinue;
|
||||
@@ -2082,7 +2226,7 @@ PRIMITIVES["step-continue"] = stepContinue;
|
||||
if (isSxTruthy(componentHasChildren(f))) {
|
||||
envBind(local, "children", children);
|
||||
}
|
||||
return makeCekState(componentBody(f), local, kontPush(makeCompTraceFrame(componentName(f), NIL), kont));
|
||||
return makeCekState(componentBody(f), local, kontPush(makeCompTraceFrame(componentName(f), componentFile(f)), kont));
|
||||
})() : error((String("Not callable: ") + String(inspect(f)))))))); };
|
||||
PRIMITIVES["continue-with-call"] = continueWithCall;
|
||||
|
||||
@@ -2897,7 +3041,7 @@ PRIMITIVES["render-html-marsh"] = renderHtmlMarsh;
|
||||
envBind(local, "children", makeRawHtml(join("", map(function(c) { return renderToHtml(c, env); }, children))));
|
||||
}
|
||||
return (function() {
|
||||
var bodyHtml = cekTry(function() { return renderToHtml(componentBody(island), local); }, function(err) { return ""; });
|
||||
var bodyHtml = renderToHtml(componentBody(island), local);
|
||||
var stateSx = serializeIslandState(kwargs);
|
||||
return (String("<span data-sx-island=\"") + String(escapeAttr(islandName)) + String("\"") + String((isSxTruthy(stateSx) ? (String(" data-sx-state=\"") + String(escapeAttr(stateSx)) + String("\"")) : "")) + String(">") + String(bodyHtml) + String("</span>"));
|
||||
})();
|
||||
@@ -3713,7 +3857,20 @@ PRIMITIVES["render-to-dom"] = renderToDom;
|
||||
return (isSxTruthy((name == "raw!")) ? renderDomRaw(args, env) : (isSxTruthy((name == "<>")) ? renderDomFragment(args, env, ns) : (isSxTruthy((name == "lake")) ? renderDomLake(args, env, ns) : (isSxTruthy((name == "marsh")) ? renderDomMarsh(args, env, ns) : (isSxTruthy(startsWith(name, "html:")) ? renderDomElement(slice(name, 5), args, env, ns) : (isSxTruthy(isRenderDomForm(name)) ? (isSxTruthy((isSxTruthy(contains(HTML_TAGS, name)) && sxOr((isSxTruthy((len(args) > 0)) && (typeOf(first(args)) == "keyword")), ns))) ? renderDomElement(name, args, env, ns) : dispatchRenderForm(name, expr, env, ns)) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? renderToDom(expandMacro(envGet(env, name), args, env), env, ns) : (isSxTruthy(contains(HTML_TAGS, name)) ? renderDomElement(name, args, env, ns) : (isSxTruthy((isSxTruthy(startsWith(name, "~")) && isSxTruthy(envHas(env, name)) && isIsland(envGet(env, name)))) ? (isSxTruthy(scopePeek("sx-render-markers")) ? (function() {
|
||||
var island = envGet(env, name);
|
||||
var marker = domCreateElement("span", NIL);
|
||||
var kwState = {};
|
||||
reduce(function(state, arg) { return (function() {
|
||||
var skip = get(state, "skip");
|
||||
return (isSxTruthy(skip) ? assoc(state, "skip", false, "i", (get(state, "i") + 1)) : (isSxTruthy((isSxTruthy((typeOf(arg) == "keyword")) && ((get(state, "i") + 1) < len(args)))) ? (function() {
|
||||
var kname = keywordName(arg);
|
||||
var kval = trampoline(evalExpr(nth(args, (get(state, "i") + 1)), env));
|
||||
kwState[kname] = kval;
|
||||
return assoc(state, "skip", true, "i", (get(state, "i") + 1));
|
||||
})() : assoc(state, "i", (get(state, "i") + 1))));
|
||||
})(); }, {["i"]: 0, ["skip"]: false}, args);
|
||||
domSetAttr(marker, "data-sx-island", componentName(island));
|
||||
if (isSxTruthy(!isSxTruthy(isEmptyDict(kwState)))) {
|
||||
domSetAttr(marker, "data-sx-state", sxSerialize(kwState));
|
||||
}
|
||||
return marker;
|
||||
})() : renderDomIsland(envGet(env, name), args, env, ns)) : (isSxTruthy(startsWith(name, "~")) ? (function() {
|
||||
var comp = envGet(env, name);
|
||||
@@ -4074,6 +4231,9 @@ PRIMITIVES["render-lambda-dom"] = renderLambdaDom;
|
||||
var container = domCreateElement("span", NIL);
|
||||
var disposers = [];
|
||||
domSetAttr(container, "data-sx-island", islandName);
|
||||
if (isSxTruthy(!isSxTruthy(isEmptyDict(kwargs)))) {
|
||||
domSetAttr(container, "data-sx-state", sxSerialize(kwargs));
|
||||
}
|
||||
markProcessed(container, "island-hydrated");
|
||||
return (function() {
|
||||
var bodyDom = withIslandScope(function(disposable) { return append_b(disposers, disposable); }, function() { return renderToDom(componentBody(island), local, ns); });
|
||||
@@ -4875,7 +5035,7 @@ return processElements(t); });
|
||||
disposeIslandsIn(target);
|
||||
return withTransition(useTransition, function() { return (function() {
|
||||
var swapResult = swapDomNodes(target, content, swapStyle);
|
||||
return postSwap(sxOr(swapResult, target));
|
||||
return postSwap((isSxTruthy((swapStyle == "outerHTML")) ? domParent(sxOr(swapResult, target)) : sxOr(swapResult, target)));
|
||||
})(); });
|
||||
})();
|
||||
})() : NIL);
|
||||
@@ -4892,8 +5052,11 @@ PRIMITIVES["handle-sx-response"] = handleSxResponse;
|
||||
disposeIslandsIn(target);
|
||||
return (isSxTruthy(selectSel) ? (function() {
|
||||
var html = selectHtmlFromDoc(doc, selectSel);
|
||||
return withTransition(useTransition, function() { swapHtmlString(target, html, swapStyle);
|
||||
return postSwap(target); });
|
||||
return withTransition(useTransition, function() { return (function() {
|
||||
var swapRoot = swapHtmlString(target, html, swapStyle);
|
||||
logInfo((String("swap-root: ") + String((isSxTruthy(swapRoot) ? domTagName(swapRoot) : "nil")) + String(" target: ") + String(domTagName(target))));
|
||||
return postSwap(sxOr(swapRoot, target));
|
||||
})(); });
|
||||
})() : (function() {
|
||||
var container = domCreateElement("div", NIL);
|
||||
domSetInnerHtml(container, domBodyInnerHtml(doc));
|
||||
@@ -5684,7 +5847,7 @@ return cekCall(hook, NIL); }, _postRenderHooks_); };
|
||||
PRIMITIVES["run-post-render-hooks"] = runPostRenderHooks;
|
||||
|
||||
// boot-init
|
||||
var bootInit = function() { return (logInfo((String("sx-browser ") + String(SX_VERSION))), initCssTracking(), processPageScripts(), processSxScripts(NIL), sxHydrateElements(NIL), sxHydrateIslands(NIL), runPostRenderHooks(), processElements(NIL), domListen(domWindow(), "popstate", function(e) { return handlePopstate(0); })); };
|
||||
var bootInit = function() { return (logInfo((String("sx-browser ") + String(SX_VERSION))), initCssTracking(), processPageScripts(), processSxScripts(NIL), sxHydrateElements(NIL), sxHydrateIslands(NIL), runPostRenderHooks(), processElements(NIL), domListen(domWindow(), "popstate", function(e) { return handlePopstate(0); }), domSetAttr(hostGet(domDocument(), "documentElement"), "data-sx-ready", "true"), domDispatch(domDocument(), "sx:ready", NIL), logInfo("sx:ready")); };
|
||||
PRIMITIVES["boot-init"] = bootInit;
|
||||
|
||||
|
||||
|
||||
@@ -228,38 +228,58 @@
|
||||
}
|
||||
|
||||
/**
|
||||
* Try loading a pre-compiled .sxbc.json bytecode module.
|
||||
* Try loading a pre-compiled bytecode module.
|
||||
* Tries .sxbc.json first, then .sxbc (SX s-expression format).
|
||||
* Returns true on success, null on failure (caller falls back to .sx source).
|
||||
*/
|
||||
function loadBytecodeFile(path) {
|
||||
var bcPath = path.replace(/\.sx$/, '.sxbc.json');
|
||||
var url = _baseUrl + bcPath + _cacheBust;
|
||||
// Try .sxbc.json (JSON dict format)
|
||||
var jsonPath = path.replace(/\.sx$/, '.sxbc.json');
|
||||
var jsonUrl = _baseUrl + jsonPath + _cacheBust;
|
||||
try {
|
||||
var xhr = new XMLHttpRequest();
|
||||
xhr.open("GET", url, false);
|
||||
xhr.open("GET", jsonUrl, false);
|
||||
xhr.send();
|
||||
if (xhr.status !== 200) return null;
|
||||
|
||||
var json = JSON.parse(xhr.responseText);
|
||||
if (!json.module || json.magic !== 'SXBC') return null;
|
||||
|
||||
var module = {
|
||||
_type: 'dict',
|
||||
arity: json.module.arity || 0,
|
||||
bytecode: { _type: 'list', items: json.module.bytecode },
|
||||
constants: { _type: 'list', items: json.module.constants.map(deserializeConstant) },
|
||||
};
|
||||
|
||||
var result = K.loadModule(module);
|
||||
if (typeof result === 'string' && result.indexOf('Error') === 0) {
|
||||
console.warn("[sx-platform] bytecode FAIL " + path + ":", result);
|
||||
return null;
|
||||
if (xhr.status === 200) {
|
||||
var json = JSON.parse(xhr.responseText);
|
||||
if (json.module && json.magic === 'SXBC') {
|
||||
var module = {
|
||||
_type: 'dict',
|
||||
arity: json.module.arity || 0,
|
||||
bytecode: { _type: 'list', items: json.module.bytecode },
|
||||
constants: { _type: 'list', items: json.module.constants.map(deserializeConstant) },
|
||||
};
|
||||
var result = K.loadModule(module);
|
||||
if (typeof result !== 'string' || result.indexOf('Error') !== 0) {
|
||||
console.log("[sx-platform] ok " + path + " (bytecode-json)");
|
||||
return true;
|
||||
}
|
||||
console.warn("[sx-platform] bytecode-json FAIL " + path + ":", result);
|
||||
}
|
||||
}
|
||||
console.log("[sx-platform] ok " + path + " (bytecode)");
|
||||
return true;
|
||||
} catch(e) {
|
||||
return null;
|
||||
}
|
||||
} catch(e) { /* fall through to .sxbc */ }
|
||||
|
||||
// Try .sxbc (SX s-expression format, loaded via load-sxbc primitive)
|
||||
var sxbcPath = path.replace(/\.sx$/, '.sxbc');
|
||||
var sxbcUrl = _baseUrl + sxbcPath + _cacheBust;
|
||||
try {
|
||||
var xhr2 = new XMLHttpRequest();
|
||||
xhr2.open("GET", sxbcUrl, false);
|
||||
xhr2.send();
|
||||
if (xhr2.status === 200) {
|
||||
// Store text in global, parse via SX to avoid JS string escaping
|
||||
window.__sxbcText = xhr2.responseText;
|
||||
var result2 = K.eval('(load-sxbc (first (parse (host-global "__sxbcText"))))');
|
||||
delete window.__sxbcText;
|
||||
if (typeof result2 !== 'string' || result2.indexOf('Error') !== 0) {
|
||||
console.log("[sx-platform] ok " + path + " (bytecode-sx)");
|
||||
return true;
|
||||
}
|
||||
console.warn("[sx-platform] bytecode-sx FAIL " + path + ":", result2);
|
||||
}
|
||||
} catch(e) { delete window.__sxbcText; /* fall through to source */ }
|
||||
|
||||
return null;
|
||||
}
|
||||
|
||||
/**
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1,25 +1,554 @@
|
||||
(define render-to-html :effects (render) (fn (expr (env :as dict)) (set-render-active! true) (case (type-of expr) "nil" "" "string" (escape-html expr) "number" (str expr) "boolean" (if expr "true" "false") "list" (if (empty? expr) "" (render-list-to-html expr env)) "symbol" (render-value-to-html (trampoline (eval-expr expr env)) env) "keyword" (escape-html (keyword-name expr)) "raw-html" (raw-html-content expr) "spread" (do (scope-emit! "element-attrs" (spread-attrs expr)) "") "thunk" (render-to-html (thunk-expr expr) (thunk-env expr)) :else (render-value-to-html (trampoline (eval-expr expr env)) env))))
|
||||
(define
|
||||
render-to-html
|
||||
:effects (render)
|
||||
(fn
|
||||
(expr (env :as dict))
|
||||
(set-render-active! true)
|
||||
(case
|
||||
(type-of expr)
|
||||
"nil"
|
||||
""
|
||||
"string"
|
||||
(escape-html expr)
|
||||
"number"
|
||||
(str expr)
|
||||
"boolean"
|
||||
(if expr "true" "false")
|
||||
"list"
|
||||
(if (empty? expr) "" (render-list-to-html expr env))
|
||||
"symbol"
|
||||
(render-value-to-html (trampoline (eval-expr expr env)) env)
|
||||
"keyword"
|
||||
(escape-html (keyword-name expr))
|
||||
"raw-html"
|
||||
(raw-html-content expr)
|
||||
"spread"
|
||||
(do (scope-emit! "element-attrs" (spread-attrs expr)) "")
|
||||
"thunk"
|
||||
(render-to-html (thunk-expr expr) (thunk-env expr))
|
||||
:else (render-value-to-html (trampoline (eval-expr expr env)) env))))
|
||||
|
||||
(define render-value-to-html :effects (render) (fn (val (env :as dict)) (case (type-of val) "nil" "" "string" (escape-html val) "number" (str val) "boolean" (if val "true" "false") "list" (render-list-to-html val env) "raw-html" (raw-html-content val) "spread" (do (scope-emit! "element-attrs" (spread-attrs val)) "") "thunk" (render-to-html (thunk-expr val) (thunk-env val)) :else (escape-html (str val)))))
|
||||
(define
|
||||
render-value-to-html
|
||||
:effects (render)
|
||||
(fn
|
||||
(val (env :as dict))
|
||||
(case
|
||||
(type-of val)
|
||||
"nil"
|
||||
""
|
||||
"string"
|
||||
(escape-html val)
|
||||
"number"
|
||||
(str val)
|
||||
"boolean"
|
||||
(if val "true" "false")
|
||||
"list"
|
||||
(render-list-to-html val env)
|
||||
"raw-html"
|
||||
(raw-html-content val)
|
||||
"spread"
|
||||
(do (scope-emit! "element-attrs" (spread-attrs val)) "")
|
||||
"thunk"
|
||||
(render-to-html (thunk-expr val) (thunk-env val))
|
||||
:else (escape-html (str val)))))
|
||||
|
||||
(define RENDER_HTML_FORMS (list "if" "when" "cond" "case" "let" "let*" "letrec" "begin" "do" "define" "defcomp" "defisland" "defmacro" "defstyle" "deftype" "defeffect" "map" "map-indexed" "filter" "for-each" "scope" "provide"))
|
||||
(define
|
||||
RENDER_HTML_FORMS
|
||||
(list
|
||||
"if"
|
||||
"when"
|
||||
"cond"
|
||||
"case"
|
||||
"let"
|
||||
"let*"
|
||||
"letrec"
|
||||
"begin"
|
||||
"do"
|
||||
"define"
|
||||
"defcomp"
|
||||
"defisland"
|
||||
"defmacro"
|
||||
"defstyle"
|
||||
"deftype"
|
||||
"defeffect"
|
||||
"map"
|
||||
"map-indexed"
|
||||
"filter"
|
||||
"for-each"
|
||||
"scope"
|
||||
"provide"))
|
||||
|
||||
(define render-html-form? :effects () (fn ((name :as string)) (contains? RENDER_HTML_FORMS name)))
|
||||
(define
|
||||
render-html-form?
|
||||
:effects ()
|
||||
(fn ((name :as string)) (contains? RENDER_HTML_FORMS name)))
|
||||
|
||||
(define render-list-to-html :effects (render) (fn ((expr :as list) (env :as dict)) (if (empty? expr) "" (let ((head (first expr))) (if (not (= (type-of head) "symbol")) (join "" (map (fn (x) (render-value-to-html x env)) expr)) (let ((name (symbol-name head)) (args (rest expr))) (cond (= name "<>") (join "" (map (fn (x) (render-to-html x env)) args)) (= name "raw!") (join "" (map (fn (x) (str (trampoline (eval-expr x env)))) args)) (= name "lake") (render-html-lake args env) (= name "marsh") (render-html-marsh args env) (or (= name "portal") (= name "error-boundary") (= name "promise-delayed")) (join "" (map (fn (x) (render-to-html x env)) args)) (contains? HTML_TAGS name) (render-html-element name args env) (and (starts-with? name "~") (env-has? env name) (island? (env-get env name))) (render-html-island (env-get env name) args env) (starts-with? name "~") (let ((val (env-get env name))) (cond (component? val) (render-html-component val args env) (macro? val) (render-to-html (expand-macro val args env) env) :else (error (str "Unknown component: " name)))) (render-html-form? name) (dispatch-html-form name expr env) (and (env-has? env name) (macro? (env-get env name))) (render-to-html (expand-macro (env-get env name) args env) env) :else (render-value-to-html (trampoline (eval-expr expr env)) env))))))))
|
||||
(define
|
||||
render-list-to-html
|
||||
:effects (render)
|
||||
(fn
|
||||
((expr :as list) (env :as dict))
|
||||
(if
|
||||
(empty? expr)
|
||||
""
|
||||
(let
|
||||
((head (first expr)))
|
||||
(if
|
||||
(not (= (type-of head) "symbol"))
|
||||
(join "" (map (fn (x) (render-value-to-html x env)) expr))
|
||||
(let
|
||||
((name (symbol-name head)) (args (rest expr)))
|
||||
(cond
|
||||
(= name "<>")
|
||||
(join "" (map (fn (x) (render-to-html x env)) args))
|
||||
(= name "raw!")
|
||||
(join
|
||||
""
|
||||
(map (fn (x) (str (trampoline (eval-expr x env)))) args))
|
||||
(= name "lake")
|
||||
(render-html-lake args env)
|
||||
(= name "marsh")
|
||||
(render-html-marsh args env)
|
||||
(or
|
||||
(= name "portal")
|
||||
(= name "error-boundary")
|
||||
(= name "promise-delayed"))
|
||||
(join "" (map (fn (x) (render-to-html x env)) args))
|
||||
(contains? HTML_TAGS name)
|
||||
(render-html-element name args env)
|
||||
(and
|
||||
(starts-with? name "~")
|
||||
(env-has? env name)
|
||||
(island? (env-get env name)))
|
||||
(render-html-island (env-get env name) args env)
|
||||
(starts-with? name "~")
|
||||
(let
|
||||
((val (env-get env name)))
|
||||
(cond
|
||||
(component? val)
|
||||
(render-html-component val args env)
|
||||
(macro? val)
|
||||
(render-to-html (expand-macro val args env) env)
|
||||
:else (str "<!-- unknown component: " name " -->")))
|
||||
(render-html-form? name)
|
||||
(dispatch-html-form name expr env)
|
||||
(and (env-has? env name) (macro? (env-get env name)))
|
||||
(render-to-html (expand-macro (env-get env name) args env) env)
|
||||
:else (render-value-to-html (trampoline (eval-expr expr env)) env))))))))
|
||||
|
||||
(define dispatch-html-form :effects (render) (fn ((name :as string) (expr :as list) (env :as dict)) (cond (= name "if") (let ((cond-val (trampoline (eval-expr (nth expr 1) env)))) (if cond-val (render-to-html (nth expr 2) env) (if (> (len expr) 3) (render-to-html (nth expr 3) env) ""))) (= name "when") (if (not (trampoline (eval-expr (nth expr 1) env))) "" (if (= (len expr) 3) (render-to-html (nth expr 2) env) (join "" (map (fn (i) (render-to-html (nth expr i) env)) (range 2 (len expr)))))) (= name "cond") (let ((branch (eval-cond (rest expr) env))) (if branch (render-to-html branch env) "")) (= name "case") (render-to-html (trampoline (eval-expr expr env)) env) (= name "letrec") (let ((bindings (nth expr 1)) (body (slice expr 2)) (local (env-extend env))) (for-each (fn (pair) (let ((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair))))) (env-bind! local pname nil))) bindings) (for-each (fn (pair) (let ((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair))))) (env-set! local pname (trampoline (eval-expr (nth pair 1) local))))) bindings) (when (> (len body) 1) (for-each (fn (e) (trampoline (eval-expr e local))) (init body))) (render-to-html (last body) local)) (or (= name "let") (= name "let*")) (let ((local (process-bindings (nth expr 1) env))) (if (= (len expr) 3) (render-to-html (nth expr 2) local) (join "" (map (fn (i) (render-to-html (nth expr i) local)) (range 2 (len expr)))))) (or (= name "begin") (= name "do")) (if (= (len expr) 2) (render-to-html (nth expr 1) env) (join "" (map (fn (i) (render-to-html (nth expr i) env)) (range 1 (len expr))))) (definition-form? name) (do (trampoline (eval-expr expr env)) "") (= name "map") (let ((f (trampoline (eval-expr (nth expr 1) env))) (coll (trampoline (eval-expr (nth expr 2) env)))) (join "" (map (fn (item) (if (lambda? f) (render-lambda-html f (list item) env) (render-to-html (apply f (list item)) env))) coll))) (= name "map-indexed") (let ((f (trampoline (eval-expr (nth expr 1) env))) (coll (trampoline (eval-expr (nth expr 2) env)))) (join "" (map-indexed (fn (i item) (if (lambda? f) (render-lambda-html f (list i item) env) (render-to-html (apply f (list i item)) env))) coll))) (= name "filter") (render-to-html (trampoline (eval-expr expr env)) env) (= name "for-each") (let ((f (trampoline (eval-expr (nth expr 1) env))) (coll (trampoline (eval-expr (nth expr 2) env)))) (join "" (map (fn (item) (if (lambda? f) (render-lambda-html f (list item) env) (render-to-html (apply f (list item)) env))) coll))) (= name "scope") (let ((scope-name (trampoline (eval-expr (nth expr 1) env))) (rest-args (slice expr 2)) (scope-val nil) (body-exprs nil)) (if (and (>= (len rest-args) 2) (= (type-of (first rest-args)) "keyword") (= (keyword-name (first rest-args)) "value")) (do (set! scope-val (trampoline (eval-expr (nth rest-args 1) env))) (set! body-exprs (slice rest-args 2))) (set! body-exprs rest-args)) (scope-push! scope-name scope-val) (let ((result (if (= (len body-exprs) 1) (render-to-html (first body-exprs) env) (join "" (map (fn (e) (render-to-html e env)) body-exprs))))) (scope-pop! scope-name) result)) (= name "provide") (let ((prov-name (trampoline (eval-expr (nth expr 1) env))) (prov-val (trampoline (eval-expr (nth expr 2) env))) (body-start 3) (body-count (- (len expr) 3))) (scope-push! prov-name prov-val) (let ((result (if (= body-count 1) (render-to-html (nth expr body-start) env) (join "" (map (fn (i) (render-to-html (nth expr i) env)) (range body-start (+ body-start body-count))))))) (scope-pop! prov-name) result)) :else (render-value-to-html (trampoline (eval-expr expr env)) env))))
|
||||
(define
|
||||
dispatch-html-form
|
||||
:effects (render)
|
||||
(fn
|
||||
((name :as string) (expr :as list) (env :as dict))
|
||||
(cond
|
||||
(= name "if")
|
||||
(let
|
||||
((cond-val (trampoline (eval-expr (nth expr 1) env))))
|
||||
(if
|
||||
cond-val
|
||||
(render-to-html (nth expr 2) env)
|
||||
(if (> (len expr) 3) (render-to-html (nth expr 3) env) "")))
|
||||
(= name "when")
|
||||
(if
|
||||
(not (trampoline (eval-expr (nth expr 1) env)))
|
||||
""
|
||||
(if
|
||||
(= (len expr) 3)
|
||||
(render-to-html (nth expr 2) env)
|
||||
(join
|
||||
""
|
||||
(map
|
||||
(fn (i) (render-to-html (nth expr i) env))
|
||||
(range 2 (len expr))))))
|
||||
(= name "cond")
|
||||
(let
|
||||
((branch (eval-cond (rest expr) env)))
|
||||
(if branch (render-to-html branch env) ""))
|
||||
(= name "case")
|
||||
(render-to-html (trampoline (eval-expr expr env)) env)
|
||||
(= name "letrec")
|
||||
(let
|
||||
((bindings (nth expr 1))
|
||||
(body (slice expr 2))
|
||||
(local (env-extend env)))
|
||||
(for-each
|
||||
(fn
|
||||
(pair)
|
||||
(let
|
||||
((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair)))))
|
||||
(env-bind! local pname nil)))
|
||||
bindings)
|
||||
(for-each
|
||||
(fn
|
||||
(pair)
|
||||
(let
|
||||
((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair)))))
|
||||
(env-set!
|
||||
local
|
||||
pname
|
||||
(trampoline (eval-expr (nth pair 1) local)))))
|
||||
bindings)
|
||||
(when
|
||||
(> (len body) 1)
|
||||
(for-each (fn (e) (trampoline (eval-expr e local))) (init body)))
|
||||
(render-to-html (last body) local))
|
||||
(or (= name "let") (= name "let*"))
|
||||
(let
|
||||
((local (process-bindings (nth expr 1) env)))
|
||||
(if
|
||||
(= (len expr) 3)
|
||||
(render-to-html (nth expr 2) local)
|
||||
(join
|
||||
""
|
||||
(map
|
||||
(fn (i) (render-to-html (nth expr i) local))
|
||||
(range 2 (len expr))))))
|
||||
(or (= name "begin") (= name "do"))
|
||||
(if
|
||||
(= (len expr) 2)
|
||||
(render-to-html (nth expr 1) env)
|
||||
(join
|
||||
""
|
||||
(map
|
||||
(fn (i) (render-to-html (nth expr i) env))
|
||||
(range 1 (len expr)))))
|
||||
(definition-form? name)
|
||||
(do (trampoline (eval-expr expr env)) "")
|
||||
(= name "map")
|
||||
(let
|
||||
((f (trampoline (eval-expr (nth expr 1) env)))
|
||||
(coll (trampoline (eval-expr (nth expr 2) env))))
|
||||
(join
|
||||
""
|
||||
(map
|
||||
(fn
|
||||
(item)
|
||||
(if
|
||||
(lambda? f)
|
||||
(render-lambda-html f (list item) env)
|
||||
(render-to-html (apply f (list item)) env)))
|
||||
coll)))
|
||||
(= name "map-indexed")
|
||||
(let
|
||||
((f (trampoline (eval-expr (nth expr 1) env)))
|
||||
(coll (trampoline (eval-expr (nth expr 2) env))))
|
||||
(join
|
||||
""
|
||||
(map-indexed
|
||||
(fn
|
||||
(i item)
|
||||
(if
|
||||
(lambda? f)
|
||||
(render-lambda-html f (list i item) env)
|
||||
(render-to-html (apply f (list i item)) env)))
|
||||
coll)))
|
||||
(= name "filter")
|
||||
(render-to-html (trampoline (eval-expr expr env)) env)
|
||||
(= name "for-each")
|
||||
(let
|
||||
((f (trampoline (eval-expr (nth expr 1) env)))
|
||||
(coll (trampoline (eval-expr (nth expr 2) env))))
|
||||
(join
|
||||
""
|
||||
(map
|
||||
(fn
|
||||
(item)
|
||||
(if
|
||||
(lambda? f)
|
||||
(render-lambda-html f (list item) env)
|
||||
(render-to-html (apply f (list item)) env)))
|
||||
coll)))
|
||||
(= name "scope")
|
||||
(let
|
||||
((scope-name (trampoline (eval-expr (nth expr 1) env)))
|
||||
(rest-args (slice expr 2))
|
||||
(scope-val nil)
|
||||
(body-exprs nil))
|
||||
(if
|
||||
(and
|
||||
(>= (len rest-args) 2)
|
||||
(= (type-of (first rest-args)) "keyword")
|
||||
(= (keyword-name (first rest-args)) "value"))
|
||||
(do
|
||||
(set! scope-val (trampoline (eval-expr (nth rest-args 1) env)))
|
||||
(set! body-exprs (slice rest-args 2)))
|
||||
(set! body-exprs rest-args))
|
||||
(scope-push! scope-name scope-val)
|
||||
(let
|
||||
((result (if (= (len body-exprs) 1) (render-to-html (first body-exprs) env) (join "" (map (fn (e) (render-to-html e env)) body-exprs)))))
|
||||
(scope-pop! scope-name)
|
||||
result))
|
||||
(= name "provide")
|
||||
(let
|
||||
((prov-name (trampoline (eval-expr (nth expr 1) env)))
|
||||
(prov-val (trampoline (eval-expr (nth expr 2) env)))
|
||||
(body-start 3)
|
||||
(body-count (- (len expr) 3)))
|
||||
(scope-push! prov-name prov-val)
|
||||
(let
|
||||
((result (if (= body-count 1) (render-to-html (nth expr body-start) env) (join "" (map (fn (i) (render-to-html (nth expr i) env)) (range body-start (+ body-start body-count)))))))
|
||||
(scope-pop! prov-name)
|
||||
result))
|
||||
:else (render-value-to-html (trampoline (eval-expr expr env)) env))))
|
||||
|
||||
(define render-lambda-html :effects (render) (fn ((f :as lambda) (args :as list) (env :as dict)) (let ((local (env-merge (lambda-closure f) env))) (for-each-indexed (fn (i p) (env-bind! local p (nth args i))) (lambda-params f)) (render-to-html (lambda-body f) local))))
|
||||
(define
|
||||
render-lambda-html
|
||||
:effects (render)
|
||||
(fn
|
||||
((f :as lambda) (args :as list) (env :as dict))
|
||||
(let
|
||||
((local (env-merge (lambda-closure f) env)))
|
||||
(for-each-indexed
|
||||
(fn (i p) (env-bind! local p (nth args i)))
|
||||
(lambda-params f))
|
||||
(render-to-html (lambda-body f) local))))
|
||||
|
||||
(define render-html-component :effects (render) (fn ((comp :as component) (args :as list) (env :as dict)) (let ((kwargs (dict)) (children (list))) (reduce (fn (state arg) (let ((skip (get state "skip"))) (if skip (assoc state "skip" false "i" (inc (get state "i"))) (if (and (= (type-of arg) "keyword") (< (inc (get state "i")) (len args))) (let ((val (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (dict-set! kwargs (keyword-name arg) val) (assoc state "skip" true "i" (inc (get state "i")))) (do (append! children arg) (assoc state "i" (inc (get state "i")))))))) (dict "i" 0 "skip" false) args) (let ((local (env-merge (component-closure comp) env))) (for-each (fn (p) (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) (component-params comp)) (when (component-has-children? comp) (env-bind! local "children" (make-raw-html (join "" (map (fn (c) (render-to-html c env)) children))))) (render-to-html (component-body comp) local)))))
|
||||
(define
|
||||
render-html-component
|
||||
:effects (render)
|
||||
(fn
|
||||
((comp :as component) (args :as list) (env :as dict))
|
||||
(let
|
||||
((kwargs (dict)) (children (list)))
|
||||
(reduce
|
||||
(fn
|
||||
(state arg)
|
||||
(let
|
||||
((skip (get state "skip")))
|
||||
(if
|
||||
skip
|
||||
(assoc state "skip" false "i" (inc (get state "i")))
|
||||
(if
|
||||
(and
|
||||
(= (type-of arg) "keyword")
|
||||
(< (inc (get state "i")) (len args)))
|
||||
(let
|
||||
((val (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
|
||||
(dict-set! kwargs (keyword-name arg) val)
|
||||
(assoc state "skip" true "i" (inc (get state "i"))))
|
||||
(do
|
||||
(append! children arg)
|
||||
(assoc state "i" (inc (get state "i"))))))))
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
(let
|
||||
((local (env-merge (component-closure comp) env)))
|
||||
(for-each
|
||||
(fn
|
||||
(p)
|
||||
(env-bind!
|
||||
local
|
||||
p
|
||||
(if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
||||
(component-params comp))
|
||||
(when
|
||||
(component-has-children? comp)
|
||||
(env-bind!
|
||||
local
|
||||
"children"
|
||||
(make-raw-html
|
||||
(join "" (map (fn (c) (render-to-html c env)) children)))))
|
||||
(render-to-html (component-body comp) local)))))
|
||||
|
||||
(define render-html-element :effects (render) (fn ((tag :as string) (args :as list) (env :as dict)) (let ((parsed (parse-element-args args env)) (attrs (first parsed)) (children (nth parsed 1)) (is-void (contains? VOID_ELEMENTS tag))) (if is-void (str "<" tag (render-attrs attrs) " />") (do (scope-push! "element-attrs" nil) (let ((content (join "" (map (fn (c) (render-to-html c env)) children)))) (for-each (fn (spread-dict) (merge-spread-attrs attrs spread-dict)) (scope-emitted "element-attrs")) (scope-pop! "element-attrs") (str "<" tag (render-attrs attrs) ">" content "</" tag ">")))))))
|
||||
(define
|
||||
render-html-element
|
||||
:effects (render)
|
||||
(fn
|
||||
((tag :as string) (args :as list) (env :as dict))
|
||||
(let
|
||||
((parsed (parse-element-args args env))
|
||||
(attrs (first parsed))
|
||||
(children (nth parsed 1))
|
||||
(is-void (contains? VOID_ELEMENTS tag)))
|
||||
(if
|
||||
is-void
|
||||
(str "<" tag (render-attrs attrs) " />")
|
||||
(do
|
||||
(scope-push! "element-attrs" nil)
|
||||
(let
|
||||
((content (join "" (map (fn (c) (render-to-html c env)) children))))
|
||||
(for-each
|
||||
(fn (spread-dict) (merge-spread-attrs attrs spread-dict))
|
||||
(scope-emitted "element-attrs"))
|
||||
(scope-pop! "element-attrs")
|
||||
(str "<" tag (render-attrs attrs) ">" content "</" tag ">")))))))
|
||||
|
||||
(define render-html-lake :effects (render) (fn ((args :as list) (env :as dict)) (let ((lake-id nil) (lake-tag "div") (children (list))) (reduce (fn (state arg) (let ((skip (get state "skip"))) (if skip (assoc state "skip" false "i" (inc (get state "i"))) (if (and (= (type-of arg) "keyword") (< (inc (get state "i")) (len args))) (let ((kname (keyword-name arg)) (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (cond (= kname "id") (set! lake-id kval) (= kname "tag") (set! lake-tag kval)) (assoc state "skip" true "i" (inc (get state "i")))) (do (append! children arg) (assoc state "i" (inc (get state "i")))))))) (dict "i" 0 "skip" false) args) (let ((lake-attrs (dict "data-sx-lake" (or lake-id "")))) (scope-push! "element-attrs" nil) (let ((content (join "" (map (fn (c) (render-to-html c env)) children)))) (for-each (fn (spread-dict) (merge-spread-attrs lake-attrs spread-dict)) (scope-emitted "element-attrs")) (scope-pop! "element-attrs") (str "<" lake-tag (render-attrs lake-attrs) ">" content "</" lake-tag ">"))))))
|
||||
(define
|
||||
render-html-lake
|
||||
:effects (render)
|
||||
(fn
|
||||
((args :as list) (env :as dict))
|
||||
(let
|
||||
((lake-id nil) (lake-tag "div") (children (list)))
|
||||
(reduce
|
||||
(fn
|
||||
(state arg)
|
||||
(let
|
||||
((skip (get state "skip")))
|
||||
(if
|
||||
skip
|
||||
(assoc state "skip" false "i" (inc (get state "i")))
|
||||
(if
|
||||
(and
|
||||
(= (type-of arg) "keyword")
|
||||
(< (inc (get state "i")) (len args)))
|
||||
(let
|
||||
((kname (keyword-name arg))
|
||||
(kval
|
||||
(trampoline
|
||||
(eval-expr (nth args (inc (get state "i"))) env))))
|
||||
(cond
|
||||
(= kname "id")
|
||||
(set! lake-id kval)
|
||||
(= kname "tag")
|
||||
(set! lake-tag kval))
|
||||
(assoc state "skip" true "i" (inc (get state "i"))))
|
||||
(do
|
||||
(append! children arg)
|
||||
(assoc state "i" (inc (get state "i"))))))))
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
(let
|
||||
((lake-attrs (dict "data-sx-lake" (or lake-id ""))))
|
||||
(scope-push! "element-attrs" nil)
|
||||
(let
|
||||
((content (join "" (map (fn (c) (render-to-html c env)) children))))
|
||||
(for-each
|
||||
(fn (spread-dict) (merge-spread-attrs lake-attrs spread-dict))
|
||||
(scope-emitted "element-attrs"))
|
||||
(scope-pop! "element-attrs")
|
||||
(str
|
||||
"<"
|
||||
lake-tag
|
||||
(render-attrs lake-attrs)
|
||||
">"
|
||||
content
|
||||
"</"
|
||||
lake-tag
|
||||
">"))))))
|
||||
|
||||
(define render-html-marsh :effects (render) (fn ((args :as list) (env :as dict)) (let ((marsh-id nil) (marsh-tag "div") (children (list))) (reduce (fn (state arg) (let ((skip (get state "skip"))) (if skip (assoc state "skip" false "i" (inc (get state "i"))) (if (and (= (type-of arg) "keyword") (< (inc (get state "i")) (len args))) (let ((kname (keyword-name arg)) (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (cond (= kname "id") (set! marsh-id kval) (= kname "tag") (set! marsh-tag kval) (= kname "transform") nil) (assoc state "skip" true "i" (inc (get state "i")))) (do (append! children arg) (assoc state "i" (inc (get state "i")))))))) (dict "i" 0 "skip" false) args) (let ((marsh-attrs (dict "data-sx-marsh" (or marsh-id "")))) (scope-push! "element-attrs" nil) (let ((content (join "" (map (fn (c) (render-to-html c env)) children)))) (for-each (fn (spread-dict) (merge-spread-attrs marsh-attrs spread-dict)) (scope-emitted "element-attrs")) (scope-pop! "element-attrs") (str "<" marsh-tag (render-attrs marsh-attrs) ">" content "</" marsh-tag ">"))))))
|
||||
(define
|
||||
render-html-marsh
|
||||
:effects (render)
|
||||
(fn
|
||||
((args :as list) (env :as dict))
|
||||
(let
|
||||
((marsh-id nil) (marsh-tag "div") (children (list)))
|
||||
(reduce
|
||||
(fn
|
||||
(state arg)
|
||||
(let
|
||||
((skip (get state "skip")))
|
||||
(if
|
||||
skip
|
||||
(assoc state "skip" false "i" (inc (get state "i")))
|
||||
(if
|
||||
(and
|
||||
(= (type-of arg) "keyword")
|
||||
(< (inc (get state "i")) (len args)))
|
||||
(let
|
||||
((kname (keyword-name arg))
|
||||
(kval
|
||||
(trampoline
|
||||
(eval-expr (nth args (inc (get state "i"))) env))))
|
||||
(cond
|
||||
(= kname "id")
|
||||
(set! marsh-id kval)
|
||||
(= kname "tag")
|
||||
(set! marsh-tag kval)
|
||||
(= kname "transform")
|
||||
nil)
|
||||
(assoc state "skip" true "i" (inc (get state "i"))))
|
||||
(do
|
||||
(append! children arg)
|
||||
(assoc state "i" (inc (get state "i"))))))))
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
(let
|
||||
((marsh-attrs (dict "data-sx-marsh" (or marsh-id ""))))
|
||||
(scope-push! "element-attrs" nil)
|
||||
(let
|
||||
((content (join "" (map (fn (c) (render-to-html c env)) children))))
|
||||
(for-each
|
||||
(fn (spread-dict) (merge-spread-attrs marsh-attrs spread-dict))
|
||||
(scope-emitted "element-attrs"))
|
||||
(scope-pop! "element-attrs")
|
||||
(str
|
||||
"<"
|
||||
marsh-tag
|
||||
(render-attrs marsh-attrs)
|
||||
">"
|
||||
content
|
||||
"</"
|
||||
marsh-tag
|
||||
">"))))))
|
||||
|
||||
(define render-html-island :effects (render) (fn ((island :as island) (args :as list) (env :as dict)) (let ((kwargs (dict)) (children (list))) (reduce (fn (state arg) (let ((skip (get state "skip"))) (if skip (assoc state "skip" false "i" (inc (get state "i"))) (if (and (= (type-of arg) "keyword") (< (inc (get state "i")) (len args))) (let ((val (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (dict-set! kwargs (keyword-name arg) val) (assoc state "skip" true "i" (inc (get state "i")))) (do (append! children arg) (assoc state "i" (inc (get state "i")))))))) (dict "i" 0 "skip" false) args) (let ((local (env-merge (component-closure island) env)) (island-name (component-name island))) (for-each (fn (p) (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) (component-params island)) (when (component-has-children? island) (env-bind! local "children" (make-raw-html (join "" (map (fn (c) (render-to-html c env)) children))))) (let ((body-html (cek-try (fn () (render-to-html (component-body island) local)) (fn (err) ""))) (state-sx (serialize-island-state kwargs))) (str "<span data-sx-island=\"" (escape-attr island-name) "\"" (if state-sx (str " data-sx-state=\"" (escape-attr state-sx) "\"") "") ">" body-html "</span>"))))))
|
||||
(define
|
||||
render-html-island
|
||||
:effects (render)
|
||||
(fn
|
||||
((island :as island) (args :as list) (env :as dict))
|
||||
(let
|
||||
((kwargs (dict)) (children (list)))
|
||||
(reduce
|
||||
(fn
|
||||
(state arg)
|
||||
(let
|
||||
((skip (get state "skip")))
|
||||
(if
|
||||
skip
|
||||
(assoc state "skip" false "i" (inc (get state "i")))
|
||||
(if
|
||||
(and
|
||||
(= (type-of arg) "keyword")
|
||||
(< (inc (get state "i")) (len args)))
|
||||
(let
|
||||
((val (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
|
||||
(dict-set! kwargs (keyword-name arg) val)
|
||||
(assoc state "skip" true "i" (inc (get state "i"))))
|
||||
(do
|
||||
(append! children arg)
|
||||
(assoc state "i" (inc (get state "i"))))))))
|
||||
(dict "i" 0 "skip" false)
|
||||
args)
|
||||
(let
|
||||
((local (env-merge (component-closure island) env))
|
||||
(island-name (component-name island)))
|
||||
(for-each
|
||||
(fn
|
||||
(p)
|
||||
(env-bind!
|
||||
local
|
||||
p
|
||||
(if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
||||
(component-params island))
|
||||
(when
|
||||
(component-has-children? island)
|
||||
(env-bind!
|
||||
local
|
||||
"children"
|
||||
(make-raw-html
|
||||
(join "" (map (fn (c) (render-to-html c env)) children)))))
|
||||
(let
|
||||
((body-html (render-to-html (component-body island) local))
|
||||
(state-sx (serialize-island-state kwargs)))
|
||||
(str
|
||||
"<span data-sx-island=\""
|
||||
(escape-attr island-name)
|
||||
"\""
|
||||
(if
|
||||
state-sx
|
||||
(str " data-sx-state=\"" (escape-attr state-sx) "\"")
|
||||
"")
|
||||
">"
|
||||
body-html
|
||||
"</span>"))))))
|
||||
|
||||
(define serialize-island-state :effects () (fn ((kwargs :as dict)) (if (empty-dict? kwargs) nil (sx-serialize kwargs))))
|
||||
(define
|
||||
serialize-island-state
|
||||
:effects ()
|
||||
(fn
|
||||
((kwargs :as dict))
|
||||
(if (empty-dict? kwargs) nil (sx-serialize kwargs))))
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -270,6 +270,7 @@
|
||||
(= name "defisland") (compile-defcomp em args scope)
|
||||
(= name "quasiquote") (compile-quasiquote em (first args) scope)
|
||||
(= name "letrec") (compile-letrec em args scope tail?)
|
||||
(= name "match") (compile-match em args scope tail?)
|
||||
;; Default — function call
|
||||
:else
|
||||
(compile-call em head args scope tail?)))))))
|
||||
@@ -634,6 +635,75 @@
|
||||
(patch-i16 em end-jump (- (current-offset em) (+ end-jump 2)))))))))))
|
||||
|
||||
|
||||
|
||||
;; compile-match — compile (match expr (pattern body) ...) to bytecode.
|
||||
;; Self-contained via letrec so JIT can find the recursive helper.
|
||||
(define compile-match
|
||||
(fn (em args scope tail?)
|
||||
(compile-expr em (first args) scope false)
|
||||
(letrec
|
||||
((do-clauses (fn (clauses)
|
||||
(if (empty? clauses)
|
||||
(do (emit-op em 5)
|
||||
(let ((idx (pool-add (get em "pool") "match: no clause matched")))
|
||||
(emit-op em 1) (emit-u16 em idx)
|
||||
(emit-op em 52) (emit-u16 em (pool-add (get em "pool") "error"))
|
||||
(emit-byte em 1)))
|
||||
(let ((clause (first clauses))
|
||||
(pattern (first clause))
|
||||
(body (nth clause 1))
|
||||
(rest-clauses (rest clauses)))
|
||||
(cond
|
||||
;; Wildcard _
|
||||
(and (= (type-of pattern) "symbol") (= (symbol-name pattern) "_"))
|
||||
(do (emit-op em 5) (compile-expr em body scope tail?))
|
||||
;; Symbol binding
|
||||
(and (= (type-of pattern) "symbol")
|
||||
(not (= (symbol-name pattern) "true"))
|
||||
(not (= (symbol-name pattern) "false"))
|
||||
(not (= (symbol-name pattern) "nil")))
|
||||
(let ((var-name (symbol-name pattern))
|
||||
(inner-scope (scope-add scope var-name)))
|
||||
(emit-op em 13) (emit-byte em (scope-index inner-scope var-name))
|
||||
(compile-expr em body inner-scope tail?))
|
||||
;; Quoted symbol 'foo
|
||||
(and (list? pattern) (= (len pattern) 2)
|
||||
(= (type-of (first pattern)) "symbol")
|
||||
(= (symbol-name (first pattern)) "quote")
|
||||
(= (type-of (nth pattern 1)) "symbol"))
|
||||
(do (emit-op em 6)
|
||||
(let ((idx (pool-add (get em "pool") (make-symbol (symbol-name (nth pattern 1))))))
|
||||
(emit-op em 1) (emit-u16 em idx))
|
||||
(let ((eq-idx (pool-add (get em "pool") "=")))
|
||||
(emit-op em 52) (emit-u16 em eq-idx) (emit-byte em 2))
|
||||
(emit-op em 33)
|
||||
(let ((skip (current-offset em)))
|
||||
(emit-i16 em 0)
|
||||
(emit-op em 5) (compile-expr em body scope tail?)
|
||||
(emit-op em 32)
|
||||
(let ((end-jump (current-offset em)))
|
||||
(emit-i16 em 0)
|
||||
(patch-i16 em skip (- (current-offset em) (+ skip 2)))
|
||||
(do-clauses rest-clauses)
|
||||
(patch-i16 em end-jump (- (current-offset em) (+ end-jump 2))))))
|
||||
;; Literal (string, number, boolean, nil)
|
||||
:else
|
||||
(do (emit-op em 6)
|
||||
(compile-expr em pattern scope false)
|
||||
(let ((eq-idx (pool-add (get em "pool") "=")))
|
||||
(emit-op em 52) (emit-u16 em eq-idx) (emit-byte em 2))
|
||||
(emit-op em 33)
|
||||
(let ((skip (current-offset em)))
|
||||
(emit-i16 em 0)
|
||||
(emit-op em 5) (compile-expr em body scope tail?)
|
||||
(emit-op em 32)
|
||||
(let ((end-jump (current-offset em)))
|
||||
(emit-i16 em 0)
|
||||
(patch-i16 em skip (- (current-offset em) (+ skip 2)))
|
||||
(do-clauses rest-clauses)
|
||||
(patch-i16 em end-jump (- (current-offset em) (+ end-jump 2))))))))))))
|
||||
(do-clauses (rest args)))))
|
||||
|
||||
(define compile-thread
|
||||
(fn (em args scope tail?)
|
||||
"Compile (-> val (f1 a) (f2 b)) by desugaring to nested calls."
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1,8 +1,4 @@
|
||||
(define
|
||||
make-signal
|
||||
(fn
|
||||
(value)
|
||||
(dict "__signal" true "value" value "subscribers" (list) "deps" (list))))
|
||||
(define make-signal (fn (value) (dict "__signal" true "value" value "subscribers" (list) "deps" (list))))
|
||||
|
||||
(define signal? (fn (x) (and (dict? x) (has-key? x "__signal"))))
|
||||
|
||||
@@ -12,179 +8,38 @@
|
||||
|
||||
(define signal-subscribers (fn (s) (get s "subscribers")))
|
||||
|
||||
(define
|
||||
signal-add-sub!
|
||||
(fn
|
||||
(s f)
|
||||
(when
|
||||
(not (contains? (get s "subscribers") f))
|
||||
(append! (get s "subscribers") f))))
|
||||
(define signal-add-sub! (fn (s f) (when (not (contains? (get s "subscribers") f)) (append! (get s "subscribers") f))))
|
||||
|
||||
(define
|
||||
signal-remove-sub!
|
||||
(fn (s f) (let ((subs (get s "subscribers"))) (remove! subs f))))
|
||||
(define signal-remove-sub! (fn (s f) (dict-set! s "subscribers" (filter (fn (sub) (not (identical? sub f))) (get s "subscribers")))))
|
||||
|
||||
(define signal-deps (fn (s) (get s "deps")))
|
||||
|
||||
(define signal-set-deps! (fn (s deps) (dict-set! s "deps" deps)))
|
||||
|
||||
(define
|
||||
signal
|
||||
:effects ()
|
||||
(fn ((initial-value :as any)) (make-signal initial-value)))
|
||||
(define signal :effects () (fn ((initial-value :as any)) (make-signal initial-value)))
|
||||
|
||||
(define
|
||||
deref
|
||||
:effects ()
|
||||
(fn
|
||||
((s :as any))
|
||||
(if
|
||||
(not (signal? s))
|
||||
s
|
||||
(let
|
||||
((ctx (context "sx-reactive" nil)))
|
||||
(when
|
||||
ctx
|
||||
(let
|
||||
((dep-list (get ctx "deps")) (notify-fn (get ctx "notify")))
|
||||
(when
|
||||
(not (contains? dep-list s))
|
||||
(append! dep-list s)
|
||||
(signal-add-sub! s notify-fn))))
|
||||
(signal-value s)))))
|
||||
(define deref :effects () (fn ((s :as any)) (if (not (signal? s)) s (let ((ctx (context "sx-reactive" nil))) (when ctx (let ((dep-list (get ctx "deps")) (notify-fn (get ctx "notify"))) (when (not (contains? dep-list s)) (append! dep-list s) (signal-add-sub! s notify-fn)))) (signal-value s)))))
|
||||
|
||||
(define
|
||||
reset!
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((s :as signal) value)
|
||||
(when
|
||||
(signal? s)
|
||||
(let
|
||||
((old (signal-value s)))
|
||||
(when
|
||||
(not (identical? old value))
|
||||
(signal-set-value! s value)
|
||||
(notify-subscribers s))))))
|
||||
(define reset! :effects (mutation) (fn ((s :as signal) value) (when (signal? s) (let ((old (signal-value s))) (when (not (identical? old value)) (signal-set-value! s value) (notify-subscribers s))))))
|
||||
|
||||
(define
|
||||
swap!
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((s :as signal) (f :as lambda) &rest args)
|
||||
(when
|
||||
(signal? s)
|
||||
(let
|
||||
((old (signal-value s))
|
||||
(new-val (trampoline (apply f (cons old args)))))
|
||||
(when
|
||||
(not (identical? old new-val))
|
||||
(signal-set-value! s new-val)
|
||||
(notify-subscribers s))))))
|
||||
(define swap! :effects (mutation) (fn ((s :as signal) (f :as lambda) &rest args) (when (signal? s) (let ((old (signal-value s)) (new-val (trampoline (apply f (cons old args))))) (when (not (identical? old new-val)) (signal-set-value! s new-val) (notify-subscribers s))))))
|
||||
|
||||
(define
|
||||
computed
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((compute-fn :as lambda))
|
||||
(let
|
||||
((s (make-signal nil)) (deps (list)) (compute-ctx nil))
|
||||
(let
|
||||
((recompute (fn () (for-each (fn ((dep :as signal)) (signal-remove-sub! dep recompute)) (signal-deps s)) (signal-set-deps! s (list)) (let ((ctx (dict "deps" (list) "notify" recompute))) (scope-push! "sx-reactive" ctx) (let ((new-val (compute-fn))) (scope-pop! "sx-reactive") (signal-set-deps! s (get ctx "deps")) (let ((old (signal-value s))) (signal-set-value! s new-val) (when (not (identical? old new-val)) (notify-subscribers s))))))))
|
||||
(recompute)
|
||||
(register-in-scope (fn () (dispose-computed s)))
|
||||
s))))
|
||||
(define computed :effects (mutation) (fn ((compute-fn :as lambda)) (let ((s (make-signal nil)) (deps (list)) (compute-ctx nil)) (let ((recompute (fn () (for-each (fn ((dep :as signal)) (signal-remove-sub! dep recompute)) (signal-deps s)) (signal-set-deps! s (list)) (let ((ctx (dict "deps" (list) "notify" recompute))) (scope-push! "sx-reactive" ctx) (let ((new-val (cek-call compute-fn nil))) (scope-pop! "sx-reactive") (signal-set-deps! s (get ctx "deps")) (let ((old (signal-value s))) (signal-set-value! s new-val) (when (not (identical? old new-val)) (notify-subscribers s)))))))) (recompute) (register-in-scope (fn () (dispose-computed s))) s))))
|
||||
|
||||
(define
|
||||
effect
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((effect-fn :as lambda))
|
||||
(let
|
||||
((deps (list)) (disposed false) (cleanup-fn nil))
|
||||
(let
|
||||
((run-effect (fn () (when (not disposed) (when cleanup-fn (cleanup-fn)) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep run-effect)) deps) (set! deps (list)) (let ((ctx (dict "deps" (list) "notify" run-effect))) (scope-push! "sx-reactive" ctx) (let ((result (effect-fn))) (scope-pop! "sx-reactive") (set! deps (get ctx "deps")) (when (callable? result) (set! cleanup-fn result))))))))
|
||||
(run-effect)
|
||||
(let
|
||||
((dispose-fn (fn () (set! disposed true) (when cleanup-fn (cleanup-fn)) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep run-effect)) deps) (set! deps (list)))))
|
||||
(register-in-scope dispose-fn)
|
||||
dispose-fn)))))
|
||||
(define effect :effects (mutation) (fn ((effect-fn :as lambda)) (let ((deps (list)) (disposed false) (cleanup-fn nil)) (let ((run-effect (fn () (when (not disposed) (when cleanup-fn (cek-call cleanup-fn nil)) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep run-effect)) deps) (set! deps (list)) (let ((ctx (dict "deps" (list) "notify" run-effect))) (scope-push! "sx-reactive" ctx) (let ((result (cek-call effect-fn nil))) (scope-pop! "sx-reactive") (set! deps (get ctx "deps")) (when (callable? result) (set! cleanup-fn result)))))))) (run-effect) (let ((dispose-fn (fn () (set! disposed true) (when cleanup-fn (cek-call cleanup-fn nil)) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep run-effect)) deps) (set! deps (list))))) (register-in-scope dispose-fn) dispose-fn)))))
|
||||
|
||||
(define *batch-depth* 0)
|
||||
|
||||
(define *batch-queue* (list))
|
||||
|
||||
(define
|
||||
batch
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((thunk :as lambda))
|
||||
(set! *batch-depth* (+ *batch-depth* 1))
|
||||
(thunk)
|
||||
(set! *batch-depth* (- *batch-depth* 1))
|
||||
(when
|
||||
(= *batch-depth* 0)
|
||||
(let
|
||||
((queue *batch-queue*))
|
||||
(set! *batch-queue* (list))
|
||||
(let
|
||||
((seen (list)) (pending (list)))
|
||||
(for-each
|
||||
(fn
|
||||
((s :as signal))
|
||||
(for-each
|
||||
(fn
|
||||
((sub :as lambda))
|
||||
(when
|
||||
(not (contains? seen sub))
|
||||
(append! seen sub)
|
||||
(append! pending sub)))
|
||||
(signal-subscribers s)))
|
||||
queue)
|
||||
(for-each (fn ((sub :as lambda)) (sub)) pending))))))
|
||||
(define batch :effects (mutation) (fn ((thunk :as lambda)) (set! *batch-depth* (+ *batch-depth* 1)) (cek-call thunk nil) (set! *batch-depth* (- *batch-depth* 1)) (when (= *batch-depth* 0) (let ((queue *batch-queue*)) (set! *batch-queue* (list)) (let ((seen (list)) (pending (list))) (for-each (fn ((s :as signal)) (for-each (fn ((sub :as lambda)) (when (not (contains? seen sub)) (append! seen sub) (append! pending sub))) (signal-subscribers s))) queue) (for-each (fn ((sub :as lambda)) (sub)) pending))))))
|
||||
|
||||
(define
|
||||
notify-subscribers
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((s :as signal))
|
||||
(if
|
||||
(> *batch-depth* 0)
|
||||
(when (not (contains? *batch-queue* s)) (append! *batch-queue* s))
|
||||
(flush-subscribers s))))
|
||||
(define notify-subscribers :effects (mutation) (fn ((s :as signal)) (if (> *batch-depth* 0) (when (not (contains? *batch-queue* s)) (append! *batch-queue* s)) (flush-subscribers s))))
|
||||
|
||||
(define
|
||||
flush-subscribers
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((s :as signal))
|
||||
(for-each (fn ((sub :as lambda)) (sub)) (signal-subscribers s))))
|
||||
(define flush-subscribers :effects (mutation) (fn ((s :as signal)) (for-each (fn ((sub :as lambda)) (sub)) (signal-subscribers s))))
|
||||
|
||||
(define
|
||||
dispose-computed
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((s :as signal))
|
||||
(when
|
||||
(signal? s)
|
||||
(for-each
|
||||
(fn ((dep :as signal)) (signal-remove-sub! dep nil))
|
||||
(signal-deps s))
|
||||
(signal-set-deps! s (list)))))
|
||||
(define dispose-computed :effects (mutation) (fn ((s :as signal)) (when (signal? s) (for-each (fn ((dep :as signal)) (signal-remove-sub! dep nil)) (signal-deps s)) (signal-set-deps! s (list)))))
|
||||
|
||||
(define
|
||||
with-island-scope
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((scope-fn :as lambda) (body-fn :as lambda))
|
||||
(scope-push! "sx-island-scope" scope-fn)
|
||||
(let ((result (body-fn))) (scope-pop! "sx-island-scope") result)))
|
||||
(define with-island-scope :effects (mutation) (fn ((scope-fn :as lambda) (body-fn :as lambda)) (scope-push! "sx-island-scope" scope-fn) (let ((result (body-fn))) (scope-pop! "sx-island-scope") result)))
|
||||
|
||||
(define
|
||||
register-in-scope
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((disposable :as lambda))
|
||||
(let
|
||||
((collector (scope-peek "sx-island-scope")))
|
||||
(when collector (cek-call collector (list disposable))))))
|
||||
(define register-in-scope :effects (mutation) (fn ((disposable :as lambda)) (let ((collector (scope-peek "sx-island-scope"))) (when collector (cek-call collector (list disposable))))))
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1 +0,0 @@
|
||||
{"magic":"SXBC","version":1,"hash":"bfa1b3e64a390451","module":{"arity":0,"bytecode":[52,1,0,0,128,0,0,5,51,3,0,128,2,0,5,51,5,0,128,4,0,5,51,7,0,128,6,0,5,51,9,0,128,8,0,5,51,11,0,128,10,0,5,51,13,0,128,12,0,5,51,15,0,128,14,0,5,51,17,0,128,16,0,50],"constants":[{"t":"s","v":"freeze-registry"},{"t":"s","v":"dict"},{"t":"s","v":"freeze-signal"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,1,1,0,2,48,2,17,2,20,2,0,33,62,0,20,4,0,20,2,0,52,3,0,2,6,34,5,0,5,52,5,0,0,17,3,20,6,0,20,7,0,1,9,0,20,9,0,1,10,0,20,11,0,52,8,0,4,48,2,5,20,4,0,20,2,0,20,7,0,52,12,0,3,32,1,0,2,50],"constants":[{"t":"s","v":"context"},{"t":"s","v":"sx-freeze-scope"},{"t":"s","v":"scope-name"},{"t":"s","v":"get"},{"t":"s","v":"freeze-registry"},{"t":"s","v":"list"},{"t":"s","v":"append!"},{"t":"s","v":"entries"},{"t":"s","v":"dict"},{"t":"s","v":"name"},{"t":"s","v":"signal"},{"t":"s","v":"sig"},{"t":"s","v":"dict-set!"}]}},{"t":"s","v":"freeze-scope"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,1,1,0,20,2,0,48,2,5,20,4,0,20,2,0,52,5,0,0,52,3,0,3,5,20,6,0,20,7,0,2,48,2,5,20,8,0,1,1,0,48,1,5,2,50],"constants":[{"t":"s","v":"scope-push!"},{"t":"s","v":"sx-freeze-scope"},{"t":"s","v":"name"},{"t":"s","v":"dict-set!"},{"t":"s","v":"freeze-registry"},{"t":"s","v":"list"},{"t":"s","v":"cek-call"},{"t":"s","v":"body-fn"},{"t":"s","v":"scope-pop!"}]}},{"t":"s","v":"cek-freeze-scope"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,1,0,20,2,0,52,0,0,2,6,34,5,0,5,52,3,0,0,17,1,52,4,0,0,17,2,51,6,0,20,7,0,52,5,0,2,5,1,2,0,20,2,0,1,8,0,20,9,0,52,4,0,4,50],"constants":[{"t":"s","v":"get"},{"t":"s","v":"freeze-registry"},{"t":"s","v":"name"},{"t":"s","v":"list"},{"t":"s","v":"dict"},{"t":"s","v":"for-each"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,1,0,20,3,0,1,4,0,52,2,0,2,20,5,0,20,3,0,1,6,0,52,2,0,2,48,1,52,0,0,3,50],"constants":[{"t":"s","v":"dict-set!"},{"t":"s","v":"signals-dict"},{"t":"s","v":"get"},{"t":"s","v":"entry"},{"t":"s","v":"name"},{"t":"s","v":"signal-value"},{"t":"s","v":"signal"}]}},{"t":"s","v":"entries"},{"t":"s","v":"signals"},{"t":"s","v":"signals-dict"}]}},{"t":"s","v":"cek-freeze-all"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[51,1,0,20,3,0,52,2,0,1,52,0,0,2,50],"constants":[{"t":"s","v":"map"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,49,1,50],"constants":[{"t":"s","v":"cek-freeze-scope"},{"t":"s","v":"name"}]}},{"t":"s","v":"keys"},{"t":"s","v":"freeze-registry"}]}},{"t":"s","v":"cek-thaw-scope"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,1,0,20,2,0,52,0,0,2,6,34,5,0,5,52,3,0,0,17,2,20,4,0,1,5,0,52,0,0,2,17,3,20,6,0,33,13,0,51,8,0,20,9,0,52,7,0,2,32,1,0,2,50],"constants":[{"t":"s","v":"get"},{"t":"s","v":"freeze-registry"},{"t":"s","v":"name"},{"t":"s","v":"list"},{"t":"s","v":"frozen"},{"t":"s","v":"signals"},{"t":"s","v":"values"},{"t":"s","v":"for-each"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,1,0,1,2,0,52,0,0,2,17,1,20,1,0,1,3,0,52,0,0,2,17,2,20,4,0,20,5,0,52,0,0,2,17,3,20,8,0,52,7,0,1,52,6,0,1,33,14,0,20,9,0,20,10,0,20,8,0,49,2,32,1,0,2,50],"constants":[{"t":"s","v":"get"},{"t":"s","v":"entry"},{"t":"s","v":"name"},{"t":"s","v":"signal"},{"t":"s","v":"values"},{"t":"s","v":"sig-name"},{"t":"s","v":"not"},{"t":"s","v":"nil?"},{"t":"s","v":"val"},{"t":"s","v":"reset!"},{"t":"s","v":"sig"}]}},{"t":"s","v":"entries"}]}},{"t":"s","v":"cek-thaw-all"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[51,1,0,20,2,0,52,0,0,2,50],"constants":[{"t":"s","v":"for-each"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,2,0,1,3,0,52,1,0,2,20,2,0,49,2,50],"constants":[{"t":"s","v":"cek-thaw-scope"},{"t":"s","v":"get"},{"t":"s","v":"frozen"},{"t":"s","v":"name"}]}},{"t":"s","v":"frozen-list"}]}},{"t":"s","v":"freeze-to-sx"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,20,2,0,48,1,49,1,50],"constants":[{"t":"s","v":"sx-serialize"},{"t":"s","v":"cek-freeze-scope"},{"t":"s","v":"name"}]}},{"t":"s","v":"thaw-from-sx"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,48,1,17,1,20,4,0,52,3,0,1,52,2,0,1,33,30,0,20,4,0,52,5,0,1,17,2,20,6,0,20,8,0,1,9,0,52,7,0,2,20,8,0,49,2,32,1,0,2,50],"constants":[{"t":"s","v":"sx-parse"},{"t":"s","v":"sx-text"},{"t":"s","v":"not"},{"t":"s","v":"empty?"},{"t":"s","v":"parsed"},{"t":"s","v":"first"},{"t":"s","v":"cek-thaw-scope"},{"t":"s","v":"get"},{"t":"s","v":"frozen"},{"t":"s","v":"name"}]}}]}}
|
||||
@@ -1,3 +1,3 @@
|
||||
(sxbc 1 "93780bb9539e858f"
|
||||
(sxbc 1 "57726b5b82c1a3cb"
|
||||
(code
|
||||
:constants ("assert-signal-value" {:upvalue-count 0 :arity 2 :constants ("deref" "assert=" "str" "Expected signal value " ", got ") :bytecode (20 0 0 16 0 48 1 17 2 20 1 0 16 2 16 1 1 3 0 16 1 1 4 0 16 2 52 2 0 4 49 3 50)} "assert-signal-has-subscribers" {:upvalue-count 0 :arity 1 :constants ("assert" ">" "len" "signal-subscribers" 0 "Expected signal to have subscribers") :bytecode (20 0 0 20 3 0 16 0 48 1 52 2 0 1 1 4 0 52 1 0 2 1 5 0 49 2 50)} "assert-signal-no-subscribers" {:upvalue-count 0 :arity 1 :constants ("assert" "=" "len" "signal-subscribers" 0 "Expected signal to have no subscribers") :bytecode (20 0 0 20 3 0 16 0 48 1 52 2 0 1 1 4 0 52 1 0 2 1 5 0 49 2 50)} "assert-signal-subscriber-count" {:upvalue-count 0 :arity 2 :constants ("len" "signal-subscribers" "assert=" "str" "Expected " " subscribers, got ") :bytecode (20 1 0 16 0 48 1 52 0 0 1 17 2 20 2 0 16 2 16 1 1 4 0 16 1 1 5 0 16 2 52 3 0 4 49 3 50)} "simulate-signal-set!" {:upvalue-count 0 :arity 2 :constants ("reset!") :bytecode (20 0 0 16 0 16 1 49 2 50)} "simulate-signal-swap!" {:upvalue-count 0 :arity 3 :constants ("apply" "swap!" "cons") :bytecode (20 1 0 16 0 16 1 16 2 52 2 0 2 52 2 0 2 52 0 0 2 50)} "assert-computed-dep-count" {:upvalue-count 0 :arity 2 :constants ("len" "signal-deps" "assert=" "str" "Expected " " deps, got ") :bytecode (20 1 0 16 0 48 1 52 0 0 1 17 2 20 2 0 16 2 16 1 1 4 0 16 1 1 5 0 16 2 52 3 0 4 49 3 50)} "assert-computed-depends-on" {:upvalue-count 0 :arity 2 :constants ("assert" "contains?" "signal-deps" "Expected computed to depend on the given signal") :bytecode (20 0 0 20 2 0 16 0 48 1 16 1 52 1 0 2 1 3 0 49 2 50)} "count-effect-runs" {:upvalue-count 0 :arity 1 :constants ("signal" 0 "effect" {:upvalue-count 1 :arity 0 :constants ("deref") :bytecode (20 0 0 18 0 49 1 50)} {:upvalue-count 2 :arity 0 :constants ("+" 1 "cek-call") :bytecode (18 0 1 1 0 52 0 0 2 19 0 5 20 2 0 18 1 2 49 2 50)}) :bytecode (20 0 0 1 1 0 48 1 17 1 20 2 0 51 3 0 1 1 48 1 5 1 1 0 17 2 20 2 0 51 4 0 1 2 1 0 48 1 17 3 16 2 50)} "make-test-signal" {:upvalue-count 0 :arity 1 :constants ("signal" "list" "effect" {:upvalue-count 2 :arity 0 :constants ("append!" "deref") :bytecode (20 0 0 18 0 20 1 0 18 1 48 1 49 2 50)} "history") :bytecode (20 0 0 16 0 48 1 17 1 52 1 0 0 17 2 20 2 0 51 3 0 1 2 1 1 48 1 5 1 0 0 16 1 1 4 0 16 2 65 2 0 50)} "assert-batch-coalesces" {:upvalue-count 0 :arity 2 :constants (0 "signal" "effect" {:upvalue-count 2 :arity 0 :constants ("deref" "+" 1) :bytecode (20 0 0 18 0 48 1 5 18 1 1 2 0 52 1 0 2 19 1 50)} "batch" "assert=" "str" "Expected " " notifications, got ") :bytecode (1 0 0 17 2 20 1 0 1 0 0 48 1 17 3 20 2 0 51 3 0 1 3 1 2 48 1 5 1 0 0 17 2 5 20 4 0 16 0 48 1 5 20 5 0 16 2 16 1 1 7 0 16 1 1 8 0 16 2 52 6 0 4 49 3 50)}) :bytecode (51 1 0 128 0 0 5 51 3 0 128 2 0 5 51 5 0 128 4 0 5 51 7 0 128 6 0 5 51 9 0 128 8 0 5 51 11 0 128 10 0 5 51 13 0 128 12 0 5 51 15 0 128 14 0 5 51 17 0 128 16 0 5 51 19 0 128 18 0 5 51 21 0 128 20 0 50)))
|
||||
:constants ("assert-signal-value" {:upvalue-count 0 :arity 2 :constants ("deref" "assert=" "str" "Expected signal value " ", got ") :bytecode (20 0 0 16 0 48 1 17 2 20 1 0 16 2 16 1 1 3 0 16 1 1 4 0 16 2 52 2 0 4 49 3 50)} "assert-signal-has-subscribers" {:upvalue-count 0 :arity 1 :constants ("assert" ">" "len" "signal-subscribers" 0 "Expected signal to have subscribers") :bytecode (20 0 0 20 3 0 16 0 48 1 52 2 0 1 1 4 0 52 1 0 2 1 5 0 49 2 50)} "assert-signal-no-subscribers" {:upvalue-count 0 :arity 1 :constants ("assert" "=" "len" "signal-subscribers" 0 "Expected signal to have no subscribers") :bytecode (20 0 0 20 3 0 16 0 48 1 52 2 0 1 1 4 0 52 1 0 2 1 5 0 49 2 50)} "assert-signal-subscriber-count" {:upvalue-count 0 :arity 2 :constants ("len" "signal-subscribers" "assert=" "str" "Expected " " subscribers, got ") :bytecode (20 1 0 16 0 48 1 52 0 0 1 17 2 20 2 0 16 2 16 1 1 4 0 16 1 1 5 0 16 2 52 3 0 4 49 3 50)} "simulate-signal-set!" {:upvalue-count 0 :arity 2 :constants ("reset!") :bytecode (20 0 0 16 0 16 1 49 2 50)} "simulate-signal-swap!" {:upvalue-count 0 :arity 2 :constants ("swap!") :bytecode (20 0 0 16 0 16 1 49 2 50)} "assert-computed-dep-count" {:upvalue-count 0 :arity 2 :constants ("len" "signal-deps" "assert=" "str" "Expected " " deps, got ") :bytecode (20 1 0 16 0 48 1 52 0 0 1 17 2 20 2 0 16 2 16 1 1 4 0 16 1 1 5 0 16 2 52 3 0 4 49 3 50)} "assert-computed-depends-on" {:upvalue-count 0 :arity 2 :constants ("assert" "contains?" "signal-deps" "Expected computed to depend on the given signal") :bytecode (20 0 0 20 2 0 16 0 48 1 16 1 52 1 0 2 1 3 0 49 2 50)} "count-effect-runs" {:upvalue-count 0 :arity 1 :constants ("signal" 0 "effect" {:upvalue-count 1 :arity 0 :constants ("deref") :bytecode (20 0 0 18 0 49 1 50)} {:upvalue-count 2 :arity 0 :constants ("+" 1 "cek-call") :bytecode (18 0 1 1 0 52 0 0 2 19 0 5 20 2 0 18 1 2 49 2 50)}) :bytecode (20 0 0 1 1 0 48 1 17 1 20 2 0 51 3 0 1 1 48 1 5 1 1 0 17 2 20 2 0 51 4 0 1 2 1 0 48 1 17 3 16 2 50)} "make-test-signal" {:upvalue-count 0 :arity 1 :constants ("signal" "list" "effect" {:upvalue-count 2 :arity 0 :constants ("append!" "deref") :bytecode (20 0 0 18 0 20 1 0 18 1 48 1 49 2 50)} "history") :bytecode (20 0 0 16 0 48 1 17 1 52 1 0 0 17 2 20 2 0 51 3 0 1 2 1 1 48 1 5 1 0 0 16 1 1 4 0 16 2 65 2 0 50)} "assert-batch-coalesces" {:upvalue-count 0 :arity 2 :constants (0 "signal" "effect" {:upvalue-count 2 :arity 0 :constants ("deref" "+" 1) :bytecode (20 0 0 18 0 48 1 5 18 1 1 2 0 52 1 0 2 19 1 50)} "batch" "assert=" "str" "Expected " " notifications, got ") :bytecode (1 0 0 17 2 20 1 0 1 0 0 48 1 17 3 20 2 0 51 3 0 1 3 1 2 48 1 5 1 0 0 17 2 5 20 4 0 16 0 48 1 5 20 5 0 16 2 16 1 1 7 0 16 1 1 8 0 16 2 52 6 0 4 49 3 50)}) :bytecode (51 1 0 128 0 0 5 51 3 0 128 2 0 5 51 5 0 128 4 0 5 51 7 0 128 6 0 5 51 9 0 128 8 0 5 51 11 0 128 10 0 5 51 13 0 128 12 0 5 51 15 0 128 14 0 5 51 17 0 128 16 0 5 51 19 0 128 18 0 5 51 21 0 128 20 0 50)))
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1,101 +1,229 @@
|
||||
;; ==========================================================================
|
||||
;; render.sx — Core rendering specification
|
||||
;;
|
||||
;; Shared registries and utilities used by all rendering adapters.
|
||||
;; This file defines WHAT is renderable (tag registries, attribute rules)
|
||||
;; and HOW arguments are parsed — but not the output format.
|
||||
;;
|
||||
;; Adapters:
|
||||
;; adapter-html.sx — HTML string output (server)
|
||||
;; adapter-sx.sx — SX wire format output (server → client)
|
||||
;; adapter-dom.sx — Live DOM node output (browser)
|
||||
;;
|
||||
;; Each adapter imports these shared definitions and provides its own
|
||||
;; render entry point (render-to-html, render-to-sx, render-to-dom).
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; HTML tag registry
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Tags known to the renderer. Unknown names are treated as function calls.
|
||||
;; Void elements self-close (no children). Boolean attrs emit name only.
|
||||
|
||||
(define HTML_TAGS
|
||||
(define
|
||||
HTML_TAGS
|
||||
(list
|
||||
;; Document
|
||||
"html" "head" "body" "title" "meta" "link" "script" "style" "noscript"
|
||||
;; Sections
|
||||
"header" "nav" "main" "section" "article" "aside" "footer"
|
||||
"h1" "h2" "h3" "h4" "h5" "h6" "hgroup"
|
||||
;; Block
|
||||
"div" "p" "blockquote" "pre" "figure" "figcaption" "address" "details" "summary"
|
||||
;; Inline
|
||||
"a" "span" "em" "strong" "small" "b" "i" "u" "s" "mark" "sub" "sup"
|
||||
"abbr" "cite" "code" "kbd" "samp" "var" "time" "br" "wbr" "hr"
|
||||
;; Lists
|
||||
"ul" "ol" "li" "dl" "dt" "dd"
|
||||
;; Tables
|
||||
"table" "thead" "tbody" "tfoot" "tr" "th" "td" "caption" "colgroup" "col"
|
||||
;; Forms
|
||||
"form" "input" "textarea" "select" "option" "optgroup" "button" "label"
|
||||
"fieldset" "legend" "output" "datalist"
|
||||
;; Media
|
||||
"img" "video" "audio" "source" "picture" "canvas" "iframe"
|
||||
;; SVG
|
||||
"svg" "math" "path" "circle" "ellipse" "rect" "line" "polyline" "polygon"
|
||||
"text" "tspan" "g" "defs" "use" "clipPath" "mask" "pattern"
|
||||
"linearGradient" "radialGradient" "stop" "filter"
|
||||
"feGaussianBlur" "feOffset" "feBlend" "feColorMatrix" "feComposite"
|
||||
"feMerge" "feMergeNode" "feTurbulence"
|
||||
"feComponentTransfer" "feFuncR" "feFuncG" "feFuncB" "feFuncA"
|
||||
"feDisplacementMap" "feFlood" "feImage" "feMorphology"
|
||||
"feSpecularLighting" "feDiffuseLighting"
|
||||
"fePointLight" "feSpotLight" "feDistantLight"
|
||||
"animate" "animateTransform" "foreignObject"
|
||||
;; Other
|
||||
"template" "slot" "dialog" "menu"))
|
||||
"html"
|
||||
"head"
|
||||
"body"
|
||||
"title"
|
||||
"meta"
|
||||
"link"
|
||||
"script"
|
||||
"style"
|
||||
"noscript"
|
||||
"header"
|
||||
"nav"
|
||||
"main"
|
||||
"section"
|
||||
"article"
|
||||
"aside"
|
||||
"footer"
|
||||
"h1"
|
||||
"h2"
|
||||
"h3"
|
||||
"h4"
|
||||
"h5"
|
||||
"h6"
|
||||
"hgroup"
|
||||
"div"
|
||||
"p"
|
||||
"blockquote"
|
||||
"pre"
|
||||
"figure"
|
||||
"figcaption"
|
||||
"address"
|
||||
"details"
|
||||
"summary"
|
||||
"a"
|
||||
"span"
|
||||
"em"
|
||||
"strong"
|
||||
"small"
|
||||
"b"
|
||||
"i"
|
||||
"u"
|
||||
"s"
|
||||
"mark"
|
||||
"sub"
|
||||
"sup"
|
||||
"abbr"
|
||||
"cite"
|
||||
"code"
|
||||
"kbd"
|
||||
"samp"
|
||||
"var"
|
||||
"time"
|
||||
"br"
|
||||
"wbr"
|
||||
"hr"
|
||||
"ul"
|
||||
"ol"
|
||||
"li"
|
||||
"dl"
|
||||
"dt"
|
||||
"dd"
|
||||
"table"
|
||||
"thead"
|
||||
"tbody"
|
||||
"tfoot"
|
||||
"tr"
|
||||
"th"
|
||||
"td"
|
||||
"caption"
|
||||
"colgroup"
|
||||
"col"
|
||||
"form"
|
||||
"input"
|
||||
"textarea"
|
||||
"select"
|
||||
"option"
|
||||
"optgroup"
|
||||
"button"
|
||||
"label"
|
||||
"fieldset"
|
||||
"legend"
|
||||
"output"
|
||||
"datalist"
|
||||
"img"
|
||||
"video"
|
||||
"audio"
|
||||
"source"
|
||||
"picture"
|
||||
"canvas"
|
||||
"iframe"
|
||||
"svg"
|
||||
"math"
|
||||
"path"
|
||||
"circle"
|
||||
"ellipse"
|
||||
"rect"
|
||||
"line"
|
||||
"polyline"
|
||||
"polygon"
|
||||
"text"
|
||||
"tspan"
|
||||
"g"
|
||||
"defs"
|
||||
"use"
|
||||
"clipPath"
|
||||
"mask"
|
||||
"pattern"
|
||||
"linearGradient"
|
||||
"radialGradient"
|
||||
"stop"
|
||||
"filter"
|
||||
"feGaussianBlur"
|
||||
"feOffset"
|
||||
"feBlend"
|
||||
"feColorMatrix"
|
||||
"feComposite"
|
||||
"feMerge"
|
||||
"feMergeNode"
|
||||
"feTurbulence"
|
||||
"feComponentTransfer"
|
||||
"feFuncR"
|
||||
"feFuncG"
|
||||
"feFuncB"
|
||||
"feFuncA"
|
||||
"feDisplacementMap"
|
||||
"feFlood"
|
||||
"feImage"
|
||||
"feMorphology"
|
||||
"feSpecularLighting"
|
||||
"feDiffuseLighting"
|
||||
"fePointLight"
|
||||
"feSpotLight"
|
||||
"feDistantLight"
|
||||
"animate"
|
||||
"animateTransform"
|
||||
"foreignObject"
|
||||
"template"
|
||||
"slot"
|
||||
"dialog"
|
||||
"menu"))
|
||||
|
||||
(define VOID_ELEMENTS
|
||||
(list "area" "base" "br" "col" "embed" "hr" "img" "input"
|
||||
"link" "meta" "param" "source" "track" "wbr"))
|
||||
(define
|
||||
VOID_ELEMENTS
|
||||
(list
|
||||
"area"
|
||||
"base"
|
||||
"br"
|
||||
"col"
|
||||
"embed"
|
||||
"hr"
|
||||
"img"
|
||||
"input"
|
||||
"link"
|
||||
"meta"
|
||||
"param"
|
||||
"source"
|
||||
"track"
|
||||
"wbr"))
|
||||
|
||||
(define BOOLEAN_ATTRS
|
||||
(list "async" "autofocus" "autoplay" "checked" "controls" "default"
|
||||
"defer" "disabled" "formnovalidate" "hidden" "inert" "ismap"
|
||||
"loop" "multiple" "muted" "nomodule" "novalidate" "open"
|
||||
"playsinline" "readonly" "required" "reversed" "selected"))
|
||||
(define
|
||||
BOOLEAN_ATTRS
|
||||
(list
|
||||
"async"
|
||||
"autofocus"
|
||||
"autoplay"
|
||||
"checked"
|
||||
"controls"
|
||||
"default"
|
||||
"defer"
|
||||
"disabled"
|
||||
"formnovalidate"
|
||||
"hidden"
|
||||
"inert"
|
||||
"ismap"
|
||||
"loop"
|
||||
"multiple"
|
||||
"muted"
|
||||
"nomodule"
|
||||
"novalidate"
|
||||
"open"
|
||||
"playsinline"
|
||||
"readonly"
|
||||
"required"
|
||||
"reversed"
|
||||
"selected"))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Shared utilities
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
;; Extension point for definition forms — modules append names here.
|
||||
;; Survives spec reloads (no function wrapping needed).
|
||||
(define *definition-form-extensions* (list))
|
||||
|
||||
(define definition-form? :effects []
|
||||
(fn ((name :as string))
|
||||
(or (= name "define") (= name "defcomp") (= name "defisland")
|
||||
(= name "defmacro") (= name "defstyle")
|
||||
(= name "deftype") (= name "defeffect")
|
||||
(contains? *definition-form-extensions* name))))
|
||||
(define
|
||||
definition-form?
|
||||
:effects ()
|
||||
(fn
|
||||
((name :as string))
|
||||
(or
|
||||
(= name "define")
|
||||
(= name "defcomp")
|
||||
(= name "defisland")
|
||||
(= name "defmacro")
|
||||
(= name "defstyle")
|
||||
(= name "deftype")
|
||||
(= name "defeffect")
|
||||
(contains? *definition-form-extensions* name))))
|
||||
|
||||
|
||||
(define parse-element-args :effects [render]
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; Parse (:key val :key2 val2 child1 child2) into (attrs-dict children-list)
|
||||
(let ((attrs (dict))
|
||||
(children (list)))
|
||||
(define
|
||||
parse-element-args
|
||||
:effects (render)
|
||||
(fn
|
||||
((args :as list) (env :as dict))
|
||||
(let
|
||||
((attrs (dict)) (children (list)))
|
||||
(reduce
|
||||
(fn ((state :as dict) arg)
|
||||
(let ((skip (get state "skip")))
|
||||
(if skip
|
||||
(fn
|
||||
((state :as dict) arg)
|
||||
(let
|
||||
((skip (get state "skip")))
|
||||
(if
|
||||
skip
|
||||
(assoc state "skip" false "i" (inc (get state "i")))
|
||||
(if (and (= (type-of arg) "keyword")
|
||||
(< (inc (get state "i")) (len args)))
|
||||
(let ((val (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
|
||||
(if
|
||||
(and
|
||||
(= (type-of arg) "keyword")
|
||||
(< (inc (get state "i")) (len args)))
|
||||
(let
|
||||
((val (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
|
||||
(dict-set! attrs (keyword-name arg) val)
|
||||
(assoc state "skip" true "i" (inc (get state "i"))))
|
||||
(do
|
||||
@@ -105,193 +233,168 @@
|
||||
args)
|
||||
(list attrs children))))
|
||||
|
||||
|
||||
(define render-attrs :effects []
|
||||
(fn ((attrs :as dict))
|
||||
;; Render an attrs dict to an HTML attribute string.
|
||||
;; Used by adapter-html.sx and adapter-sx.sx.
|
||||
(join ""
|
||||
(define
|
||||
render-attrs
|
||||
:effects ()
|
||||
(fn
|
||||
((attrs :as dict))
|
||||
(join
|
||||
""
|
||||
(map
|
||||
(fn ((key :as string))
|
||||
(let ((val (dict-get attrs key)))
|
||||
(fn
|
||||
((key :as string))
|
||||
(let
|
||||
((val (dict-get attrs key)))
|
||||
(cond
|
||||
;; Boolean attrs
|
||||
(and (contains? BOOLEAN_ATTRS key) val)
|
||||
(str " " key)
|
||||
(str " " key)
|
||||
(and (contains? BOOLEAN_ATTRS key) (not val))
|
||||
""
|
||||
;; Nil values — skip
|
||||
(nil? val) ""
|
||||
;; Normal attr
|
||||
""
|
||||
(nil? val)
|
||||
""
|
||||
:else (str " " key "=\"" (escape-attr (str val)) "\""))))
|
||||
(keys attrs)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Render adapter helpers
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Shared by HTML and DOM adapters for evaluating control forms during
|
||||
;; rendering. Unlike sf-cond (eval.sx) which returns a thunk for TCO,
|
||||
;; eval-cond returns the unevaluated body expression so the adapter
|
||||
;; can render it in its own mode (HTML string vs DOM nodes).
|
||||
|
||||
;; eval-cond: find matching cond branch, return unevaluated body expr.
|
||||
;; Handles both scheme-style ((test body) ...) and clojure-style
|
||||
;; (test body test body ...).
|
||||
(define eval-cond :effects []
|
||||
(fn ((clauses :as list) (env :as dict))
|
||||
(if (cond-scheme? clauses)
|
||||
(define
|
||||
eval-cond
|
||||
:effects ()
|
||||
(fn
|
||||
((clauses :as list) (env :as dict))
|
||||
(if
|
||||
(cond-scheme? clauses)
|
||||
(eval-cond-scheme clauses env)
|
||||
(eval-cond-clojure clauses env))))
|
||||
|
||||
(define eval-cond-scheme :effects []
|
||||
(fn ((clauses :as list) (env :as dict))
|
||||
(if (empty? clauses)
|
||||
(define
|
||||
eval-cond-scheme
|
||||
:effects ()
|
||||
(fn
|
||||
((clauses :as list) (env :as dict))
|
||||
(if
|
||||
(empty? clauses)
|
||||
nil
|
||||
(let ((clause (first clauses))
|
||||
(test (first clause))
|
||||
(body (nth clause 1)))
|
||||
(if (is-else-clause? test)
|
||||
(let
|
||||
((clause (first clauses))
|
||||
(test (first clause))
|
||||
(body (nth clause 1)))
|
||||
(if
|
||||
(is-else-clause? test)
|
||||
body
|
||||
(if (trampoline (eval-expr test env))
|
||||
(if
|
||||
(trampoline (eval-expr test env))
|
||||
body
|
||||
(eval-cond-scheme (rest clauses) env)))))))
|
||||
|
||||
(define eval-cond-clojure :effects []
|
||||
(fn ((clauses :as list) (env :as dict))
|
||||
(if (< (len clauses) 2)
|
||||
(define
|
||||
eval-cond-clojure
|
||||
:effects ()
|
||||
(fn
|
||||
((clauses :as list) (env :as dict))
|
||||
(if
|
||||
(< (len clauses) 2)
|
||||
nil
|
||||
(let ((test (first clauses))
|
||||
(body (nth clauses 1)))
|
||||
(if (is-else-clause? test)
|
||||
(let
|
||||
((test (first clauses)) (body (nth clauses 1)))
|
||||
(if
|
||||
(is-else-clause? test)
|
||||
body
|
||||
(if (trampoline (eval-expr test env))
|
||||
(if
|
||||
(trampoline (eval-expr test env))
|
||||
body
|
||||
(eval-cond-clojure (slice clauses 2) env)))))))
|
||||
|
||||
;; process-bindings: evaluate let-binding pairs, return extended env.
|
||||
;; bindings = ((name1 expr1) (name2 expr2) ...)
|
||||
(define process-bindings :effects [mutation]
|
||||
(fn ((bindings :as list) (env :as dict))
|
||||
;; env-extend (not merge) — Env is not a dict subclass, so merge()
|
||||
;; returns an empty dict, losing all parent scope bindings.
|
||||
(let ((local (env-extend env)))
|
||||
(define
|
||||
process-bindings
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((bindings :as list) (env :as dict))
|
||||
(let
|
||||
((local (env-extend env)))
|
||||
(for-each
|
||||
(fn ((pair :as list))
|
||||
(when (and (= (type-of pair) "list") (>= (len pair) 2))
|
||||
(let ((name (if (= (type-of (first pair)) "symbol")
|
||||
(symbol-name (first pair))
|
||||
(str (first pair)))))
|
||||
(env-bind! local name (trampoline (eval-expr (nth pair 1) local))))))
|
||||
(fn
|
||||
((pair :as list))
|
||||
(when
|
||||
(and (= (type-of pair) "list") (>= (len pair) 2))
|
||||
(let
|
||||
((name (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair)))))
|
||||
(env-bind!
|
||||
local
|
||||
name
|
||||
(trampoline (eval-expr (nth pair 1) local))))))
|
||||
bindings)
|
||||
local)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; is-render-expr? — check if expression is a rendering form
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Used by eval-list to dispatch rendering forms to the active adapter
|
||||
;; (HTML, SX wire, or DOM) rather than evaluating them as function calls.
|
||||
|
||||
(define is-render-expr? :effects []
|
||||
(fn (expr)
|
||||
(if (or (not (= (type-of expr) "list")) (empty? expr))
|
||||
(define
|
||||
is-render-expr?
|
||||
:effects ()
|
||||
(fn
|
||||
(expr)
|
||||
(if
|
||||
(or (not (= (type-of expr) "list")) (empty? expr))
|
||||
false
|
||||
(let ((h (first expr)))
|
||||
(if (not (= (type-of h) "symbol"))
|
||||
(let
|
||||
((h (first expr)))
|
||||
(if
|
||||
(not (= (type-of h) "symbol"))
|
||||
false
|
||||
(let ((n (symbol-name h)))
|
||||
(or (= n "<>")
|
||||
(= n "raw!")
|
||||
(starts-with? n "~")
|
||||
(starts-with? n "html:")
|
||||
(contains? HTML_TAGS n)
|
||||
(and (> (index-of n "-") 0)
|
||||
(> (len expr) 1)
|
||||
(= (type-of (nth expr 1)) "keyword")))))))))
|
||||
(let
|
||||
((n (symbol-name h)))
|
||||
(or
|
||||
(= n "<>")
|
||||
(= n "raw!")
|
||||
(starts-with? n "~")
|
||||
(starts-with? n "html:")
|
||||
(contains? HTML_TAGS n)
|
||||
(and
|
||||
(> (index-of n "-") 0)
|
||||
(> (len expr) 1)
|
||||
(= (type-of (nth expr 1)) "keyword")))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Spread — attribute injection from children into parent elements
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; A spread value is a dict of attributes that, when returned as a child
|
||||
;; of an HTML element, merges its attrs onto the parent element.
|
||||
;; This enables components to inject classes/styles/data-attrs onto their
|
||||
;; parent without the parent knowing about the specific attrs.
|
||||
;;
|
||||
;; merge-spread-attrs: merge a spread's attrs into an element's attrs dict.
|
||||
;; Class values are joined (space-separated); others overwrite.
|
||||
;; Mutates the target attrs dict in place.
|
||||
|
||||
(define merge-spread-attrs :effects [mutation]
|
||||
(fn ((target :as dict) (spread-dict :as dict))
|
||||
(define
|
||||
merge-spread-attrs
|
||||
:effects (mutation)
|
||||
(fn
|
||||
((target :as dict) (spread-dict :as dict))
|
||||
(for-each
|
||||
(fn ((key :as string))
|
||||
(let ((val (dict-get spread-dict key)))
|
||||
(if (= key "class")
|
||||
;; Class: join existing + new with space
|
||||
(let ((existing (dict-get target "class")))
|
||||
(dict-set! target "class"
|
||||
(if (and existing (not (= existing "")))
|
||||
(fn
|
||||
((key :as string))
|
||||
(let
|
||||
((val (dict-get spread-dict key)))
|
||||
(if
|
||||
(= key "class")
|
||||
(let
|
||||
((existing (dict-get target "class")))
|
||||
(dict-set!
|
||||
target
|
||||
"class"
|
||||
(if
|
||||
(and existing (not (= existing "")))
|
||||
(str existing " " val)
|
||||
val)))
|
||||
;; Style: join with semicolons
|
||||
(if (= key "style")
|
||||
(let ((existing (dict-get target "style")))
|
||||
(dict-set! target "style"
|
||||
(if (and existing (not (= existing "")))
|
||||
(if
|
||||
(= key "style")
|
||||
(let
|
||||
((existing (dict-get target "style")))
|
||||
(dict-set!
|
||||
target
|
||||
"style"
|
||||
(if
|
||||
(and existing (not (= existing "")))
|
||||
(str existing ";" val)
|
||||
val)))
|
||||
;; Everything else: overwrite
|
||||
(dict-set! target key val)))))
|
||||
(keys spread-dict))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; HTML escaping — library functions (pure text processing)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define escape-html
|
||||
(fn (s)
|
||||
(let ((r (str s)))
|
||||
(define
|
||||
escape-html
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((r (str s)))
|
||||
(set! r (replace r "&" "&"))
|
||||
(set! r (replace r "<" "<"))
|
||||
(set! r (replace r ">" ">"))
|
||||
(set! r (replace r "\"" """))
|
||||
r)))
|
||||
|
||||
(define escape-attr
|
||||
(fn (s)
|
||||
(escape-html s)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Platform interface (shared across adapters)
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; Raw HTML (marker type for unescaped content):
|
||||
;; (raw-html-content r) → unwrap RawHTML marker to string
|
||||
;;
|
||||
;; Spread (render-time attribute injection):
|
||||
;; (make-spread attrs) → Spread value
|
||||
;; (spread? x) → boolean
|
||||
;; (spread-attrs s) → dict
|
||||
;;
|
||||
;; Render-time accumulators:
|
||||
;; (collect! bucket value) → void
|
||||
;; (collected bucket) → list
|
||||
;; (clear-collected! bucket) → void
|
||||
;;
|
||||
;; Scoped effects (scope/provide/context/emit!):
|
||||
;; (scope-push! name val) → void (general form)
|
||||
;; (scope-pop! name) → void (general form)
|
||||
;; (provide-push! name val) → alias for scope-push!
|
||||
;; (provide-pop! name) → alias for scope-pop!
|
||||
;; (context name &rest def) → value from nearest scope
|
||||
;; (emit! name value) → void (append to scope accumulator)
|
||||
;; (emitted name) → list of emitted values
|
||||
;;
|
||||
;; From parser.sx:
|
||||
;; (sx-serialize val) → SX source string (aliased as serialize above)
|
||||
;; --------------------------------------------------------------------------
|
||||
(define escape-attr (fn (s) (escape-html s)))
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -35,25 +35,9 @@
|
||||
;; Named stores — page-level signal containers
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define *store-registry* (dict))
|
||||
|
||||
(define def-store :effects [mutation]
|
||||
(fn ((name :as string) (init-fn :as lambda))
|
||||
(let ((registry *store-registry*))
|
||||
(when (not (has-key? registry name))
|
||||
(set! *store-registry* (assoc registry name (cek-call init-fn nil))))
|
||||
(get *store-registry* name))))
|
||||
|
||||
(define use-store :effects []
|
||||
(fn ((name :as string))
|
||||
(if (has-key? *store-registry* name)
|
||||
(get *store-registry* name)
|
||||
(error (str "Store not found: " name
|
||||
". Call (def-store ...) before (use-store ...).")))))
|
||||
|
||||
(define clear-stores :effects [mutation]
|
||||
(fn ()
|
||||
(set! *store-registry* (dict))))
|
||||
;; def-store, use-store, clear-stores are now OCaml primitives
|
||||
;; (sx_primitives.ml) with a global mutable registry that survives
|
||||
;; env scoping across bytecode modules and island hydration.
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
@@ -1,3 +1,3 @@
|
||||
(sxbc 1 "1e908c466d2b8c22"
|
||||
(sxbc 1 "7e4a727b2f55684e"
|
||||
(code
|
||||
:constants ("with-marsh-scope" {:upvalue-count 0 :arity 2 :constants ("list" "with-island-scope" {:upvalue-count 1 :arity 1 :constants ("append!") :bytecode (20 0 0 18 0 16 0 49 2 50)} "dom-set-data" "sx-marsh-disposers") :bytecode (52 0 0 0 17 2 20 1 0 51 2 0 1 2 16 1 48 2 5 20 3 0 16 0 1 4 0 16 2 49 3 50)} "dispose-marsh-scope" {:upvalue-count 0 :arity 1 :constants ("dom-get-data" "sx-marsh-disposers" "for-each" {:upvalue-count 0 :arity 1 :constants ("cek-call") :bytecode (20 0 0 16 0 2 49 2 50)} "dom-set-data") :bytecode (20 0 0 16 0 1 1 0 48 2 17 1 16 1 33 24 0 51 3 0 16 1 52 2 0 2 5 20 4 0 16 0 1 1 0 2 49 3 32 1 0 2 50)} "*store-registry*" "dict" "def-store" {:upvalue-count 0 :arity 2 :constants ("*store-registry*" "not" "has-key?" "assoc" "cek-call" "get") :bytecode (20 0 0 17 2 16 2 16 0 52 2 0 2 52 1 0 1 33 22 0 16 2 16 0 20 4 0 16 1 2 48 2 52 3 0 3 21 0 0 32 1 0 2 5 20 0 0 16 0 52 5 0 2 50)} "use-store" {:upvalue-count 0 :arity 1 :constants ("has-key?" "*store-registry*" "get" "error" "str" "Store not found: " ". Call (def-store ...) before (use-store ...).") :bytecode (20 1 0 16 0 52 0 0 2 33 12 0 20 1 0 16 0 52 2 0 2 32 16 0 1 5 0 16 0 1 6 0 52 4 0 3 52 3 0 1 50)} "clear-stores" {:upvalue-count 0 :arity 0 :constants ("dict" "*store-registry*") :bytecode (52 0 0 0 21 1 0 50)} "emit-event" {:upvalue-count 0 :arity 3 :constants ("dom-dispatch") :bytecode (20 0 0 16 0 16 1 16 2 49 3 50)} "on-event" {:upvalue-count 0 :arity 3 :constants ("dom-on") :bytecode (20 0 0 16 0 16 1 16 2 49 3 50)} "bridge-event" {:upvalue-count 0 :arity 4 :constants ("effect" {:upvalue-count 4 :arity 0 :constants ("dom-on" {:upvalue-count 2 :arity 1 :constants ("event-detail" "cek-call" "list" "reset!") :bytecode (20 0 0 16 0 48 1 17 1 18 0 33 16 0 20 1 0 18 0 16 1 52 2 0 1 48 2 32 2 0 16 1 17 2 20 3 0 18 1 16 2 49 2 50)}) :bytecode (20 0 0 18 0 18 1 51 1 0 0 2 0 3 48 3 17 0 16 0 50)}) :bytecode (20 0 0 51 1 0 1 0 1 1 1 3 1 2 49 1 50)} "resource" {:upvalue-count 0 :arity 1 :constants ("signal" "dict" "loading" "data" "error" "promise-then" "cek-call" {:upvalue-count 1 :arity 1 :constants ("reset!" "dict" "loading" "data" "error") :bytecode (20 0 0 18 0 1 2 0 4 1 3 0 16 0 1 4 0 2 52 1 0 6 49 2 50)} {:upvalue-count 1 :arity 1 :constants ("reset!" "dict" "loading" "data" "error") :bytecode (20 0 0 18 0 1 2 0 4 1 3 0 2 1 4 0 16 0 52 1 0 6 49 2 50)}) :bytecode (20 0 0 1 2 0 3 1 3 0 2 1 4 0 2 52 1 0 6 48 1 17 1 20 5 0 20 6 0 16 0 2 48 2 51 7 0 1 1 51 8 0 1 1 48 3 5 16 1 50)}) :bytecode (51 1 0 128 0 0 5 51 3 0 128 2 0 5 52 5 0 0 128 4 0 5 51 7 0 128 6 0 5 51 9 0 128 8 0 5 51 11 0 128 10 0 5 51 13 0 128 12 0 5 51 15 0 128 14 0 5 51 17 0 128 16 0 5 51 19 0 128 18 0 50)))
|
||||
:constants ("with-marsh-scope" {:upvalue-count 0 :arity 2 :constants ("list" "with-island-scope" {:upvalue-count 1 :arity 1 :constants ("append!") :bytecode (20 0 0 18 0 16 0 49 2 50)} "dom-set-data" "sx-marsh-disposers") :bytecode (52 0 0 0 17 2 20 1 0 51 2 0 1 2 16 1 48 2 5 20 3 0 16 0 1 4 0 16 2 49 3 50)} "dispose-marsh-scope" {:upvalue-count 0 :arity 1 :constants ("dom-get-data" "sx-marsh-disposers" "for-each" {:upvalue-count 0 :arity 1 :constants ("cek-call") :bytecode (20 0 0 16 0 2 49 2 50)} "dom-set-data") :bytecode (20 0 0 16 0 1 1 0 48 2 17 1 16 1 33 24 0 51 3 0 16 1 52 2 0 2 5 20 4 0 16 0 1 1 0 2 49 3 32 1 0 2 50)} "emit-event" {:upvalue-count 0 :arity 3 :constants ("dom-dispatch") :bytecode (20 0 0 16 0 16 1 16 2 49 3 50)} "on-event" {:upvalue-count 0 :arity 3 :constants ("dom-on") :bytecode (20 0 0 16 0 16 1 16 2 49 3 50)} "bridge-event" {:upvalue-count 0 :arity 4 :constants ("effect" {:upvalue-count 4 :arity 0 :constants ("dom-on" {:upvalue-count 2 :arity 1 :constants ("event-detail" "cek-call" "list" "reset!") :bytecode (20 0 0 16 0 48 1 17 1 18 0 33 16 0 20 1 0 18 0 16 1 52 2 0 1 48 2 32 2 0 16 1 17 2 20 3 0 18 1 16 2 49 2 50)}) :bytecode (20 0 0 18 0 18 1 51 1 0 0 2 0 3 48 3 17 0 16 0 50)}) :bytecode (20 0 0 51 1 0 1 0 1 1 1 3 1 2 49 1 50)} "resource" {:upvalue-count 0 :arity 1 :constants ("signal" "dict" "loading" "data" "error" "promise-then" "cek-call" {:upvalue-count 1 :arity 1 :constants ("reset!" "dict" "loading" "data" "error") :bytecode (20 0 0 18 0 1 2 0 4 1 3 0 16 0 1 4 0 2 52 1 0 6 49 2 50)} {:upvalue-count 1 :arity 1 :constants ("reset!" "dict" "loading" "data" "error") :bytecode (20 0 0 18 0 1 2 0 4 1 3 0 2 1 4 0 16 0 52 1 0 6 49 2 50)}) :bytecode (20 0 0 1 2 0 3 1 3 0 2 1 4 0 2 52 1 0 6 48 1 17 1 20 5 0 20 6 0 16 0 2 48 2 51 7 0 1 1 51 8 0 1 1 48 3 5 16 1 50)}) :bytecode (51 1 0 128 0 0 5 51 3 0 128 2 0 5 51 5 0 128 4 0 5 51 7 0 128 6 0 5 51 9 0 128 8 0 5 51 11 0 128 10 0 50)))
|
||||
|
||||
@@ -1 +0,0 @@
|
||||
{"magic":"SXBC","version":1,"hash":"f460911b9f86fad2","module":{"arity":0,"bytecode":[51,1,0,128,0,0,5,51,3,0,128,2,0,5,52,5,0,0,128,4,0,5,51,7,0,128,6,0,5,51,9,0,128,8,0,5,51,11,0,128,10,0,5,51,13,0,128,12,0,5,51,15,0,128,14,0,5,51,17,0,128,16,0,5,51,19,0,128,18,0,50],"constants":[{"t":"s","v":"with-marsh-scope"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[52,0,0,0,17,2,20,1,0,51,2,0,20,3,0,48,2,5,20,4,0,20,5,0,1,6,0,20,7,0,49,3,50],"constants":[{"t":"s","v":"list"},{"t":"s","v":"with-island-scope"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,20,2,0,49,2,50],"constants":[{"t":"s","v":"append!"},{"t":"s","v":"disposers"},{"t":"s","v":"d"}]}},{"t":"s","v":"body-fn"},{"t":"s","v":"dom-set-data"},{"t":"s","v":"marsh-el"},{"t":"s","v":"sx-marsh-disposers"},{"t":"s","v":"disposers"}]}},{"t":"s","v":"dispose-marsh-scope"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,1,2,0,48,2,17,1,20,3,0,33,26,0,51,5,0,20,3,0,52,4,0,2,5,20,6,0,20,1,0,1,2,0,2,49,3,32,1,0,2,50],"constants":[{"t":"s","v":"dom-get-data"},{"t":"s","v":"marsh-el"},{"t":"s","v":"sx-marsh-disposers"},{"t":"s","v":"disposers"},{"t":"s","v":"for-each"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,2,49,2,50],"constants":[{"t":"s","v":"cek-call"},{"t":"s","v":"d"}]}},{"t":"s","v":"dom-set-data"}]}},{"t":"s","v":"*store-registry*"},{"t":"s","v":"dict"},{"t":"s","v":"def-store"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,17,2,20,3,0,20,4,0,52,2,0,2,52,1,0,1,33,25,0,20,3,0,20,4,0,20,6,0,20,7,0,2,48,2,52,5,0,3,21,0,0,32,1,0,2,5,20,0,0,20,4,0,52,8,0,2,50],"constants":[{"t":"s","v":"*store-registry*"},{"t":"s","v":"not"},{"t":"s","v":"has-key?"},{"t":"s","v":"registry"},{"t":"s","v":"name"},{"t":"s","v":"assoc"},{"t":"s","v":"cek-call"},{"t":"s","v":"init-fn"},{"t":"s","v":"get"}]}},{"t":"s","v":"use-store"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,1,0,20,2,0,52,0,0,2,33,13,0,20,1,0,20,2,0,52,3,0,2,32,17,0,1,6,0,20,2,0,1,7,0,52,5,0,3,52,4,0,1,50],"constants":[{"t":"s","v":"has-key?"},{"t":"s","v":"*store-registry*"},{"t":"s","v":"name"},{"t":"s","v":"get"},{"t":"s","v":"error"},{"t":"s","v":"str"},{"t":"s","v":"Store not found: "},{"t":"s","v":". Call (def-store ...) before (use-store ...)."}]}},{"t":"s","v":"clear-stores"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[52,0,0,0,21,1,0,50],"constants":[{"t":"s","v":"dict"},{"t":"s","v":"*store-registry*"}]}},{"t":"s","v":"emit-event"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,20,2,0,20,3,0,49,3,50],"constants":[{"t":"s","v":"dom-dispatch"},{"t":"s","v":"el"},{"t":"s","v":"event-name"},{"t":"s","v":"detail"}]}},{"t":"s","v":"on-event"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,20,2,0,20,3,0,49,3,50],"constants":[{"t":"s","v":"dom-on"},{"t":"s","v":"el"},{"t":"s","v":"event-name"},{"t":"s","v":"handler"}]}},{"t":"s","v":"bridge-event"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,51,1,0,49,1,50],"constants":[{"t":"s","v":"effect"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,20,2,0,51,3,0,48,3,17,0,20,4,0,50],"constants":[{"t":"s","v":"dom-on"},{"t":"s","v":"el"},{"t":"s","v":"event-name"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,48,1,17,1,20,2,0,33,18,0,20,3,0,20,2,0,20,5,0,52,4,0,1,48,2,32,3,0,20,5,0,17,2,20,6,0,20,7,0,20,8,0,49,2,50],"constants":[{"t":"s","v":"event-detail"},{"t":"s","v":"e"},{"t":"s","v":"transform-fn"},{"t":"s","v":"cek-call"},{"t":"s","v":"list"},{"t":"s","v":"detail"},{"t":"s","v":"reset!"},{"t":"s","v":"target-signal"},{"t":"s","v":"new-val"}]}},{"t":"s","v":"remove"}]}}]}},{"t":"s","v":"resource"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,1,2,0,3,1,3,0,2,1,4,0,2,52,1,0,6,48,1,17,1,20,5,0,20,6,0,20,7,0,2,48,2,51,8,0,51,9,0,48,3,5,20,10,0,50],"constants":[{"t":"s","v":"signal"},{"t":"s","v":"dict"},{"t":"s","v":"loading"},{"t":"s","v":"data"},{"t":"s","v":"error"},{"t":"s","v":"promise-then"},{"t":"s","v":"cek-call"},{"t":"s","v":"fetch-fn"},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,1,3,0,4,1,4,0,20,4,0,1,5,0,2,52,2,0,6,49,2,50],"constants":[{"t":"s","v":"reset!"},{"t":"s","v":"state"},{"t":"s","v":"dict"},{"t":"s","v":"loading"},{"t":"s","v":"data"},{"t":"s","v":"error"}]}},{"t":"code","v":{"arity":0,"upvalue-count":0,"bytecode":[20,0,0,20,1,0,1,3,0,4,1,4,0,2,1,5,0,20,6,0,52,2,0,6,49,2,50],"constants":[{"t":"s","v":"reset!"},{"t":"s","v":"state"},{"t":"s","v":"dict"},{"t":"s","v":"loading"},{"t":"s","v":"data"},{"t":"s","v":"error"},{"t":"s","v":"err"}]}},{"t":"s","v":"state"}]}}]}}
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
69
spec/tests/test-closure-isolation.sx
Normal file
69
spec/tests/test-closure-isolation.sx
Normal file
@@ -0,0 +1,69 @@
|
||||
(defsuite
|
||||
"closure-isolation"
|
||||
(deftest
|
||||
"basic factory: two closures are independent"
|
||||
(let
|
||||
((mk (fn (x) (fn () x))) (a (mk 1)) (b (mk 2)))
|
||||
(assert-equal (a) 1)
|
||||
(assert-equal (b) 2)))
|
||||
(deftest
|
||||
"factory with multiple params"
|
||||
(let
|
||||
((mk (fn (x y) (fn (s) (str x s y))))
|
||||
(a (mk "A" "1"))
|
||||
(b (mk "B" "2"))
|
||||
(c (mk "C" "3")))
|
||||
(assert-equal (a "-") "A-1")
|
||||
(assert-equal (b "-") "B-2")
|
||||
(assert-equal (c "-") "C-3")))
|
||||
(deftest
|
||||
"earlier closure unaffected by later factory call"
|
||||
(let
|
||||
((mk (fn (x y) (fn (s) (str x s y)))) (a (mk "A" "1")))
|
||||
(let
|
||||
((b (mk "B" "2")) (c (mk "C" "3")))
|
||||
(assert-equal (a "x") "Ax1")
|
||||
(assert-equal (b "x") "Bx2")
|
||||
(assert-equal (c "x") "Cx3"))))
|
||||
(deftest
|
||||
"factory with nil branch (make-page-fn pattern)"
|
||||
(let
|
||||
((mk (fn (default prefix suffix) (fn (slug) (if (nil? slug) default (str prefix slug suffix)))))
|
||||
(examples (mk "EX-DEFAULT" "EX-" ""))
|
||||
(sxtp (mk "SX-DEFAULT" "SX-" "-content")))
|
||||
(assert-equal (examples nil) "EX-DEFAULT")
|
||||
(assert-equal (examples "counter") "EX-counter")
|
||||
(assert-equal (sxtp nil) "SX-DEFAULT")
|
||||
(assert-equal (sxtp "overview") "SX-overview-content")
|
||||
(assert-equal (examples nil) "EX-DEFAULT")))
|
||||
(deftest
|
||||
"ten closures from same factory all independent"
|
||||
(let
|
||||
((mk (fn (tag) (fn () tag)))
|
||||
(fns (map mk (list "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"))))
|
||||
(assert-equal
|
||||
(map (fn (f) (f)) fns)
|
||||
(list "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"))))
|
||||
(deftest
|
||||
"nested factory: inner closures independent"
|
||||
(let
|
||||
((outer (fn (x) (fn (y) (fn () (str x y))))))
|
||||
(let
|
||||
((a (outer "A")) (b (outer "B")))
|
||||
(let
|
||||
((a1 (a "1")) (a2 (a "2")) (b1 (b "1")))
|
||||
(assert-equal (a1) "A1")
|
||||
(assert-equal (a2) "A2")
|
||||
(assert-equal (b1) "B1")
|
||||
(assert-equal (a1) "A1")))))
|
||||
(deftest
|
||||
"closure captures survive across define"
|
||||
(do
|
||||
(define _ci-mk (fn (x y) (fn (s) (str x s y))))
|
||||
(define _ci-f1 (_ci-mk "A" "1"))
|
||||
(define _ci-f2 (_ci-mk "B" "2"))
|
||||
(define _ci-f3 (_ci-mk "C" "3"))
|
||||
(assert-equal (_ci-f1 "-") "A-1")
|
||||
(assert-equal (_ci-f2 "-") "B-2")
|
||||
(assert-equal (_ci-f3 "-") "C-3")
|
||||
(assert-equal (_ci-f1 "x") "Ax1"))))
|
||||
@@ -130,7 +130,7 @@
|
||||
(render-html-component val args env)
|
||||
(macro? val)
|
||||
(render-to-html (expand-macro val args env) env)
|
||||
:else (error (str "Unknown component: " name))))
|
||||
:else (str "<!-- unknown component: " name " -->")))
|
||||
(render-html-form? name)
|
||||
(dispatch-html-form name expr env)
|
||||
(and (env-has? env name) (macro? (env-get env name)))
|
||||
|
||||
Reference in New Issue
Block a user