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

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:
2026-05-06 09:19:56 +00:00
parent c311d4ebc4
commit 985671cd76
31 changed files with 16041 additions and 7056 deletions

View File

@@ -48,6 +48,15 @@
prop
value))
(list (quote hs-query-all) (nth base-ast 1))))
((and (list? base-ast) (= (first base-ast) (quote query)))
(list
(quote dom-set-prop)
(list
(quote hs-named-target)
(nth base-ast 1)
(list (quote hs-query-first) (nth base-ast 1)))
prop
value))
((and (list? base-ast) (= (first base-ast) dot-sym) (let ((inner (nth base-ast 1))) (and (list? inner) (= (first inner) (quote query)) (let ((s (nth inner 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))))
(let
((inner (nth base-ast 1))
@@ -146,6 +155,14 @@
(nth prop-ast 1)
value)
(list (quote set!) (hs-to-sx target) value))))))
((= th (quote query))
(list
(quote hs-set-inner-html!)
(list
(quote hs-named-target)
(nth target 1)
(list (quote hs-query-first) (nth target 1)))
value))
(true (list (quote set!) (hs-to-sx target) value)))))))
(define
emit-on
@@ -274,17 +291,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)
@@ -706,6 +739,33 @@
(quote fn)
(cons (quote me) (map make-symbol params))
(cons (quote do) (map hs-to-sx body)))))))
(define
hs-safe-obj
(fn
(obj-ast)
(if
(and (list? obj-ast) (= (first obj-ast) (quote ref)))
(list (quote host-global) (nth obj-ast 1))
(if
(and (list? obj-ast) (= (first obj-ast) dot-sym))
(let
((inner (nth obj-ast 1)) (prop (nth obj-ast 2)))
(list (quote host-get) (hs-safe-obj inner) prop))
(hs-to-sx obj-ast)))))
(define
hs-chain-name
(fn
(obj-ast)
(if
(and (list? obj-ast) (= (first obj-ast) (quote ref)))
(nth obj-ast 1)
(if
(and (list? obj-ast) (= (first obj-ast) dot-sym))
(str (hs-chain-name (nth obj-ast 1)) "." (nth obj-ast 2))
(if
(and (list? obj-ast) (= (first obj-ast) (quote query)))
(nth obj-ast 1)
nil)))))
(fn
(ast)
(cond
@@ -1226,12 +1286,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 +1313,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 +1424,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))
@@ -1401,15 +1482,32 @@
((tgt (nth ast 3)))
(list
(quote hs-set-attr!)
(hs-to-sx tgt)
(if
(and (list? tgt) (= (first tgt) (quote query)))
(list
(quote hs-named-target)
(nth tgt 1)
(list (quote hs-query-first) (nth tgt 1)))
(hs-to-sx tgt))
(nth ast 1)
(hs-to-sx (nth ast 2)))))
((= head (quote remove-value))
(let
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
((val (hs-to-sx (nth ast 1))) (raw-tgt (nth ast 2)))
(emit-set
tgt
(list (quote hs-remove-from!) val (hs-to-sx tgt)))))
raw-tgt
(list
(quote hs-remove-from!)
val
(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))))))
((= head (quote empty-target))
(let
((tgt (nth ast 1)))
@@ -1440,8 +1538,19 @@
(hs-to-sx (nth ast 2))))
((= head (quote remove-attr))
(let
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))))
(list (quote dom-remove-attr) tgt (nth ast 1))))
((raw-tgt (nth ast 2)))
(list
(quote dom-remove-attr)
(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)))
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt)))
(nth ast 1))))
((= head (quote remove-css))
(let
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2))))
@@ -1452,10 +1561,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 +1629,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 +1667,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 +1714,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 +1805,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 +1836,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
@@ -1735,13 +1899,28 @@
((= head (quote call))
(let
((raw-fn (nth ast 1))
(fn-expr
(if
(string? raw-fn)
(make-symbol raw-fn)
(hs-to-sx raw-fn)))
(args (map hs-to-sx (rest (rest ast)))))
(cons fn-expr args)))
(if
(and (list? raw-fn) (= (first raw-fn) (quote ref)))
(let
((name (nth raw-fn 1)))
(list
(quote let)
(list
(list
(quote __hs-fn)
(list (quote host-global) name)))
(cons
(quote do)
(list
(list
(quote if)
(list (quote nil?) (quote __hs-fn))
(list (quote raise) (str "'" name "' is null"))
(cons (quote __hs-fn) args))))))
(let
((fn-expr (if (string? raw-fn) (make-symbol raw-fn) (hs-to-sx raw-fn))))
(cons fn-expr args)))))
((= head (quote return))
(let
((val (nth ast 1)))
@@ -1754,7 +1933,22 @@
((= head (quote throw))
(list (quote raise) (hs-to-sx (nth ast 1))))
((= head (quote settle))
(list (quote hs-settle) (quote me)))
(let
((raw-tgt (nth ast 1)))
(list
(quote hs-settle)
(if
(nil? raw-tgt)
(quote me)
(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))))))
((= head (quote go))
(list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
((= head (quote ask))
@@ -1874,7 +2068,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)