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

Fix signal-add-sub! losing subscribers after remove, fix build pipeline

Browse Source 
signal-add-sub! used (append! subscribers f) which returns a new list
for immutable List but discards the result — after signal-remove-sub!
replaces the subscribers list via dict-set!, re-adding subscribers
silently fails. Counter island only worked once (0→1 then stuck).

Fix: use (dict-set! s "subscribers" (append ...)) to explicitly update
the dict field, matching signal-remove-sub!'s pattern.

Build pipeline fixes:
- sx-build-all.sh now bundles spec→dist and recompiles .sxbc bytecode
- compile-modules.js syncs .sx source files alongside .sxbc to wasm/sx/
- Per-file cache busting: wasm, platform JS, and sxbc each get own hash
- bundle.sh adds cssx.sx to dist

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-31 07:36:36 +00:00
parent 5abc947ac7
commit 9ce8659f74
12 changed files with 439 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1597,6 +1597,8 @@ let http_render_page env path headers =
Keyword "sx-css-classes"; get_shell "sx-css-classes";
Keyword "asset-url"; get_shell "asset-url";
Keyword "wasm-hash"; get_shell "wasm-hash";
Keyword "platform-hash"; get_shell "platform-hash";
Keyword "sxbc-hash"; get_shell "sxbc-hash";
Keyword "inline-css"; get_shell "inline-css";
Keyword "inline-head-js"; get_shell "inline-head-js";
Keyword "init-sx"; get_shell "init-sx";
@@ -1678,6 +1680,20 @@ let file_hash path =
String.sub (Digest.string (In_channel.with_open_bin path In_channel.input_all) |> Digest.to_hex) 0 12
else ""
let sxbc_combined_hash dir =
let sxbc_dir = dir ^ "/sx" in
if Sys.file_exists sxbc_dir && Sys.is_directory sxbc_dir then begin
let files = Array.to_list (Sys.readdir sxbc_dir) in
let sxbc_files = List.filter (fun f -> Filename.check_suffix f ".sxbc") files in
let sorted = List.sort String.compare sxbc_files in
let buf = Buffer.create 65536 in
List.iter (fun f ->
let path = sxbc_dir ^ "/" ^ f in
Buffer.add_string buf (In_channel.with_open_bin path In_channel.input_all)
) sorted;
String.sub (Digest.string (Buffer.contents buf) |> Digest.to_hex) 0 12
end else ""
let read_css_file path =
if Sys.file_exists path then
In_channel.with_open_text path In_channel.input_all
@@ -1726,8 +1742,10 @@ let http_inject_shell_statics env static_dir sx_sxc =
literals, preventing the HTML parser from matching </script>. *)
let component_defs = raw_defs in
let component_hash = Digest.string component_defs |> Digest.to_hex in
(* Compute file hashes for cache busting *)
(* Compute per-file hashes for cache busting *)
let wasm_hash = file_hash (static_dir ^ "/wasm/sx_browser.bc.wasm.js") in
let platform_hash = file_hash (static_dir ^ "/wasm/sx-platform-2.js") in
let sxbc_hash = sxbc_combined_hash (static_dir ^ "/wasm") in
(* Read CSS for inline injection *)
let tw_css = read_css_file (static_dir ^ "/styles/tw.css") in
let basics_css = read_css_file (static_dir ^ "/styles/basics.css") in
@@ -1781,6 +1799,8 @@ let http_inject_shell_statics env static_dir sx_sxc =
ignore (env_bind env "__shell-sx-css-classes" (String ""));
ignore (env_bind env "__shell-asset-url" (String "/static"));
ignore (env_bind env "__shell-wasm-hash" (String wasm_hash));
ignore (env_bind env "__shell-platform-hash" (String platform_hash));
ignore (env_bind env "__shell-sxbc-hash" (String sxbc_hash));
ignore (env_bind env "__shell-inline-css" Nil);
ignore (env_bind env "__shell-inline-head-js" Nil);
(* init-sx: trigger client-side render when sx-root is empty (SSR failed).
@@ -1793,8 +1813,8 @@ let http_inject_shell_statics env static_dir sx_sxc =
SX.renderPage(); \
} \
});"));
Printf.eprintf "[sx-http] Shell statics: defs=%d hash=%s css=%d wasm=%s\n%!"
(String.length component_defs) component_hash (String.length sx_css) wasm_hash
Printf.eprintf "[sx-http] Shell statics: defs=%d hash=%s css=%d wasm=%s platform=%s sxbc=%s\n%!"
(String.length component_defs) component_hash (String.length sx_css) wasm_hash platform_hash sxbc_hash
let http_setup_declarative_stubs env =
(* Stub declarative forms that are metadata-only — no-ops at render time. *)

3
hosts/ocaml/browser/bundle.sh
View File

@@ -65,6 +65,9 @@ cp "$ROOT/web/engine.sx" "$DIST/sx/"
cp "$ROOT/web/orchestration.sx" "$DIST/sx/"
cp "$ROOT/web/boot.sx" "$DIST/sx/"
# 9. CSSX (stylesheet language)
cp "$ROOT/sx/sx/cssx.sx" "$DIST/sx/"
# Summary
WASM_SIZE=$(du -sh "$DIST/sx_browser.bc.wasm.assets" | cut -f1)
JS_SIZE=$(du -sh "$DIST/sx_browser.bc.js" | cut -f1)

8
hosts/ocaml/browser/compile-modules.js
View File

@@ -185,6 +185,7 @@ const staticSxDir = path.resolve(__dirname, '..', '..', '..', 'shared', 'static'
if (fs.existsSync(staticSxDir)) {
let copied = 0;
for (const file of FILES) {
// Copy bytecode
for (const ext of ['.sxbc', '.sxbc.json']) {
const src = path.join(sxDir, file.replace(/\.sx$/, ext));
const dst = path.join(staticSxDir, file.replace(/\.sx$/, ext));
@@ -193,6 +194,13 @@ if (fs.existsSync(staticSxDir)) {
copied++;
}
}
// Also sync .sx source files (fallback when .sxbc missing)
const sxSrc = path.join(sxDir, file);
const sxDst = path.join(staticSxDir, file);
if (fs.existsSync(sxSrc) && !fs.lstatSync(sxSrc).isSymbolicLink()) {
fs.copyFileSync(sxSrc, sxDst);
copied++;
}
}
console.log('Copied', copied, 'files to', staticSxDir);
}

10
hosts/ocaml/browser/sx-platform.js
View File

@@ -180,8 +180,12 @@
var _baseUrl = "";
// Detect base URL from current script
// Detect base URL and cache-bust params from current script tag.
// _cacheBust comes from the script's own ?v= query string (used for .sx source fallback).
// _sxbcCacheBust comes from data-sxbc-hash attribute — a separate content hash
// covering all .sxbc files so each file gets its own correct cache buster.
var _cacheBust = "";
var _sxbcCacheBust = "";
(function() {
if (typeof document !== "undefined") {
var scripts = document.getElementsByTagName("script");
@@ -191,6 +195,8 @@
_baseUrl = src.substring(0, src.lastIndexOf("/") + 1);
var qi = src.indexOf("?");
if (qi !== -1) _cacheBust = src.substring(qi);
var sxbcHash = scripts[i].getAttribute("data-sxbc-hash");
if (sxbcHash) _sxbcCacheBust = "?v=" + sxbcHash;
break;
}
}
@@ -233,7 +239,7 @@
*/
function loadBytecodeFile(path) {
var bcPath = path.replace(/\.sx$/, '.sxbc.json');
var url = _baseUrl + bcPath + _cacheBust;
var url = _baseUrl + bcPath + _sxbcCacheBust;
try {
var xhr = new XMLHttpRequest();
xhr.open("GET", url, false);

21
scripts/sx-build-all.sh
View File

@@ -15,6 +15,27 @@ cp -r "$OCAML_BUILD/sx_browser.bc.wasm.assets" shared/static/wasm/
echo " WASM loader: $(du -sh shared/static/wasm/sx_browser.bc.wasm.js | cut -f1)"
echo " JS fallback: $(du -sh shared/static/wasm/sx_browser.bc.js | cut -f1)"
echo "=== Sync spec .sx to dist (canonical → dist) ==="
cp spec/signals.sx hosts/ocaml/browser/dist/sx/core-signals.sx
cp spec/render.sx hosts/ocaml/browser/dist/sx/
cp spec/harness.sx hosts/ocaml/browser/dist/sx/
echo " spec → dist: 3 files"
echo "=== Sync web .sx to dist (wasm/sx → dist) ==="
for f in signals.sx deps.sx router.sx page-helpers.sx freeze.sx \
bytecode.sx compiler.sx vm.sx dom.sx browser.sx \
adapter-html.sx adapter-sx.sx adapter-dom.sx \
boot-helpers.sx hypersx.sx harness-reactive.sx harness-web.sx \
engine.sx orchestration.sx boot.sx cssx.sx; do
if [ -f "shared/static/wasm/sx/$f" ]; then
cp "shared/static/wasm/sx/$f" "hosts/ocaml/browser/dist/sx/"
fi
done
echo " wasm/sx → dist: web files synced"
echo "=== Recompile .sxbc bytecode ==="
node hosts/ocaml/browser/compile-modules.js || { echo "FAIL: sxbc compile"; exit 1; }
echo "=== JS browser build ==="
python3 hosts/javascript/cli.py --output shared/static/scripts/sx-browser.js || { echo "FAIL: JS build"; exit 1; }
echo "=== JS test build ==="

10
shared/static/wasm/sx-platform-2.js
View File

@@ -180,8 +180,12 @@
var _baseUrl = "";
// Detect base URL from current script
// Detect base URL and cache-bust params from current script tag.
// _cacheBust comes from the script's own ?v= query string (used for .sx source fallback).
// _sxbcCacheBust comes from data-sxbc-hash attribute — a separate content hash
// covering all .sxbc files so each file gets its own correct cache buster.
var _cacheBust = "";
var _sxbcCacheBust = "";
(function() {
if (typeof document !== "undefined") {
var scripts = document.getElementsByTagName("script");
@@ -191,6 +195,8 @@
_baseUrl = src.substring(0, src.lastIndexOf("/") + 1);
var qi = src.indexOf("?");
if (qi !== -1) _cacheBust = src.substring(qi);
var sxbcHash = scripts[i].getAttribute("data-sxbc-hash");
if (sxbcHash) _sxbcCacheBust = "?v=" + sxbcHash;
break;
}
}
@@ -239,7 +245,7 @@
// Try .sxbc (SX s-expression format, loaded via load-sxbc primitive)
var sxbcPath = path.replace(/\.sx$/, '.sxbc');
var sxbcUrl = _baseUrl + sxbcPath + _cacheBust;
var sxbcUrl = _baseUrl + sxbcPath + _sxbcCacheBust;
try {
var xhr2 = new XMLHttpRequest();
xhr2.open("GET", sxbcUrl, false);

180
shared/static/wasm/sx/core-signals.sx
View File

@@ -1,4 +1,8 @@
(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"))))
@@ -8,38 +12,184 @@
(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))
(dict-set! s "subscribers" (append (get s "subscribers") (list f))))))
(define signal-remove-sub! (fn (s f) (dict-set! s "subscribers" (filter (fn (sub) (not (identical? sub f))) (get s "subscribers")))))
(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 (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
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 (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
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)) (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
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 dict))
(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))))))

4
shared/static/wasm/sx/core-signals.sxbc
View File

File diff suppressed because one or more lines are too long

25
shared/sx/helpers.py
View File

@@ -883,7 +883,9 @@ def _get_shell_static() -> dict[str, Any]:
pages_sx=pages_sx,
sx_css=sx_css,
sx_css_classes=sx_css_classes,
wasm_hash=_wasm_hash("sx_browser.bc.js"),
wasm_hash=_wasm_hash("sx_browser.bc.wasm.js"),
platform_hash=_wasm_hash("sx-platform-2.js"),
sxbc_hash=_sxbc_hash(),
asset_url=_ca.config.get("ASSET_URL", "/static"),
inline_css=_shell_cfg.get("inline_css"),
inline_head_js=_shell_cfg.get("inline_head_js"),
@@ -1032,7 +1034,9 @@ def sx_page_streaming_parts(ctx: dict, page_html: str, *,
from quart import current_app
pages_sx = _build_pages_sx(current_app.name)
wasm_hash = _wasm_hash("sx_browser.bc.js")
wasm_hash = _wasm_hash("sx_browser.bc.wasm.js")
platform_hash = _wasm_hash("sx-platform-2.js")
sxbc_hash = _sxbc_hash()
# Shell: head + body with server-rendered HTML (not SX mount script)
shell = (
@@ -1074,7 +1078,7 @@ def sx_page_streaming_parts(ctx: dict, page_html: str, *,
tail = (
_SX_STREAMING_BOOTSTRAP + '\n'
+ f'<script src="{asset_url}/wasm/sx_browser.bc.wasm.js?v={wasm_hash}"></script>\n'
f'<script src="{asset_url}/wasm/sx-platform.js?v={wasm_hash}"></script>\n'
f'<script src="{asset_url}/wasm/sx-platform-2.js?v={platform_hash}" data-sxbc-hash="{sxbc_hash}"></script>\n'
)
return shell, tail
@@ -1124,6 +1128,21 @@ def _wasm_hash(filename: str) -> str:
return _SCRIPT_HASH_CACHE[key]
def _sxbc_hash() -> str:
"""Compute combined MD5 hash of all .sxbc files, cached for process lifetime."""
key = "sxbc/_combined"
if key not in _SCRIPT_HASH_CACHE:
try:
sxbc_dir = Path(__file__).resolve().parent.parent / "static" / "wasm" / "sx"
h = hashlib.md5()
for p in sorted(sxbc_dir.glob("*.sxbc")):
h.update(p.read_bytes())
_SCRIPT_HASH_CACHE[key] = h.hexdigest()[:8]
except OSError:
_SCRIPT_HASH_CACHE[key] = "dev"
return _SCRIPT_HASH_CACHE[key]
def _get_csrf_token() -> str:
"""Get the CSRF token from the current request context."""
try:

4
shared/sx/ocaml_bridge.py
View File

@@ -190,7 +190,8 @@ class OcamlBridge:
# Only inject small, safe values as kernel variables.
# Large/complex blobs use placeholder tokens at render time.
for key in ("component_hash", "sx_css_classes", "asset_url",
"sx_js_hash", "body_js_hash", "wasm_hash"):
"sx_js_hash", "body_js_hash", "wasm_hash",
"platform_hash", "sxbc_hash"):
val = static.get(key) or ""
var = f"__shell-{key.replace('_', '-')}"
defn = f'(define {var} "{_escape(str(val))}")'
@@ -269,6 +270,7 @@ class OcamlBridge:
placeholders = {}
static_keys = {"component_hash", "sx_css_classes", "asset_url",
"sx_js_hash", "body_js_hash", "wasm_hash",
"platform_hash", "sxbc_hash",
"head_scripts", "body_scripts"}
# page_source is SX wire format that may contain \" escapes.
# Send via binary blob protocol to avoid double-escaping

16
shared/sx/templates/shell.sx
View File

@@ -13,6 +13,8 @@
(body-html :as string?)
(asset-url :as string)
(wasm-hash :as string?)
(platform-hash :as string?)
(sxbc-hash :as string?)
(inline-css :as string?)
(inline-head-js :as string?)
(init-sx :as string?))
@@ -74,8 +76,12 @@
:type "text/sx"
:data-mount "#sx-root"
(raw! (or page-sx "")))
(let
((wv (or wasm-hash "0")))
(<>
(script :src (str asset-url "/wasm/sx_browser.bc.wasm.js?v=" wv))
(script :src (str asset-url "/wasm/sx-platform-2.js?v=" wv))))))))
(<>
(script
:src (str
asset-url
"/wasm/sx_browser.bc.wasm.js?v="
(or wasm-hash "0")))
(script
:src (str asset-url "/wasm/sx-platform-2.js?v=" (or platform-hash "0"))
:data-sxbc-hash (or sxbc-hash "0")))))))

180
spec/signals.sx
View File

@@ -1,4 +1,8 @@
(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"))))
@@ -8,38 +12,184 @@
(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))
(dict-set! s "subscribers" (append (get s "subscribers") (list f))))))
(define signal-remove-sub! (fn (s f) (dict-set! s "subscribers" (filter (fn (sub) (not (identical? sub f))) (get s "subscribers")))))
(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 (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
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 (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
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)) (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
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 dict))
(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))))))