HS behavioral tests: 478→509/831 (57%→61%), parser/compiler/runtime fixes
Parser: am-a/am-not-a type checks, transition element/selector targeting, take @attr=value with replacement, toggle my/the possessive, <selector/> syntax in parse-atom, the-of for style/attr/class/selector, when-clause filtering for add, starts/ends-with ignoring case. Compiler: take attr passthrough, toggle-style nil→me default, scoped querySelectorAll for add/remove/toggle-class, has-class? entry, matches? extracts selector from (query sel), add-class-when with for-each filter, starts/ends-with-ic entries, hs-add replaces + for polymorphic add. Runtime: hs-take! proper attr values, hs-type-check Element/Node via host-typeof, hs-toggle-style! opacity 0↔1, hs-coerce +8 coercions (Keys/Values/Entries/Reversed/Unique/Flat/JSON/Object), hs-query-all bypasses broken dom-query-all (WASM auto-converts arrays), hs-matches? handles DOM el.matches(selector), hs-add list+string+number polymorphic, hs-starts/ends-with-ic for case-insensitive comparison. DOM mock: mkStyle() with setProperty/getPropertyValue, fndAll.item(). Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -56,32 +56,39 @@
|
||||
(hs-to-sx (nth target 2))
|
||||
value))
|
||||
((= th (quote of))
|
||||
;; Decompose (of prop-expr target) into a set operation
|
||||
;; e.g. (of (. (ref "parentNode") "innerHTML") (query "#d1"))
|
||||
;; → set parentNode.innerHTML of #d1 → need to navigate target, then set final prop
|
||||
(let ((prop-ast (nth target 1))
|
||||
(obj-ast (nth target 2)))
|
||||
(if (and (list? prop-ast) (= (first prop-ast) dot-sym))
|
||||
;; (. base "prop") of obj → (dom-set-prop (host-get (compiled-obj) (compiled-base-name)) "prop" value)
|
||||
(let ((base (nth prop-ast 1))
|
||||
(prop-name (nth prop-ast 2)))
|
||||
(list (quote dom-set-prop)
|
||||
(list (quote host-get) (hs-to-sx obj-ast) (nth base 1))
|
||||
(let
|
||||
((prop-ast (nth target 1)) (obj-ast (nth target 2)))
|
||||
(if
|
||||
(and (list? prop-ast) (= (first prop-ast) dot-sym))
|
||||
(let
|
||||
((base (nth prop-ast 1))
|
||||
(prop-name (nth prop-ast 2)))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(list
|
||||
(quote host-get)
|
||||
(hs-to-sx obj-ast)
|
||||
(nth base 1))
|
||||
prop-name
|
||||
value))
|
||||
;; (attr "name") of obj → (dom-set-attr (compiled-obj) "name" value)
|
||||
(if (and (list? prop-ast) (= (first prop-ast) (quote attr)))
|
||||
(list (quote dom-set-attr)
|
||||
(if
|
||||
(and
|
||||
(list? prop-ast)
|
||||
(= (first prop-ast) (quote attr)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
(hs-to-sx obj-ast)
|
||||
(nth prop-ast 1)
|
||||
value)
|
||||
;; Simple: (ref "prop") of obj → (dom-set-prop (compiled-obj) "prop" value)
|
||||
(if (and (list? prop-ast) (= (first prop-ast) (quote ref)))
|
||||
(list (quote dom-set-prop)
|
||||
(if
|
||||
(and
|
||||
(list? prop-ast)
|
||||
(= (first prop-ast) (quote ref)))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(hs-to-sx obj-ast)
|
||||
(nth prop-ast 1)
|
||||
value)
|
||||
;; Fallback
|
||||
(list (quote set!) (hs-to-sx target) value))))))
|
||||
(true (list (quote set!) (hs-to-sx target) value)))))))
|
||||
(define
|
||||
@@ -427,7 +434,7 @@
|
||||
((= head (quote null-literal)) nil)
|
||||
((= head (quote not))
|
||||
(list (quote not) (hs-to-sx (nth ast 1))))
|
||||
((or (= head (quote starts-with?)) (= head (quote ends-with?)) (= head (quote contains?)) (= head (quote matches?)) (= head (quote precedes?)) (= head (quote follows?)) (= head (quote exists?)))
|
||||
((or (= head (quote starts-with?)) (= head (quote ends-with?)) (= head (quote contains?)) (= head (quote precedes?)) (= head (quote follows?)) (= head (quote exists?)))
|
||||
(cons head (map hs-to-sx (rest ast))))
|
||||
((= head (quote object-literal))
|
||||
(let
|
||||
@@ -656,6 +663,11 @@
|
||||
(quote dom-get-style)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 1)))
|
||||
((= head (quote has-class?))
|
||||
(list
|
||||
(quote dom-has-class?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(nth ast 2)))
|
||||
((= head (quote local)) (make-symbol (nth ast 1)))
|
||||
((= head (quote array))
|
||||
(cons (quote list) (map hs-to-sx (rest ast))))
|
||||
@@ -713,15 +725,30 @@
|
||||
(quote not)
|
||||
(list (quote nil?) (hs-to-sx (nth ast 1)))))
|
||||
((= head (quote matches?))
|
||||
(list
|
||||
(quote hs-matches?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
(let
|
||||
((left (nth ast 1)) (right (nth ast 2)))
|
||||
(if
|
||||
(and (list? right) (= (first right) (quote query)))
|
||||
(list (quote hs-matches?) (hs-to-sx left) (nth right 1))
|
||||
(list
|
||||
(quote hs-matches?)
|
||||
(hs-to-sx left)
|
||||
(hs-to-sx right)))))
|
||||
((= head (quote matches-ignore-case?))
|
||||
(list
|
||||
(quote hs-matches-ignore-case?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote starts-with-ic?))
|
||||
(list
|
||||
(quote hs-starts-with-ic?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote ends-with-ic?))
|
||||
(list
|
||||
(quote hs-ends-with-ic?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote contains?))
|
||||
(list
|
||||
(quote hs-contains?)
|
||||
@@ -824,6 +851,23 @@
|
||||
(map
|
||||
(fn (cls) (list (quote dom-add-class) target cls))
|
||||
classes))))
|
||||
((= head (quote add-class-when))
|
||||
(let
|
||||
((cls (nth ast 1))
|
||||
(raw-tgt (nth ast 2))
|
||||
(when-cond (nth ast 3)))
|
||||
(let
|
||||
((tgt-expr (cond ((and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1))) ((and (list? raw-tgt) (= (first raw-tgt) (quote in?)) (list? (nth raw-tgt 1)) (= (first (nth raw-tgt 1)) (quote query))) (list (quote host-call) (hs-to-sx (nth raw-tgt 2)) "querySelectorAll" (nth (nth raw-tgt 1) 1))) (true (hs-to-sx raw-tgt)))))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote it))
|
||||
(list
|
||||
(quote when)
|
||||
(hs-to-sx when-cond)
|
||||
(list (quote dom-add-class) (quote it) cls)))
|
||||
tgt-expr))))
|
||||
((= head (quote multi-remove-class))
|
||||
(let
|
||||
((target (hs-to-sx (nth ast 1)))
|
||||
@@ -895,10 +939,12 @@
|
||||
(nth ast 1)
|
||||
(nth ast 2)))
|
||||
((= head (quote toggle-style))
|
||||
(list
|
||||
(quote hs-toggle-style!)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 1)))
|
||||
(let
|
||||
((raw-tgt (nth ast 2)))
|
||||
(list
|
||||
(quote hs-toggle-style!)
|
||||
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
|
||||
(nth ast 1))))
|
||||
((= head (quote toggle-style-between))
|
||||
(list
|
||||
(quote hs-toggle-style-between!)
|
||||
|
||||
Reference in New Issue
Block a user