HS: implement morph command — tokenizer keyword, parser, compiler, runtime HTML-fragment parser

Adds the missing `morph <target> to <html>` command. Runtime includes a small
HTML fragment parser that applies the outer element's attributes to the target,
rebuilds children, and re-activates hyperscript on the new subtree. Other
hyperscript fixes (^ attr ref, dom-ref keyword, pick keyword, between in am/is,
prop-is removal) from parallel work are bundled along.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-22 11:49:36 +00:00
parent ef5faa6b54
commit 5b0c8569a8
4 changed files with 735 additions and 68 deletions

View File

@@ -44,6 +44,12 @@
(list (quote set!) (make-symbol (nth target 1)) value))
((= th (quote local))
(list (quote define) (make-symbol (nth target 1)) value))
((= th (quote dom-ref))
(list
(quote hs-dom-set!)
(hs-to-sx (nth target 2))
(nth target 1)
value))
((= th (quote me))
(list (quote dom-set-inner-html) (quote me) value))
((= th (quote it)) (list (quote set!) (quote it) value))
@@ -427,7 +433,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 precedes?)) (= head (quote follows?)))
((or (= head (quote and)) (= head (quote or)) (= head (quote >=)) (= head (quote <=)) (= head (quote >)) (= head (quote <)))
(cons head (map hs-to-sx (rest ast))))
((= head (quote object-literal))
(let
@@ -559,6 +565,37 @@
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 3))))
((= head (quote pick-first))
(list
(quote hs-pick-first)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote pick-last))
(list
(quote hs-pick-last)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote pick-random))
(list
(quote hs-pick-random)
(hs-to-sx (nth ast 1))
(if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2)))))
((= head (quote pick-items))
(list
(quote hs-pick-items)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 3))))
((= head (quote pick-match))
(list
(quote regex-match)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote pick-matches))
(list
(quote regex-find-all)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote prop-is))
(list
(quote hs-prop-is)
@@ -656,6 +693,11 @@
(quote dom-get-style)
(hs-to-sx (nth ast 2))
(nth ast 1)))
((= head (quote dom-ref))
(list
(quote hs-dom-get)
(hs-to-sx (nth ast 2))
(nth ast 1)))
((= head (quote has-class?))
(list
(quote dom-has-class?)
@@ -742,6 +784,26 @@
(quote hs-ends-with-ic?)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote starts-with?))
(list
(quote hs-starts-with?)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote ends-with?))
(list
(quote hs-ends-with?)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote precedes?))
(list
(quote hs-precedes?)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote follows?))
(list
(quote hs-follows?)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote contains?))
(list
(quote hs-contains?)
@@ -937,6 +999,11 @@
(quote do)
(emit-set lhs (hs-to-sx rhs))
(emit-set rhs (quote _swap_tmp))))))
((= head (quote morph!))
(list
(quote hs-morph!)
(hs-to-sx (nth ast 1))
(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)))))
@@ -977,6 +1044,23 @@
(quote hs-set-on!)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote set-on!))
(let
((lhs (nth ast 1))
(tgt-ast (nth ast 2))
(val-ast (nth ast 3)))
(if
(and (list? lhs) (= (first lhs) (quote dom-ref)))
(list
(quote hs-dom-set!)
(hs-to-sx tgt-ast)
(nth lhs 1)
(hs-to-sx val-ast))
(list
(quote hs-set-on!)
(hs-to-sx lhs)
(hs-to-sx tgt-ast)
(hs-to-sx val-ast)))))
((= head (quote toggle-between))
(list
(quote hs-toggle-between!)
@@ -1194,15 +1278,21 @@
((= head (quote measure))
(list (quote hs-measure) (hs-to-sx (nth ast 1))))
((= head (quote increment!))
(emit-inc
(nth ast 1)
(nth ast 2)
(if (> (len ast) 3) (nth ast 3) nil)))
(if
(= (len ast) 3)
(emit-inc (nth ast 1) 1 (nth ast 2))
(emit-inc
(nth ast 1)
(nth ast 2)
(if (> (len ast) 3) (nth ast 3) nil))))
((= head (quote decrement!))
(emit-dec
(nth ast 1)
(nth ast 2)
(if (> (len ast) 3) (nth ast 3) nil)))
(if
(= (len ast) 3)
(emit-dec (nth ast 1) 1 (nth ast 2))
(emit-dec
(nth ast 1)
(nth ast 2)
(if (> (len ast) 3) (nth ast 3) nil))))
((= head (quote break)) (list (quote raise) "hs-break"))
((= head (quote continue))
(list (quote raise) "hs-continue"))
@@ -1210,6 +1300,17 @@
((= head (quote live-no-op)) nil)
((= head (quote when-feat-no-op)) nil)
((= head (quote on)) (emit-on ast))
((= head (quote when-changes))
(let
((expr (nth ast 1)) (body (nth ast 2)))
(if
(and (list? expr) (= (first expr) (quote dom-ref)))
(list
(quote hs-dom-watch!)
(hs-to-sx (nth expr 2))
(nth expr 1)
(list (quote fn) (list (quote it)) (hs-to-sx body)))
nil)))
((= head (quote init))
(list
(quote hs-init)