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

hs: query targets, prolog hook, loop scripts, new plans, WASM regen

Browse Source 
Hyperscript compiler/runtime:
- query target support in set/fire/put commands
- hs-set-prolog-hook! / hs-prolog-hook / hs-prolog in runtime
- runtime log-capture cleanup

Scripts: sx-loops-up/down, sx-hs-e-up/down, sx-primitives-down
Plans: datalog, elixir, elm, go, koka, minikanren, ocaml, hs-bucket-f,
       designs (breakpoint, null-safety, step-limit, tell, cookies, eval,
       plugin-system)
lib/prolog/hs-bridge.sx: initial hook-based bridge draft
lib/common-lisp/tests/runtime.sx: CL runtime tests

WASM: regenerate sx_browser.bc.js from updated hs sources

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-06 09:19:56 +00:00
parent c311d4ebc4
commit 985671cd76
31 changed files with 16041 additions and 7056 deletions
Download Patch File Download Diff File Expand all files Collapse all files

204
shared/static/wasm/sx/hs-compiler.sx
View File

@@ -274,17 +274,33 @@
((name (nth ast 1)) (rest-parts (rest (rest ast))))
(cond
((and (= (len ast) 4) (list? (nth ast 2)) (= (first (nth ast 2)) (quote dict)))
(list
(quote dom-dispatch)
(hs-to-sx (nth ast 3))
name
(hs-to-sx (nth ast 2))))
(let
((tgt-ast (nth ast 3)))
(list
(quote dom-dispatch)
(if
(and (list? tgt-ast) (= (first tgt-ast) (quote query)))
(list
(quote hs-named-target)
(nth tgt-ast 1)
(list (quote hs-query-first) (nth tgt-ast 1)))
(hs-to-sx tgt-ast))
name
(hs-to-sx (nth ast 2)))))
((= (len ast) 3)
(list
(quote dom-dispatch)
(hs-to-sx (nth ast 2))
name
(list (quote dict) "sender" (quote me))))
(let
((tgt-ast (nth ast 2)))
(list
(quote dom-dispatch)
(if
(and (list? tgt-ast) (= (first tgt-ast) (quote query)))
(list
(quote hs-named-target)
(nth tgt-ast 1)
(list (quote hs-query-first) (nth tgt-ast 1)))
(hs-to-sx tgt-ast))
name
(list (quote dict) "sender" (quote me)))))
(true
(list
(quote dom-dispatch)
@@ -1226,12 +1242,21 @@
(if
(and (list? raw-tgt) (= (first raw-tgt) (quote query)))
(list
(quote for-each)
(quote let)
(list
(quote fn)
(list (quote _el))
(list (quote dom-add-class) (quote _el) (nth ast 1)))
(list (quote hs-query-all) (nth raw-tgt 1)))
(list
(quote _tgt)
(list (quote hs-query-named-all) (nth raw-tgt 1))))
(list
(quote for-each)
(list
(quote fn)
(list (quote _el))
(list
(quote dom-add-class)
(quote _el)
(nth ast 1)))
(quote _tgt)))
(list
(quote dom-add-class)
(hs-to-sx raw-tgt)
@@ -1244,14 +1269,20 @@
(nth ast 2)))
((= head (quote set-styles))
(let
((pairs (nth ast 1)) (tgt (hs-to-sx (nth ast 2))))
(cons
(quote do)
(map
(fn
(p)
(list (quote dom-set-style) tgt (first p) (nth p 1)))
pairs))))
((pairs (nth ast 1)) (tgt-ast (nth ast 2)))
(let
((tgt (if (and (list? tgt-ast) (= (first tgt-ast) (quote query))) (list (quote hs-named-target) (nth tgt-ast 1) (list (quote hs-query-first) (nth tgt-ast 1))) (hs-to-sx tgt-ast))))
(cons
(quote do)
(map
(fn
(p)
(list
(quote dom-set-style)
tgt
(first p)
(nth p 1)))
pairs)))))
((= head (quote multi-add-class))
(let
((target (hs-to-sx (nth ast 1)))
@@ -1349,15 +1380,21 @@
(if
(and (list? raw-tgt) (= (first raw-tgt) (quote query)))
(list
(quote for-each)
(quote let)
(list
(quote fn)
(list (quote _el))
(list
(quote dom-remove-class)
(quote _el)
(nth ast 1)))
(list (quote hs-query-all) (nth raw-tgt 1)))
(quote _tgt)
(list (quote hs-query-named-all) (nth raw-tgt 1))))
(list
(quote for-each)
(list
(quote fn)
(list (quote _el))
(list
(quote dom-remove-class)
(quote _el)
(nth ast 1)))
(quote _tgt)))
(list
(quote dom-remove-class)
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
@@ -1398,10 +1435,18 @@
(list (quote hs-add-to!) val (hs-to-sx tgt)))))
((= head (quote add-attr))
(let
((tgt (nth ast 3)))
((tgt-ast tgt))
(list
(quote hs-set-attr!)
(hs-to-sx tgt)
(if
(and
(list? tgt-ast)
(= (first tgt-ast) (quote query)))
(list
(quote hs-named-target)
(nth tgt-ast 1)
(list (quote hs-query-first) (nth tgt-ast 1)))
(hs-to-sx tgt-ast))
(nth ast 1)
(hs-to-sx (nth ast 2)))))
((= head (quote remove-value))
@@ -1452,10 +1497,20 @@
(fn (p) (list (quote dom-set-style) tgt p ""))
props))))
((= head (quote toggle-class))
(list
(quote hs-toggle-class!)
(hs-to-sx (nth ast 2))
(nth ast 1)))
(let
((tgt-ast (nth ast 2)))
(list
(quote hs-toggle-class!)
(if
(and
(list? tgt-ast)
(= (first tgt-ast) (quote query)))
(list
(quote hs-named-target)
(nth tgt-ast 1)
(list (quote hs-query-first) (nth tgt-ast 1)))
(hs-to-sx tgt-ast))
(nth ast 1))))
((= head (quote toggle-class-for))
(list
(quote do)
@@ -1510,11 +1565,21 @@
(hs-to-sx tgt-ast)
(hs-to-sx val-ast)))))
((= head (quote toggle-between))
(list
(quote hs-toggle-between!)
(hs-to-sx (nth ast 3))
(nth ast 1)
(nth ast 2)))
(let
((tgt-ast (nth ast 3)))
(list
(quote hs-toggle-between!)
(if
(and
(list? tgt-ast)
(= (first tgt-ast) (quote query)))
(list
(quote hs-named-target)
(nth tgt-ast 1)
(list (quote hs-query-first) (nth tgt-ast 1)))
(hs-to-sx tgt-ast))
(nth ast 1)
(nth ast 2))))
((= head (quote toggle-style))
(let
((raw-tgt (nth ast 2)))
@@ -1538,10 +1603,20 @@
(quote list)
(map hs-to-sx (slice ast 3 (len ast))))))
((= head (quote toggle-attr))
(list
(quote hs-toggle-attr!)
(hs-to-sx (nth ast 2))
(nth ast 1)))
(let
((tgt-ast (nth ast 2)))
(list
(quote hs-toggle-attr!)
(if
(and
(list? tgt-ast)
(= (first tgt-ast) (quote query)))
(list
(quote hs-named-target)
(nth tgt-ast 1)
(list (quote hs-query-first) (nth tgt-ast 1)))
(hs-to-sx tgt-ast))
(nth ast 1))))
((= head (quote toggle-attr-between))
(list
(quote hs-toggle-attr-between!)
@@ -1575,7 +1650,22 @@
(emit-set
raw-tgt
(list (quote hs-put-at!) val pos (hs-to-sx raw-tgt))))
(true (list (quote hs-put!) val pos (hs-to-sx raw-tgt))))))
(true
(let
((tgt-ast raw-tgt))
(list
(quote hs-put!)
val
pos
(if
(and
(list? tgt-ast)
(= (first tgt-ast) (quote query)))
(list
(quote hs-named-target)
(nth tgt-ast 1)
(list (quote hs-query-first) (nth tgt-ast 1)))
(hs-to-sx tgt-ast))))))))
((= head (quote if))
(if
(> (len ast) 3)
@@ -1651,12 +1741,22 @@
(detail (if (= (len ast) 4) (nth ast 2) nil)))
(list
(quote dom-dispatch)
(hs-to-sx tgt)
(let
((tgt-ast tgt))
(if
(and
(list? tgt-ast)
(= (first tgt-ast) (quote query)))
(list
(quote hs-named-target)
(nth tgt-ast 1)
(list (quote hs-query-first) (nth tgt-ast 1)))
(hs-to-sx tgt-ast)))
name
(if has-detail (hs-to-sx detail) nil))))
((= head (quote hide))
(let
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-named-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
(if
@@ -1672,7 +1772,7 @@
(hs-to-sx when-cond))))))
((= head (quote show))
(let
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-named-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
(if
@@ -1874,7 +1974,11 @@
((= head (quote install))
(cons (quote hs-install) (map hs-to-sx (rest ast))))
((= head (quote measure))
(list (quote hs-measure) (hs-to-sx (nth ast 1))))
(let
((raw-tgt (nth ast 1)))
(let
((compiled-tgt (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-named-target) (nth raw-tgt 1) (list (quote hs-query-first) (nth raw-tgt 1))) (hs-to-sx raw-tgt))))
(list (quote hs-measure) compiled-tgt))))
((= head (quote increment!))
(if
(= (len ast) 3)

29
shared/static/wasm/sx/hs-runtime.sx
View File

@@ -2466,6 +2466,35 @@
((nth entry 2) val)))
_hs-dom-watchers)))
(define
hs-null-error!
(fn (selector) (raise (str "'" selector "' is null"))))
(define
hs-named-target
(fn (selector value) (if (nil? value) (hs-null-error! selector) value)))
(define
hs-named-target-list
(fn
(selector values)
(if (nil? values) (hs-null-error! selector) values)))
(define
hs-query-named-all
(fn
(selector)
(let
((results (hs-query-all selector)))
(if
(and
(or (nil? results) (and (list? results) (= (len results) 0)))
(string? selector)
(> (len selector) 0)
(= (substring selector 0 1) "#"))
(hs-null-error! selector)
results))))
(define
hs-dom-is-ancestor?
(fn

19003
shared/static/wasm/sx_browser.bc.js
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx_browser.bc.wasm.js
View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
}
(globalThis))
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-f783241f",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-30cab65c",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-3a32ee22",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-456e4a54",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new