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

HS: collectionExpressions +4 (then on click, undefined where, component template)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 11m0s
Details

Browse Source 
- parser: nil return in parse-cmd for feature keywords (on/init/def/behavior/live)
  so "then on click" correctly hands off to outer coll-feats loop
- compiler: cek-try wrap for undefined variable refs in coll-where compilation
  so "doesNotExist where it > 1" returns nil instead of throwing
- integration: hs-activate! detects script[type=text/hyperscript-template] and
  applies handler to DOM instances via hs-query-all(component attr) not to script el

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-04 13:31:29 +00:00
parent 51bc075da5
commit 73e86fa8e8
6 changed files with 333 additions and 279 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
lib/hyperscript/compiler.sx
View File

@@ -1107,13 +1107,21 @@
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(nth ast 2))) (nth ast 2)))
((= head (quote coll-where)) ((= head (quote coll-where))
(list (let
(quote filter) ((raw-coll (hs-to-sx (nth ast 1))))
(list (list
(quote fn) (quote filter)
(list (quote it)) (list
(hs-to-sx (nth ast 2))) (quote fn)
(hs-to-sx (nth ast 1)))) (list (quote it))
(hs-to-sx (nth ast 2)))
(if
(symbol? raw-coll)
(list
(quote cek-try)
(list (quote fn) (list) raw-coll)
(list (quote fn) (list (quote _e)) nil))
raw-coll))))
((= head (quote coll-sorted)) ((= head (quote coll-sorted))
(list (list
(quote hs-sorted-by) (quote hs-sorted-by)

10
lib/hyperscript/integration.sx
View File

@@ -115,7 +115,15 @@
(dom-set-data el "hs-script" src) (dom-set-data el "hs-script" src)
(dom-set-data el "hs-active" true) (dom-set-data el "hs-active" true)
(dom-set-attr el "data-hyperscript-powered" "true") (dom-set-attr el "data-hyperscript-powered" "true")
(let ((handler (hs-handler src))) (handler el)) (let
((handler (hs-handler src)))
(let
((el-type (dom-get-attr el "type"))
(comp-name (dom-get-attr el "component")))
(if
(= el-type "text/hyperscript-template")
(for-each handler (hs-query-all (or comp-name "")))
(handler el))))
(dom-dispatch el "hyperscript:after:init" nil))))))) (dom-dispatch el "hyperscript:after:init" nil)))))))
;; ── Boot subtree: for dynamic content ─────────────────────────── ;; ── Boot subtree: for dynamic content ───────────────────────────

2
lib/hyperscript/parser.sx
View File

@@ -2783,6 +2783,8 @@
((body (parse-cmd-list))) ((body (parse-cmd-list)))
(match-kw "end") (match-kw "end")
(list (quote view-transition!) using body))))) (list (quote view-transition!) using body)))))
((and (= typ "keyword") (or (= val "on") (= val "init") (= val "def") (= val "behavior") (= val "live")))
nil)
(true (parse-expr)))))) (true (parse-expr))))))
(define (define
parse-cmd-list parse-cmd-list

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

@@ -32,10 +32,9 @@
(let (let
((th (first target))) ((th (first target)))
(cond (cond
((= th dot-sym) ((or (= th dot-sym) (= th (make-symbol "poss")))
(let (let
((base-ast (nth target 1)) ((base-ast (nth target 1)) (prop (nth target 2)))
(prop (nth target 2)))
(cond (cond
((and (list? base-ast) (= (first base-ast) (quote query)) (let ((s (nth base-ast 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) ".")))) ((and (list? base-ast) (= (first base-ast) (quote query)) (let ((s (nth base-ast 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))
(list (list
@@ -69,16 +68,56 @@
(list (quote hs-query-all) (nth inner 1))))) (list (quote hs-query-all) (nth inner 1)))))
(true (true
(list (list
(quote dom-set-prop) (quote let)
(hs-to-sx base-ast) (list
prop (list
value))))) (quote __hs-obj)
(if
(or
(symbol? base-ast)
(and
(list? base-ast)
(= (str (first base-ast)) "ref")))
(let
((sel (if (symbol? base-ast) (str base-ast) (nth base-ast 1))))
(list
(quote do)
(list
(quote host-set!)
(list (quote host-global) "window")
"_hs_last_query_sel"
sel)
(hs-to-sx base-ast)))
(hs-to-sx base-ast))))
(list
(quote do)
(list (quote hs-null-raise!) (quote __hs-obj))
(list
(quote dom-set-prop)
(quote __hs-obj)
prop
value)))))))
((= th (quote attr)) ((= th (quote attr))
(list (let
(quote hs-set-attr!) ((base-ast (nth target 2)))
(hs-to-sx (nth target 2)) (if
(nth target 1) (and (list? base-ast) (= (str (first base-ast)) "ref"))
value)) (list
(quote do)
(list
(quote set!)
(quote _hs-last-query-sel)
(nth base-ast 1))
(list
(quote hs-set-attr!)
(hs-to-sx base-ast)
(nth target 1)
value))
(list
(quote hs-set-attr!)
(hs-to-sx base-ast)
(nth target 1)
value))))
((= th (quote style)) ((= th (quote style))
(list (list
(quote dom-set-style) (quote dom-set-style)
@@ -86,10 +125,7 @@
(nth target 1) (nth target 1)
value)) value))
((= th (quote ref)) ((= th (quote ref))
(list (list (quote set!) (make-symbol (nth target 1)) value))
(quote set!)
(make-symbol (nth target 1))
value))
((= th (quote local)) ((= th (quote local))
(list (list
(quote hs-scoped-set!) (quote hs-scoped-set!)
@@ -117,8 +153,7 @@
(list (quote hs-set-inner-html!) (hs-to-sx target) value)) (list (quote hs-set-inner-html!) (hs-to-sx target) value))
((= th (quote of)) ((= th (quote of))
(let (let
((prop-ast (nth target 1)) ((prop-ast (nth target 1)) (obj-ast (nth target 2)))
(obj-ast (nth target 2)))
(if (if
(and (list? prop-ast) (= (first prop-ast) dot-sym)) (and (list? prop-ast) (= (first prop-ast) dot-sym))
(let (let
@@ -370,13 +405,13 @@
(cond (cond
((and (= (len ast) 4) (list? (nth ast 2)) (= (first (nth ast 2)) (quote dict))) ((and (= (len ast) 4) (list? (nth ast 2)) (= (first (nth ast 2)) (quote dict)))
(list (list
(quote dom-dispatch) (quote hs-dispatch!)
(hs-to-sx (nth ast 3)) (hs-to-sx (nth ast 3))
name name
(hs-to-sx (nth ast 2)))) (hs-to-sx (nth ast 2))))
((= (len ast) 3) ((= (len ast) 3)
(list (list
(quote dom-dispatch) (quote hs-dispatch!)
(hs-to-sx (nth ast 2)) (hs-to-sx (nth ast 2))
name name
(list (quote dict) "sender" (quote me)))) (list (quote dict) "sender" (quote me))))
@@ -391,8 +426,7 @@
(fn (fn
(ast) (ast)
(let (let
((mode (nth ast 1)) ((mode (nth ast 1)) (body (hs-to-sx (nth ast 2))))
(body (hs-to-sx (nth ast 2))))
(cond (cond
((and (list? mode) (= (first mode) (quote forever))) ((and (list? mode) (= (first mode) (quote forever)))
(list (list
@@ -480,9 +514,7 @@
(quote map-indexed) (quote map-indexed)
(list (list
(quote fn) (quote fn)
(list (list (make-symbol (nth ast 5)) (make-symbol safe-param))
(make-symbol (nth ast 5))
(make-symbol safe-param))
body) body)
collection) collection)
(list (list
@@ -495,15 +527,13 @@
(ast) (ast)
(let (let
((event-name (nth ast 1)) ((event-name (nth ast 1))
(has-from (has-from (and (> (len ast) 2) (= (nth ast 2) :from)))
(and (> (len ast) 2) (= (nth ast 2) :from)))
(has-from-or (has-from-or
(and (and
(> (len ast) 4) (> (len ast) 4)
(= (nth ast 2) :from) (= (nth ast 2) :from)
(= (nth ast 4) :or))) (= (nth ast 4) :or)))
(has-or (has-or (and (> (len ast) 2) (= (nth ast 2) :or))))
(and (> (len ast) 2) (= (nth ast 2) :or))))
(cond (cond
(has-from-or (has-from-or
(list (list
@@ -512,10 +542,7 @@
event-name event-name
(nth ast 5))) (nth ast 5)))
(has-from (has-from
(list (list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name))
(quote hs-wait-for)
(hs-to-sx (nth ast 3))
event-name))
(has-or (has-or
(list (list
(quote hs-wait-for-or) (quote hs-wait-for-or)
@@ -544,14 +571,9 @@
(ast) (ast)
(let (let
((type-name (nth ast 1)) ((type-name (nth ast 1))
(called (called (if (>= (len ast) 3) (nth ast 2) nil))
(if (>= (len ast) 3) (nth ast 2) nil))
(args (if (>= (len ast) 4) (nth ast 3) nil)) (args (if (>= (len ast) 4) (nth ast 3) nil))
(kind (kind (if (>= (len ast) 5) (nth ast 4) (quote auto))))
(if
(>= (len ast) 5)
(nth ast 4)
(quote auto))))
(let (let
((make-call (cond ((nil? args) (list (quote hs-make) type-name)) (true (cons (quote hs-make) (cons type-name (map hs-to-sx args))))))) ((make-call (cond ((nil? args) (list (quote hs-make) type-name)) (true (cons (quote hs-make) (cons type-name (map hs-to-sx args)))))))
(cond (cond
@@ -606,25 +628,34 @@
(quote do) (quote do)
(list (quote dom-set-attr) el attr-name (quote __hs-new)) (list (quote dom-set-attr) el attr-name (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) dot-sym)) ((and (list? expr) (or (= (first expr) dot-sym) (= (first expr) (make-symbol "poss"))))
(let (let
((obj (hs-to-sx (nth expr 1))) ((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
(prop (nth expr 2)))
(list (list
(quote let) (quote let)
(list (list (list (quote __hs-obj) obj))
(list
(quote __hs-new)
(list
(quote +)
(list
(quote hs-to-number)
(list (quote host-get) obj prop))
amount)))
(list (list
(quote do) (quote do)
(list (quote host-set!) obj prop (quote __hs-new)) (list (quote hs-null-raise!) (quote __hs-obj))
(list (quote set!) (quote it) (quote __hs-new)))))) (list
(quote let)
(list
(list
(quote __hs-new)
(list
(quote +)
(list
(quote hs-to-number)
(list (quote host-get) (quote __hs-obj) prop))
amount)))
(list
(quote do)
(list
(quote host-set!)
(quote __hs-obj)
prop
(quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new))))))))
((and (list? expr) (= (first expr) (quote style))) ((and (list? expr) (= (first expr) (quote style)))
(let (let
((el (if tgt-override (hs-to-sx tgt-override) (quote me))) ((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
@@ -646,8 +677,7 @@
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote dom-ref))) ((and (list? expr) (= (first expr) (quote dom-ref)))
(let (let
((el (hs-to-sx (nth expr 2))) ((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
(name (nth expr 1)))
(list (list
(quote let) (quote let)
(list (list
@@ -724,25 +754,34 @@
(quote do) (quote do)
(list (quote dom-set-attr) el attr-name (quote __hs-new)) (list (quote dom-set-attr) el attr-name (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) dot-sym)) ((and (list? expr) (or (= (first expr) dot-sym) (= (first expr) (make-symbol "poss"))))
(let (let
((obj (hs-to-sx (nth expr 1))) ((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
(prop (nth expr 2)))
(list (list
(quote let) (quote let)
(list (list (list (quote __hs-obj) obj))
(list
(quote __hs-new)
(list
(quote -)
(list
(quote hs-to-number)
(list (quote host-get) obj prop))
amount)))
(list (list
(quote do) (quote do)
(list (quote host-set!) obj prop (quote __hs-new)) (list (quote hs-null-raise!) (quote __hs-obj))
(list (quote set!) (quote it) (quote __hs-new)))))) (list
(quote let)
(list
(list
(quote __hs-new)
(list
(quote -)
(list
(quote hs-to-number)
(list (quote host-get) (quote __hs-obj) prop))
amount)))
(list
(quote do)
(list
(quote host-set!)
(quote __hs-obj)
prop
(quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new))))))))
((and (list? expr) (= (first expr) (quote style))) ((and (list? expr) (= (first expr) (quote style)))
(let (let
((el (if tgt-override (hs-to-sx tgt-override) (quote me))) ((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
@@ -764,8 +803,7 @@
(list (quote set!) (quote it) (quote __hs-new)))))) (list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote dom-ref))) ((and (list? expr) (= (first expr) (quote dom-ref)))
(let (let
((el (hs-to-sx (nth expr 2))) ((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
(name (nth expr 1)))
(list (list
(quote let) (quote let)
(list (list
@@ -823,9 +861,7 @@
(fn (fn
(ast) (ast)
(let (let
((name (nth ast 1)) ((name (nth ast 1)) (params (nth ast 2)) (body (nth ast 3)))
(params (nth ast 2))
(body (nth ast 3)))
(list (list
(quote define) (quote define)
(make-symbol name) (make-symbol name)
@@ -836,10 +872,7 @@
(map (map
(fn (fn
(p) (p)
(if (if (list? p) (make-symbol (nth p 1)) (make-symbol p)))
(list? p)
(make-symbol (nth p 1))
(make-symbol p)))
params)) params))
(list (list
(quote let) (quote let)
@@ -901,10 +934,7 @@
(let (let
((raw (nth ast 1))) ((raw (nth ast 1)))
(let (let
((parts (list)) ((parts (list)) (buf "") (i 0) (n (len raw)))
(buf "")
(i 0)
(n (len raw)))
(define (define
tpl-flush tpl-flush
(fn (fn
@@ -942,14 +972,10 @@
(if (if
(= depth 1) (= depth 1)
j j
(tpl-find-close (tpl-find-close (+ j 1) (- depth 1)))
(+ j 1)
(- depth 1)))
(if (if
(= (nth raw j) "{") (= (nth raw j) "{")
(tpl-find-close (tpl-find-close (+ j 1) (+ depth 1))
(+ j 1)
(+ depth 1))
(tpl-find-close (+ j 1) depth)))))) (tpl-find-close (+ j 1) depth))))))
(define (define
tpl-collect tpl-collect
@@ -1049,10 +1075,7 @@
(list (list
(quote hs-pick-random) (quote hs-pick-random)
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(if (if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2))))))
(nil? (nth ast 2))
nil
(hs-to-sx (nth ast 2))))))
((= head (quote pick-items)) ((= head (quote pick-items))
(list (list
(quote set!) (quote set!)
@@ -1084,13 +1107,21 @@
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(nth ast 2))) (nth ast 2)))
((= head (quote coll-where)) ((= head (quote coll-where))
(list (let
(quote filter) ((raw-coll (hs-to-sx (nth ast 1))))
(list (list
(quote fn) (quote filter)
(list (quote it)) (list
(hs-to-sx (nth ast 2))) (quote fn)
(hs-to-sx (nth ast 1)))) (list (quote it))
(hs-to-sx (nth ast 2)))
(if
(symbol? raw-coll)
(list
(quote cek-try)
(list (quote fn) (list) raw-coll)
(list (quote fn) (list (quote _e)) nil))
raw-coll))))
((= head (quote coll-sorted)) ((= head (quote coll-sorted))
(list (list
(quote hs-sorted-by) (quote hs-sorted-by)
@@ -1132,13 +1163,29 @@
(if (if
(and (and
(list? dot-node) (list? dot-node)
(= (first dot-node) (make-symbol "."))) (or
(= (str (first dot-node)) ".")
(= (str (first dot-node)) "poss")))
(let (let
((obj (hs-to-sx (nth dot-node 1))) ((receiver-ast (nth dot-node 1))
(method (nth dot-node 2))) (method (nth dot-node 2))
(cons (sel
(quote hs-method-call) (hs-receiver-selector (nth dot-node 1) "poss")))
(cons obj (cons method args)))) (list
(quote let)
(list
(list (quote __hs-recv) (hs-to-sx receiver-ast)))
(list
(quote do)
(list
(quote host-set!)
(list (quote host-global) "window")
"_hs_last_query_sel"
sel)
(list (quote hs-null-raise!) (quote __hs-recv))
(cons
(quote hs-method-call)
(cons (quote __hs-recv) (cons method args))))))
(if (if
(and (and
(list? dot-node) (list? dot-node)
@@ -1151,10 +1198,7 @@
(quote hs-method-call) (quote hs-method-call)
(cons (hs-to-sx dot-node) args)))))) (cons (hs-to-sx dot-node) args))))))
((= head (quote string-postfix)) ((= head (quote string-postfix))
(list (list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2)))
(quote str)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote block-literal)) ((= head (quote block-literal))
(let (let
((params (map make-symbol (nth ast 1))) ((params (map make-symbol (nth ast 1)))
@@ -1172,6 +1216,10 @@
((= prop "first") (list (quote hs-first) target)) ((= prop "first") (list (quote hs-first) target))
((= prop "last") (list (quote hs-last) target)) ((= prop "last") (list (quote hs-last) target))
(true (list (quote host-get) target prop))))) (true (list (quote host-get) target prop)))))
((= head (make-symbol "poss"))
(let
((target (hs-to-sx (nth ast 1))) (prop (nth ast 2)))
(list (quote host-get) target prop)))
((= head (quote ref)) ((= head (quote ref))
(cond (cond
((= (nth ast 1) "selection") ((= (nth ast 1) "selection")
@@ -1206,10 +1254,7 @@
(hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 1))
(nth ast 2))) (nth ast 2)))
((= head (quote local)) ((= head (quote local))
(list (list (quote hs-scoped-get) (quote me) (nth ast 1)))
(quote hs-scoped-get)
(quote me)
(nth ast 1)))
((= head (quote array)) ((= head (quote array))
(cons (quote list) (map hs-to-sx (rest ast)))) (cons (quote list) (map hs-to-sx (rest ast))))
((= head (quote not)) ((= head (quote not))
@@ -1272,8 +1317,7 @@
(list (quote nil?) (hs-to-sx (nth ast 1))))) (list (quote nil?) (hs-to-sx (nth ast 1)))))
((= head (quote matches?)) ((= head (quote matches?))
(let (let
((left (nth ast 1)) ((left (nth ast 1)) (right (nth ast 2)))
(right (nth ast 2)))
(if (if
(and (list? right) (= (first right) (quote query))) (and (list? right) (= (first right) (quote query)))
(list (list
@@ -1393,10 +1437,7 @@
"parentElement") "parentElement")
(nth ast 1))) (nth ast 1)))
((= head (quote next)) ((= head (quote next))
(list (list (quote hs-next) (hs-to-sx (nth ast 2)) (nth ast 1)))
(quote hs-next)
(hs-to-sx (nth ast 2))
(nth ast 1)))
((= head (quote previous)) ((= head (quote previous))
(list (list
(quote hs-previous) (quote hs-previous)
@@ -1434,7 +1475,7 @@
(quote dom-add-class) (quote dom-add-class)
(quote _el) (quote _el)
(nth ast 1))) (nth ast 1)))
(list (quote hs-query-all) (nth raw-tgt 1))) (list (quote hs-query-all-checked) (nth raw-tgt 1)))
(list (list
(quote dom-add-class) (quote dom-add-class)
(hs-to-sx raw-tgt) (hs-to-sx raw-tgt)
@@ -1447,19 +1488,23 @@
(nth ast 2))) (nth ast 2)))
((= head (quote set-styles)) ((= head (quote set-styles))
(let (let
((pairs (nth ast 1)) ((pairs (nth ast 1)) (tgt (hs-to-sx (nth ast 2))))
(tgt (hs-to-sx (nth ast 2)))) (list
(cons (quote let)
(quote do) (list (list (quote __hs-tgt) tgt))
(map (cons
(fn (quote do)
(p) (cons
(list (list (quote hs-null-raise!) (quote __hs-tgt))
(quote dom-set-style) (map
tgt (fn
(first p) (p)
(nth p 1))) (list
pairs)))) (quote dom-set-style)
(quote __hs-tgt)
(first p)
(nth p 1)))
pairs))))))
((= head (quote multi-add-class)) ((= head (quote multi-add-class))
(let (let
((target (hs-to-sx (nth ast 1))) ((target (hs-to-sx (nth ast 1)))
@@ -1575,7 +1620,7 @@
(quote dom-remove-class) (quote dom-remove-class)
(quote _el) (quote _el)
(nth ast 1))) (nth ast 1)))
(list (quote hs-query-all) (nth raw-tgt 1))) (list (quote hs-query-all-checked) (nth raw-tgt 1)))
(list (list
(quote dom-remove-class) (quote dom-remove-class)
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt)) (if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
@@ -1586,10 +1631,7 @@
(raw-tgt (nth ast 2)) (raw-tgt (nth ast 2))
(when-cond (nth ast 3))) (when-cond (nth ast 3)))
(let (let
((tgt-expr (cond ((tgt-expr (cond ((and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1))) (true (hs-to-sx raw-tgt)))))
((and (list? raw-tgt) (= (first raw-tgt) (quote query)))
(list (quote hs-query-all) (nth raw-tgt 1)))
(true (hs-to-sx raw-tgt)))))
(list (list
(quote let) (quote let)
(list (list
@@ -1622,8 +1664,7 @@
(list (quote hs-splice-at!) (hs-to-sx coll) idx)))) (list (quote hs-splice-at!) (hs-to-sx coll) idx))))
((and (list? tgt) (= (first tgt) dot-sym)) ((and (list? tgt) (= (first tgt) dot-sym))
(let (let
((obj (nth tgt 1)) ((obj (nth tgt 1)) (prop (nth tgt 2)))
(prop (nth tgt 2)))
(emit-set (emit-set
obj obj
(list (list
@@ -1632,8 +1673,7 @@
prop)))) prop))))
((and (list? tgt) (= (first tgt) (quote of))) ((and (list? tgt) (= (first tgt) (quote of)))
(let (let
((prop-ast (nth tgt 1)) ((prop-ast (nth tgt 1)) (obj-ast (nth tgt 2)))
(obj-ast (nth tgt 2)))
(let (let
((prop (cond ((string? prop-ast) prop-ast) ((and (list? prop-ast) (= (first prop-ast) (quote ref))) (nth prop-ast 1)) (true (hs-to-sx prop-ast))))) ((prop (cond ((string? prop-ast) prop-ast) ((and (list? prop-ast) (= (first prop-ast) (quote ref))) (nth prop-ast 1)) (true (hs-to-sx prop-ast)))))
(emit-set (emit-set
@@ -1642,11 +1682,19 @@
(quote hs-dict-without) (quote hs-dict-without)
(hs-to-sx obj-ast) (hs-to-sx obj-ast)
prop))))) prop)))))
(true (list (quote dom-remove) (hs-to-sx tgt)))))) (true
(let
((tgt (hs-to-sx tgt)))
(list
(quote let)
(list (list (quote __hs-tgt) tgt))
(list
(quote do)
(list (quote hs-null-raise!) (quote __hs-tgt))
(list (quote dom-remove) (quote __hs-tgt)))))))))
((= head (quote add-value)) ((= head (quote add-value))
(let (let
((val (hs-to-sx (nth ast 1))) ((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
(tgt (nth ast 2)))
(emit-set (emit-set
tgt tgt
(list (quote hs-add-to!) val (hs-to-sx tgt))))) (list (quote hs-add-to!) val (hs-to-sx tgt)))))
@@ -1660,8 +1708,7 @@
(hs-to-sx (nth ast 2))))) (hs-to-sx (nth ast 2)))))
((= head (quote remove-value)) ((= head (quote remove-value))
(let (let
((val (hs-to-sx (nth ast 1))) ((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
(tgt (nth ast 2)))
(emit-set (emit-set
tgt tgt
(list (quote hs-remove-from!) val (hs-to-sx tgt))))) (list (quote hs-remove-from!) val (hs-to-sx tgt)))))
@@ -1704,7 +1751,16 @@
((= head (quote remove-attr)) ((= head (quote remove-attr))
(let (let
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2))))) ((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))))
(list (quote dom-remove-attr) tgt (nth ast 1)))) (list
(quote let)
(list (list (quote __hs-tgt) tgt))
(list
(quote do)
(list (quote hs-null-raise!) (quote __hs-tgt))
(list
(quote dom-remove-attr)
(quote __hs-tgt)
(nth ast 1))))))
((= head (quote remove-css)) ((= head (quote remove-css))
(let (let
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))) ((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2))))
@@ -1827,14 +1883,19 @@
(nth ast 3) (nth ast 3)
(hs-to-sx (nth ast 4)))) (hs-to-sx (nth ast 4))))
((= head (quote set!)) ((= head (quote set!))
(emit-set (emit-set (nth ast 1) (hs-to-sx (nth ast 2))))
(nth ast 1)
(hs-to-sx (nth ast 2))))
((= head (quote set-el!)) ((= head (quote set-el!))
(list (quote hs-set-element!) (hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 2)))) (list
(quote hs-set-element!)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote view-transition!)) ((= head (quote view-transition!))
(let ((body (nth ast 2))) (let
(list (quote hs-view-transition!) (hs-to-sx (nth ast 1)) (if (nil? body) (quote nil) (hs-to-sx body))))) ((body (nth ast 2)))
(list
(quote hs-view-transition!)
(hs-to-sx (nth ast 1))
(if (nil? body) (quote nil) (hs-to-sx body)))))
((= head (quote put!)) ((= head (quote put!))
(let (let
((val (hs-to-sx (nth ast 1))) ((val (hs-to-sx (nth ast 1)))
@@ -1924,8 +1985,7 @@
(= (first c) (quote define))))) (= (first c) (quote define)))))
compiled))) compiled)))
(cons (quote do) (append defs non-defs))))))) (cons (quote do) (append defs non-defs)))))))
((= head (quote wait)) ((= head (quote wait)) (list (quote hs-wait) (nth ast 1)))
(list (quote hs-wait) (nth ast 1)))
((= head (quote wait-for)) (emit-wait-for ast)) ((= head (quote wait-for)) (emit-wait-for ast))
((= head (quote log)) ((= head (quote log))
(list (quote console-log) (hs-to-sx (nth ast 1)))) (list (quote console-log) (hs-to-sx (nth ast 1))))
@@ -1938,34 +1998,18 @@
(= (len ast) 4) (= (len ast) 4)
(list? (nth ast 2)) (list? (nth ast 2))
(= (first (nth ast 2)) (quote dict)))) (= (first (nth ast 2)) (quote dict))))
(tgt (tgt (if (= (len ast) 4) (nth ast 3) (nth ast 2)))
(if (detail (if (= (len ast) 4) (nth ast 2) nil)))
(= (len ast) 4)
(nth ast 3)
(nth ast 2)))
(detail
(if
(= (len ast) 4)
(nth ast 2)
nil)))
(list (list
(quote dom-dispatch) (quote hs-dispatch!)
(hs-to-sx tgt) (hs-to-sx tgt)
name name
(if has-detail (hs-to-sx detail) nil)))) (if has-detail (hs-to-sx detail) nil))))
((= head (quote hide)) ((= head (quote hide))
(let (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-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
(strategy (strategy (if (> (len ast) 2) (nth ast 2) "display"))
(if (when-cond (if (> (len ast) 3) (nth ast 3) nil)))
(> (len ast) 2)
(nth ast 2)
"display"))
(when-cond
(if
(> (len ast) 3)
(nth ast 3)
nil)))
(if (if
(nil? when-cond) (nil? when-cond)
(list (quote hs-hide!) tgt strategy) (list (quote hs-hide!) tgt strategy)
@@ -1980,16 +2024,8 @@
((= head (quote show)) ((= head (quote show))
(let (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-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
(strategy (strategy (if (> (len ast) 2) (nth ast 2) "display"))
(if (when-cond (if (> (len ast) 3) (nth ast 3) nil)))
(> (len ast) 2)
(nth ast 2)
"display"))
(when-cond
(if
(> (len ast) 3)
(nth ast 3)
nil)))
(if (if
(nil? when-cond) (nil? when-cond)
(list (quote hs-show!) tgt strategy) (list (quote hs-show!) tgt strategy)
@@ -2033,25 +2069,13 @@
((= head (quote repeat-until)) ((= head (quote repeat-until))
(list (list
(quote hs-repeat-until) (quote hs-repeat-until)
(list (list (quote fn) (list) (hs-to-sx (nth ast 1)))
(quote fn) (list (quote fn) (list) (hs-to-sx (nth ast 2)))))
(list)
(hs-to-sx (nth ast 1)))
(list
(quote fn)
(list)
(hs-to-sx (nth ast 2)))))
((= head (quote repeat-while)) ((= head (quote repeat-while))
(list (list
(quote hs-repeat-while) (quote hs-repeat-while)
(list (list (quote fn) (list) (hs-to-sx (nth ast 1)))
(quote fn) (list (quote fn) (list) (hs-to-sx (nth ast 2)))))
(list)
(hs-to-sx (nth ast 1)))
(list
(quote fn)
(list)
(hs-to-sx (nth ast 2)))))
((= head (quote fetch)) ((= head (quote fetch))
(list (list
(if (if
@@ -2064,10 +2088,7 @@
(list (list
(quote hs-fetch-gql) (quote hs-fetch-gql)
(nth ast 1) (nth ast 1)
(if (if (nth ast 2) (hs-to-sx (nth ast 2)) nil)))
(nth ast 2)
(hs-to-sx (nth ast 2))
nil)))
((= head (quote call)) ((= head (quote call))
(let (let
((raw-fn (nth ast 1)) ((raw-fn (nth ast 1))
@@ -2077,9 +2098,42 @@
(make-symbol raw-fn) (make-symbol raw-fn)
(hs-to-sx raw-fn))) (hs-to-sx raw-fn)))
(args (map hs-to-sx (rest (rest ast))))) (args (map hs-to-sx (rest (rest ast)))))
(let (cond
((call-expr (if (and (list? raw-fn) (= (first raw-fn) (quote ref))) (list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args)) (cons fn-expr args)))) ((and (list? raw-fn) (= (first raw-fn) (quote ref)))
(emit-set (quote the-result) call-expr)))) (emit-set
(quote the-result)
(list
(quote hs-win-call)
(nth raw-fn 1)
(cons (quote list) args))))
((and (list? raw-fn) (= (str (first raw-fn)) "."))
(let
((receiver-ast (nth raw-fn 1))
(prop-name (nth raw-fn 2))
(sel (hs-receiver-selector (nth raw-fn 1) "dot")))
(list
(quote let)
(list
(list
(quote __hs-recv)
(hs-to-sx receiver-ast)))
(list
(quote do)
(list
(quote set!)
(quote _hs-last-query-sel)
sel)
(list (quote hs-null-raise!) (quote __hs-recv))
(emit-set
(quote the-result)
(cons
(list
(quote host-get)
(quote __hs-recv)
prop-name)
args))))))
(true
(emit-set (quote the-result) (cons fn-expr args))))))
((= head (quote return)) ((= head (quote return))
(let (let
((val (nth ast 1))) ((val (nth ast 1)))
@@ -2094,11 +2148,13 @@
((= head (quote throw)) ((= head (quote throw))
(list (quote raise) (hs-to-sx (nth ast 1)))) (list (quote raise) (hs-to-sx (nth ast 1))))
((= head (quote settle)) ((= head (quote settle))
(list (quote hs-settle) (quote me))) (let
((raw-tgt (if (> (len ast) 1) (nth ast 1) nil)))
(list
(quote hs-settle)
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt)))))
((= head (quote go)) ((= head (quote go))
(list (list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
(quote hs-navigate!)
(hs-to-sx (nth ast 1))))
((= head (quote ask)) ((= head (quote ask))
(let (let
((val (list (quote hs-ask) (hs-to-sx (nth ast 1))))) ((val (list (quote hs-ask) (hs-to-sx (nth ast 1)))))
@@ -2184,35 +2240,17 @@
(let (let
((kind (nth ast 1)) ((kind (nth ast 1))
(name (nth ast 2)) (name (nth ast 2))
(from-sel (from-sel (if (> (len ast) 3) (nth ast 3) nil))
(if (for-tgt (if (> (len ast) 4) (nth ast 4) nil))
(> (len ast) 3) (attr-val (if (> (len ast) 5) (nth ast 5) nil))
(nth ast 3) (with-val (if (> (len ast) 6) (nth ast 6) nil)))
nil))
(for-tgt
(if
(> (len ast) 4)
(nth ast 4)
nil))
(attr-val
(if
(> (len ast) 5)
(nth ast 5)
nil))
(with-val
(if
(> (len ast) 6)
(nth ast 6)
nil)))
(let (let
((target (if for-tgt (hs-to-sx for-tgt) (quote me))) ((target (if for-tgt (hs-to-sx for-tgt) (quote me)))
(scope (scope
(cond (cond
((nil? from-sel) nil) ((nil? from-sel) nil)
((and (list? from-sel) (= (first from-sel) (quote query))) ((and (list? from-sel) (= (first from-sel) (quote query)))
(list (list (quote hs-query-all) (nth from-sel 1)))
(quote hs-query-all)
(nth from-sel 1)))
(true (hs-to-sx from-sel)))) (true (hs-to-sx from-sel))))
(with-sx (with-sx
(if (if
@@ -2265,10 +2303,7 @@
((= head (quote increment!)) ((= head (quote increment!))
(if (if
(= (len ast) 3) (= (len ast) 3)
(emit-inc (emit-inc (nth ast 1) 1 (nth ast 2))
(nth ast 1)
1
(nth ast 2))
(emit-inc (emit-inc
(nth ast 1) (nth ast 1)
(nth ast 2) (nth ast 2)
@@ -2276,10 +2311,7 @@
((= head (quote decrement!)) ((= head (quote decrement!))
(if (if
(= (len ast) 3) (= (len ast) 3)
(emit-dec (emit-dec (nth ast 1) 1 (nth ast 2))
(nth ast 1)
1
(nth ast 2))
(emit-dec (emit-dec
(nth ast 1) (nth ast 1)
(nth ast 2) (nth ast 2)
@@ -2293,8 +2325,7 @@
((= head (quote on)) (emit-on ast)) ((= head (quote on)) (emit-on ast))
((= head (quote when-changes)) ((= head (quote when-changes))
(let (let
((expr (nth ast 1)) ((expr (nth ast 1)) (body (nth ast 2)))
(body (nth ast 2)))
(if (if
(and (list? expr) (= (first expr) (quote dom-ref))) (and (list? expr) (= (first expr) (quote dom-ref)))
(list (list
@@ -2306,10 +2337,7 @@
((= head (quote init)) ((= head (quote init))
(list (list
(quote hs-init) (quote hs-init)
(list (list (quote fn) (list) (hs-to-sx (nth ast 1)))))
(quote fn)
(list)
(hs-to-sx (nth ast 1)))))
((= head (quote def)) ((= head (quote def))
(let (let
((body (hs-to-sx (nth ast 3))) ((body (hs-to-sx (nth ast 3)))
@@ -2348,10 +2376,7 @@
(quote =) (quote =)
(list (quote first) (quote _e)) (list (quote first) (quote _e))
"hs-return")) "hs-return"))
(list (list (quote nth) (quote _e) 1)
(quote nth)
(quote _e)
1)
(list (quote raise) (quote _e))))) (list (quote raise) (quote _e)))))
body)))) body))))
(list (list
@@ -2370,22 +2395,14 @@
(string? src) (string? src)
(first (sx-parse src)) (first (sx-parse src))
(list (quote cek-eval) (hs-to-sx src))))) (list (quote cek-eval) (hs-to-sx src)))))
((= head (quote component)) ((= head (quote component)) (make-symbol (nth ast 1)))
(make-symbol (nth ast 1)))
((= head (quote render)) ((= head (quote render))
(let (let
((comp-raw (nth ast 1)) ((comp-raw (nth ast 1))
(kwargs (nth ast 2)) (kwargs (nth ast 2))
(pos (pos (if (> (len ast) 3) (nth ast 3) nil))
(if
(> (len ast) 3)
(nth ast 3)
nil))
(target (target
(if (if (> (len ast) 4) (hs-to-sx (nth ast 4)) nil)))
(> (len ast) 4)
(hs-to-sx (nth ast 4))
nil)))
(let (let
((comp (if (string? comp-raw) (make-symbol comp-raw) (hs-to-sx comp-raw)))) ((comp (if (string? comp-raw) (make-symbol comp-raw) (hs-to-sx comp-raw))))
(define (define
@@ -2482,9 +2499,7 @@
((and (list? raw-tgt) (= (first raw-tgt) (quote query))) ((and (list? raw-tgt) (= (first raw-tgt) (quote query)))
(list (list
(quote hs-reset!) (quote hs-reset!)
(list (list (quote hs-query-all) (nth raw-tgt 1))))
(quote hs-query-all)
(nth raw-tgt 1))))
(true (list (quote hs-reset!) (hs-to-sx raw-tgt)))))) (true (list (quote hs-reset!) (hs-to-sx raw-tgt))))))
((= head (quote default!)) ((= head (quote default!))
(let (let
@@ -2510,8 +2525,7 @@
(list (quote dom-focus) (hs-to-sx (nth ast 1)))) (list (quote dom-focus) (hs-to-sx (nth ast 1))))
((= head (quote js-block)) ((= head (quote js-block))
(let (let
((params (nth ast 1)) ((params (nth ast 1)) (js-src (nth ast 2)))
(js-src (nth ast 2)))
(let (let
((bound-syms (map (fn (p) (make-symbol p)) params))) ((bound-syms (map (fn (p) (make-symbol p)) params)))
(list (list
@@ -2531,4 +2545,16 @@
(true ast))))))))) (true ast)))))))))
;; ── Convenience: source → SX ───────────────────────────────── ;; ── Convenience: source → SX ─────────────────────────────────
(define
hs-receiver-selector
(fn
(ast notation)
(cond
((and (list? ast) (= (str (first ast)) "ref")) (nth ast 1))
((and (list? ast) (= (str (first ast)) "."))
(str (hs-receiver-selector (nth ast 1) notation) "." (nth ast 2)))
((and (list? ast) (= (str (first ast)) "poss"))
(str (hs-receiver-selector (nth ast 1) "poss") "'s " (nth ast 2)))
(true "?"))))
(define hs-to-sx-from-source (fn (src) (hs-to-sx (hs-compile src)))) (define hs-to-sx-from-source (fn (src) (hs-to-sx (hs-compile src))))

10
shared/static/wasm/sx/hs-integration.sx
View File

@@ -115,7 +115,15 @@
(dom-set-data el "hs-script" src) (dom-set-data el "hs-script" src)
(dom-set-data el "hs-active" true) (dom-set-data el "hs-active" true)
(dom-set-attr el "data-hyperscript-powered" "true") (dom-set-attr el "data-hyperscript-powered" "true")
(let ((handler (hs-handler src))) (handler el)) (let
((handler (hs-handler src)))
(let
((el-type (dom-get-attr el "type"))
(comp-name (dom-get-attr el "component")))
(if
(= el-type "text/hyperscript-template")
(for-each handler (hs-query-all (or comp-name "")))
(handler el))))
(dom-dispatch el "hyperscript:after:init" nil))))))) (dom-dispatch el "hyperscript:after:init" nil)))))))
;; ── Boot subtree: for dynamic content ─────────────────────────── ;; ── Boot subtree: for dynamic content ───────────────────────────

2
shared/static/wasm/sx/hs-parser.sx
View File

@@ -2783,6 +2783,8 @@
((body (parse-cmd-list))) ((body (parse-cmd-list)))
(match-kw "end") (match-kw "end")
(list (quote view-transition!) using body))))) (list (quote view-transition!) using body)))))
((and (= typ "keyword") (or (= val "on") (= val "init") (= val "def") (= val "behavior") (= val "live")))
nil)
(true (parse-expr)))))) (true (parse-expr))))))
(define (define
parse-cmd-list parse-cmd-list