HS: fix empty/halt/morph/reset/dialog — 17 upstream tests pass

- parser `empty` no-target → (ref "me") (was bogus (sym "me"))
- parser `halt` modes distinguish: "all"/"bubbling"/"default" halt execution
  (raise hs-return), "the-event"/"the event's" only stop propagation/default.
  "'s" now matched as op token, not keyword.
- parser `get` cmd: dispatch + cmd-kw list + parse-get-cmd (parses expr with
  optional `as TYPE`). Required for `get result as JSON` in fetch chains.
- compiler empty-target for (local X): emit (set! X (hs-empty-like X)) so
  arrays/sets/maps clear the variable, not call DOM empty on the value.
- runtime hs-empty-like: container-of-same-type empty value.
- runtime hs-empty-target!: drop dead FORM branch that was short-circuiting
  to innerHTML=""; the querySelectorAll-over-inputs branch now runs.
- runtime hs-halt!: take ev param (was free `event` lookup); raise hs-return
  to stop execution unless mode is "the-event".
- runtime hs-reset!: type-aware — FORM → reset, INPUT/TEXTAREA → value/checked
  from defaults, SELECT → defaultSelected option.
- runtime hs-open!/hs-close!: toggle `open` attribute on details elements
  (not just the prop) so dom-has-attr? assertions work.
- runtime hs-coerce JSON: json-stringify dict/list (was str).
- test-runner mock: host-get on List + "length"/"size" (was only Dict);
  dom-set-attr tracks defaultChecked / defaultSelected / defaultValue;
  mock_query_all supports comma-separated selector groups.
- generator: emit boolean attrs (checked/selected/etc) even with null value;
  drop overcautious "skip HS with bare quotes or embedded HTML" guard so
  morph tests (source contains embedded <div>) emit properly.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-22 15:36:01 +00:00
parent 5c66095b0f
commit 802ccd23e8
12 changed files with 1340 additions and 345 deletions

View File

@@ -23,14 +23,48 @@
((th (first target)))
(cond
((= th dot-sym)
(list
(quote dom-set-prop)
(hs-to-sx (nth target 1))
(nth target 2)
value))
(let
((base-ast (nth target 1)) (prop (nth target 2)))
(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) "."))))
(list
(quote for-each)
(list
(quote fn)
(list (quote __hs-el))
(list
(quote dom-set-prop)
(quote __hs-el)
prop
value))
(list (quote hs-query-all) (nth base-ast 1))))
((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))
(mid-prop (nth base-ast 2)))
(list
(quote for-each)
(list
(quote fn)
(list (quote __hs-el))
(list
(quote dom-set-prop)
(list
(quote host-get)
(quote __hs-el)
mid-prop)
prop
value))
(list (quote hs-query-all) (nth inner 1)))))
(true
(list
(quote dom-set-prop)
(hs-to-sx base-ast)
prop
value)))))
((= th (quote attr))
(list
(quote dom-set-attr)
(quote hs-set-attr!)
(hs-to-sx (nth target 2))
(nth target 1)
value))
@@ -84,7 +118,7 @@
(list? prop-ast)
(= (first prop-ast) (quote attr)))
(list
(quote dom-set-attr)
(quote hs-set-attr!)
(hs-to-sx obj-ast)
(nth prop-ast 1)
value)
@@ -323,56 +357,120 @@
(cond
((and (list? expr) (= (first expr) (quote attr)))
(let
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
(attr-name (nth expr 1)))
(list
(quote dom-set-attr)
el
(nth expr 1)
(quote let)
(list
(quote +)
(list
(quote parse-number)
(list (quote dom-get-attr) el (nth expr 1)))
amount))))
(quote __hs-new)
(list
(quote +)
(list
(quote hs-to-number)
(list (quote dom-get-attr) el attr-name))
amount)))
(list
(quote do)
(list (quote dom-set-attr) el attr-name (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) dot-sym))
(let
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
(list
(quote host-set!)
obj
prop
(quote let)
(list
(quote +)
(list
(quote parse-number)
(list (quote host-get) obj prop))
amount))))
(quote __hs-new)
(list
(quote +)
(list
(quote hs-to-number)
(list (quote host-get) obj prop))
amount)))
(list
(quote do)
(list (quote host-set!) obj prop (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote style)))
(let
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
(prop (nth expr 1)))
(list
(quote dom-set-style)
el
prop
(quote let)
(list
(quote +)
(list
(quote parse-number)
(list (quote dom-get-style) el prop))
amount))))
(quote __hs-new)
(list
(quote +)
(list
(quote hs-to-number)
(list (quote dom-get-style) el prop))
amount)))
(list
(quote do)
(list (quote dom-set-style) el prop (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote dom-ref)))
(let
((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
(list
(quote hs-dom-set!)
el
name
(list (quote +) (list (quote hs-dom-get) el name) amount))))
(quote let)
(list
(list
(quote __hs-new)
(list
(quote +)
(list
(quote hs-to-number)
(list (quote hs-dom-get) el name))
amount)))
(list
(quote do)
(list (quote hs-dom-set!) el name (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote array-index)) (list? (nth expr 1)) (= (first (nth expr 1)) (quote ref)))
(let
((var-sym (make-symbol (nth (nth expr 1) 1)))
(idx (hs-to-sx (nth expr 2))))
(list
(quote let)
(list (list (quote __hs-idx) idx))
(list
(quote let)
(list
(list
(quote __hs-new)
(list
(quote +)
(list
(quote hs-to-number)
(list (quote nth) var-sym (quote __hs-idx)))
amount)))
(list
(quote do)
(list
(quote set!)
var-sym
(list
(quote hs-list-set)
var-sym
(quote __hs-idx)
(quote __hs-new)))
(list (quote set!) (quote it) (quote __hs-new)))))))
(true
(let
((t (hs-to-sx expr)))
(list (quote set!) t (list (quote +) t amount)))))))
(list
(quote let)
(list
(list
(quote __hs-new)
(list (quote +) (list (quote hs-to-number) t) amount)))
(list
(quote do)
(list (quote set!) t (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new)))))))))
(define
emit-dec
(fn
@@ -380,56 +478,120 @@
(cond
((and (list? expr) (= (first expr) (quote attr)))
(let
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
(attr-name (nth expr 1)))
(list
(quote dom-set-attr)
el
(nth expr 1)
(quote let)
(list
(quote -)
(list
(quote parse-number)
(list (quote dom-get-attr) el (nth expr 1)))
amount))))
(quote __hs-new)
(list
(quote -)
(list
(quote hs-to-number)
(list (quote dom-get-attr) el attr-name))
amount)))
(list
(quote do)
(list (quote dom-set-attr) el attr-name (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) dot-sym))
(let
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
(list
(quote host-set!)
obj
prop
(quote let)
(list
(quote -)
(list
(quote parse-number)
(list (quote host-get) obj prop))
amount))))
(quote __hs-new)
(list
(quote -)
(list
(quote hs-to-number)
(list (quote host-get) obj prop))
amount)))
(list
(quote do)
(list (quote host-set!) obj prop (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote style)))
(let
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
(prop (nth expr 1)))
(list
(quote dom-set-style)
el
prop
(quote let)
(list
(quote -)
(list
(quote parse-number)
(list (quote dom-get-style) el prop))
amount))))
(quote __hs-new)
(list
(quote -)
(list
(quote hs-to-number)
(list (quote dom-get-style) el prop))
amount)))
(list
(quote do)
(list (quote dom-set-style) el prop (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote dom-ref)))
(let
((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
(list
(quote hs-dom-set!)
el
name
(list (quote -) (list (quote hs-dom-get) el name) amount))))
(quote let)
(list
(list
(quote __hs-new)
(list
(quote -)
(list
(quote hs-to-number)
(list (quote hs-dom-get) el name))
amount)))
(list
(quote do)
(list (quote hs-dom-set!) el name (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new))))))
((and (list? expr) (= (first expr) (quote array-index)) (list? (nth expr 1)) (= (first (nth expr 1)) (quote ref)))
(let
((var-sym (make-symbol (nth (nth expr 1) 1)))
(idx (hs-to-sx (nth expr 2))))
(list
(quote let)
(list (list (quote __hs-idx) idx))
(list
(quote let)
(list
(list
(quote __hs-new)
(list
(quote -)
(list
(quote hs-to-number)
(list (quote nth) var-sym (quote __hs-idx)))
amount)))
(list
(quote do)
(list
(quote set!)
var-sym
(list
(quote hs-list-set)
var-sym
(quote __hs-idx)
(quote __hs-new)))
(list (quote set!) (quote it) (quote __hs-new)))))))
(true
(let
((t (hs-to-sx expr)))
(list (quote set!) t (list (quote -) t amount)))))))
(list
(quote let)
(list
(list
(quote __hs-new)
(list (quote -) (list (quote hs-to-number) t) amount)))
(list
(quote do)
(list (quote set!) t (quote __hs-new))
(list (quote set!) (quote it) (quote __hs-new)))))))))
(define
emit-behavior
(fn
@@ -1009,7 +1171,15 @@
(hs-to-sx tgt)
(list (quote hs-remove-from!) val (hs-to-sx tgt)))))
((= head (quote empty-target))
(list (quote hs-empty-target!) (hs-to-sx (nth ast 1))))
(let
((tgt (nth ast 1)))
(if
(and (list? tgt) (= (first tgt) (quote local)))
(list
(quote set!)
(make-symbol (nth tgt 1))
(list (quote hs-empty-like) (make-symbol (nth tgt 1))))
(list (quote hs-empty-target!) (hs-to-sx tgt)))))
((= head (quote open-element))
(list (quote hs-open!) (hs-to-sx (nth ast 1))))
((= head (quote close-element))
@@ -1160,6 +1330,9 @@
(or
(= (first c) (quote hs-fetch))
(= (first c) (quote hs-wait))
(= (first c) (quote hs-wait-for))
(= (first c) (quote hs-query-first))
(= (first c) (quote hs-query-all))
(= (first c) (quote perform)))))
compiled))
(reduce
@@ -1486,7 +1659,8 @@
(hs-to-sx (nth ast 1))
(list (quote fn) (list) (hs-to-sx (nth (nth ast 2) 2)))
(nth ast 3)))
((= head (quote halt!)) (list (quote hs-halt!) (nth ast 1)))
((= head (quote halt!))
(list (quote hs-halt!) (quote event) (nth ast 1)))
((= head (quote focus!))
(list (quote dom-focus) (hs-to-sx (nth ast 1))))
(true ast))))))))