HS: call command fix, event destructuring, array ops, form reset

- call: use make-symbol for fn name, rest-rest for args (was string + nth)
- on: extract (ref ...) nodes from body as event.detail let-bindings
- host-set!: add ListRef+Number case for array index mutation
- append!: support index 0 for prepend
- hs-put!: branch on list? for array start/end operations
- hs-reset!: form reset restoring defaultValue/checked/textContent
- 522/793 pass (was 493/754)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-21 12:16:09 +00:00
parent b23da3190e
commit 9d246f5c96
4 changed files with 110 additions and 47 deletions

View File

@@ -110,47 +110,32 @@
(let
((target (if source (hs-to-sx source) (quote me))))
(let
((compiled-body (hs-to-sx body))
(wrapped-body
(if
catch-info
((event-refs (if (and (list? body) (= (first body) (quote do))) (filter (fn (x) (and (list? x) (= (first x) (quote ref)))) (rest body)) (list))))
(let
((stripped-body (if (> (len event-refs) 0) (let ((remaining (filter (fn (x) (not (and (list? x) (= (first x) (quote ref))))) (rest body)))) (if (= (len remaining) 1) (first remaining) (cons (quote do) remaining))) body)))
(let
((raw-compiled (hs-to-sx stripped-body)))
(let
((compiled-body (if (> (len event-refs) 0) (let ((bindings (map (fn (r) (let ((name (nth r 1))) (list (make-symbol name) (list (quote get) (list (quote get) (quote event) "detail") name)))) event-refs))) (list (quote let) bindings raw-compiled)) raw-compiled)))
(let
((var (make-symbol (first catch-info)))
(catch-body
(hs-to-sx (nth catch-info 1))))
(if
finally-info
(list
(quote do)
((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote do) (list (quote guard) (list var (list true catch-body)) compiled-body) (hs-to-sx finally-info)) (list (quote guard) (list var (list true catch-body)) compiled-body))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body)))
(handler
(list
(quote guard)
(list var (list true catch-body))
compiled-body)
(hs-to-sx finally-info))
(quote fn)
(list (quote event))
wrapped-body)))
(if
every?
(list
(quote guard)
(list var (list true catch-body))
compiled-body)))
(if
finally-info
(list
(quote do)
compiled-body
(hs-to-sx finally-info))
compiled-body)))
(handler
(list
(quote fn)
(list (quote event))
wrapped-body)))
(if
every?
(list
(quote hs-on-every)
target
event-name
handler)
(list (quote hs-on) target event-name handler))))))
(quote hs-on-every)
target
event-name
handler)
(list
(quote hs-on)
target
event-name
handler))))))))))
((= (first items) :from)
(scan-on
(rest (rest items))
@@ -1134,8 +1119,13 @@
(if (nth ast 2) (hs-to-sx (nth ast 2)) nil)))
((= head (quote call))
(let
((fn-expr (hs-to-sx (nth ast 1)))
(args (map hs-to-sx (nth ast 2))))
((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)))
((= head (quote return))
(let

View File

@@ -161,12 +161,21 @@
(fn
(value pos target)
(cond
((= pos "into") (dom-set-inner-html target value))
((= pos "into")
(if (list? target) target (dom-set-inner-html target value)))
((= pos "before")
(dom-insert-adjacent-html target "beforebegin" value))
((= pos "after") (dom-insert-adjacent-html target "afterend" value))
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
((= pos "end") (dom-insert-adjacent-html target "beforeend" value)))))
((= pos "start")
(if
(list? target)
(append! target value 0)
(dom-insert-adjacent-html target "afterbegin" value)))
((= pos "end")
(if
(list? target)
(append! target value)
(dom-insert-adjacent-html target "beforeend" value))))))
;; Last element matching selector.
(define