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

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

Browse Source 
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:
giles
2026-04-22 11:49:36 +00:00
parent ef5faa6b54
commit 5b0c8569a8
4 changed files with 735 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

271
lib/hyperscript/parser.sx
View File

@@ -180,6 +180,16 @@
((= typ "style")
(do (adv!) (list (quote style) val (list (quote me)))))
((= typ "local") (do (adv!) (list (quote local) val)))
((= typ "hat")
(do (adv!) (list (quote dom-ref) val (list (quote me)))))
((and (= typ "keyword") (= val "dom"))
(do
(adv!)
(let
((name (tp-val)))
(do
(adv!)
(list (quote dom-ref) name (list (quote me)))))))
((= typ "class")
(do (adv!) (list (quote query) (str "." val))))
((= typ "ident") (do (adv!) (list (quote ref) val)))
@@ -479,21 +489,14 @@
(list (quote type-check-strict) left type-name)
(list (quote type-check) left type-name))))))
(true
(if
(and
(= (tp-type) "ident")
(not (hs-keyword? (tp-val))))
(let
((prop-name (tp-val)))
(do (adv!) (list (quote prop-is) left prop-name)))
(let
((right (parse-expr)))
(if
(match-kw "ignoring")
(do
(match-kw "case")
(list (quote eq-ignore-case) left right))
(list (quote =) left right))))))))
(let
((right (parse-expr)))
(if
(match-kw "ignoring")
(do
(match-kw "case")
(list (quote eq-ignore-case) left right))
(list (quote =) left right)))))))
((and (= typ "keyword") (= val "am"))
(do
(adv!)
@@ -504,12 +507,34 @@
(list (quote not-in?) left (parse-expr)))
((match-kw "empty")
(list (quote not) (list (quote empty?) left)))
((match-kw "between")
(let
((lo (parse-atom)))
(match-kw "and")
(let
((hi (parse-atom)))
(list
(quote not)
(list
(quote and)
(list (quote >=) left lo)
(list (quote <=) left hi))))))
(true
(let
((right (parse-expr)))
(list (quote not) (list (quote =) left right))))))
((match-kw "in") (list (quote in?) left (parse-expr)))
((match-kw "empty") (list (quote empty?) left))
((match-kw "between")
(let
((lo (parse-atom)))
(match-kw "and")
(let
((hi (parse-atom)))
(list
(quote and)
(list (quote >=) left lo)
(list (quote <=) left hi)))))
(true
(let
((right (parse-expr)))
@@ -639,6 +664,14 @@
(list
(quote not)
(list (quote ends-with?) left (parse-expr)))))
((or (match-kw "precede") (match-kw "precedes"))
(list
(quote not)
(list (quote precedes?) left (parse-atom))))
((or (match-kw "follow") (match-kw "follows"))
(list
(quote not)
(list (quote follows?) left (parse-atom))))
(true left))))
((and (= typ "keyword") (= val "equals"))
(do (adv!) (list (quote =) left (parse-expr))))
@@ -877,7 +910,7 @@
(collect-classes!))))
(collect-classes!)
(let
((tgt (if (match-kw "from") (parse-expr) nil)))
((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
(if
(empty? extra-classes)
(list (quote remove-class) cls tgt)
@@ -1097,7 +1130,12 @@
((match-kw "on")
(let
((target (parse-expr)))
(list (quote set-on) tgt target)))
(if
(match-kw "to")
(let
((value (parse-expr)))
(list (quote set-on!) tgt target value))
(list (quote set-on) tgt target))))
(true (error (str "Expected to/on at position " p)))))))
(define
parse-put-cmd
@@ -1105,28 +1143,31 @@
()
(let
((value (parse-expr)))
(cond
((match-kw "into") (list (quote set!) (parse-expr) value))
((match-kw "before")
(list (quote put!) value "before" (parse-expr)))
((match-kw "after")
(list (quote put!) value "after" (parse-expr)))
((match-kw "at")
(do
(match-kw "the")
(cond
((match-kw "start")
(do
(expect-kw! "of")
(list (quote put!) value "start" (parse-expr))))
((match-kw "end")
(do
(expect-kw! "of")
(list (quote put!) value "end" (parse-expr))))
(true
(error (str "Expected start/end after at, position " p))))))
(true
(error (str "Expected into/before/after/at at position " p)))))))
(let
((value (if (and (list? value) (= (first value) (quote dom-ref)) (match-kw "on")) (list (quote dom-ref) (nth value 1) (parse-expr)) value)))
(cond
((match-kw "into") (list (quote set!) (parse-expr) value))
((match-kw "before")
(list (quote put!) value "before" (parse-expr)))
((match-kw "after")
(list (quote put!) value "after" (parse-expr)))
((match-kw "at")
(do
(match-kw "the")
(cond
((match-kw "start")
(do
(expect-kw! "of")
(list (quote put!) value "start" (parse-expr))))
((match-kw "end")
(do
(expect-kw! "of")
(list (quote put!) value "end" (parse-expr))))
(true
(error
(str "Expected start/end after at, position " p))))))
(true
(error (str "Expected into/before/after/at at position " p))))))))
(define
parse-if-cmd
(fn
@@ -1241,10 +1282,13 @@
(let
((expr (parse-expr)))
(let
((amount (if (match-kw "by") (parse-expr) 1)))
((by-amount (if (match-kw "by") (parse-expr) nil)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote increment!) expr amount tgt))))))
(if
by-amount
(list (quote increment!) expr by-amount tgt)
(list (quote increment!) expr tgt)))))))
(define
parse-dec-cmd
(fn
@@ -1252,10 +1296,13 @@
(let
((expr (parse-expr)))
(let
((amount (if (match-kw "by") (parse-expr) 1)))
((by-amount (if (match-kw "by") (parse-expr) nil)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote decrement!) expr amount tgt))))))
(if
by-amount
(list (quote decrement!) expr by-amount tgt)
(list (quote decrement!) expr tgt)))))))
(define
parse-hide-cmd
(fn
@@ -1396,7 +1443,7 @@
(let
((fmt-after (if (and (not fmt-before) (match-kw "as")) (let ((f (tp-val))) (adv!) f) nil)))
(let
((fmt (or fmt-before fmt-after "text")))
((fmt (or fmt-before fmt-after "json")))
(list (quote fetch) url fmt)))))))))
(define
parse-call-args
@@ -1460,6 +1507,103 @@
attr-val
with-val)))))))
(true nil))))
(define
parse-pick-cmd
(fn
()
(let
((typ (tp-type)) (val (tp-val)))
(cond
((and (= typ "keyword") (= val "first"))
(do
(adv!)
(let
((n (parse-atom)))
(do
(expect-kw! "of")
(let
((coll (parse-expr)))
(list (quote pick-first) coll n))))))
((and (= typ "keyword") (= val "last"))
(do
(adv!)
(let
((n (parse-atom)))
(do
(expect-kw! "of")
(let
((coll (parse-expr)))
(list (quote pick-last) coll n))))))
((and (= typ "keyword") (= val "random"))
(do
(adv!)
(if
(match-kw "of")
(let
((coll (parse-expr)))
(list (quote pick-random) coll nil))
(let
((n (parse-atom)))
(do
(expect-kw! "of")
(let
((coll (parse-expr)))
(list (quote pick-random) coll n)))))))
((and (= typ "ident") (= val "items"))
(do
(adv!)
(let
((start-expr (parse-atom)))
(do
(expect-kw! "to")
(let
((end-expr (parse-atom)))
(do
(expect-kw! "of")
(let
((coll (parse-expr)))
(list (quote pick-items) coll start-expr end-expr))))))))
((and (= typ "keyword") (= val "match"))
(do
(adv!)
(expect-kw! "of")
(let
((regex (parse-expr)))
(do
(cond
((match-kw "of") nil)
((match-kw "from") nil)
(true
(error
(str
"Expected of/from after pick match regex at "
p))))
(let
((haystack (parse-expr)))
(list (quote pick-match) regex haystack))))))
((and (= typ "keyword") (= val "matches"))
(do
(adv!)
(expect-kw! "of")
(let
((regex (parse-expr)))
(do
(cond
((match-kw "of") nil)
((match-kw "from") nil)
(true
(error
(str
"Expected of/from after pick matches regex at "
p))))
(let
((haystack (parse-expr)))
(list (quote pick-matches) regex haystack))))))
(true
(error
(str
"Expected first/last/random/items/match/matches after 'pick' at "
p)))))))
(define
parse-go-cmd
(fn () (match-kw "to") (list (quote go) (parse-expr))))
@@ -1819,6 +1963,16 @@
((lhs (parse-expr)))
(match-kw "with")
(let ((rhs (parse-expr))) (list (quote swap!) lhs rhs)))))
(define
parse-morph-cmd
(fn
()
(let
((target (parse-expr)))
(expect-kw! "to")
(let
((content (parse-expr)))
(list (quote morph!) target content)))))
(define
parse-open-cmd
(fn
@@ -1880,6 +2034,8 @@
(do (adv!) (parse-call-cmd)))
((and (= typ "keyword") (= val "take"))
(do (adv!) (parse-take-cmd)))
((and (= typ "keyword") (= val "pick"))
(do (adv!) (parse-pick-cmd)))
((and (= typ "keyword") (= val "settle"))
(do (adv!) (list (quote settle))))
((and (= typ "keyword") (= val "go"))
@@ -1920,6 +2076,8 @@
(do (adv!) (parse-empty-cmd)))
((and (= typ "keyword") (= val "swap"))
(do (adv!) (parse-swap-cmd)))
((and (= typ "keyword") (= val "morph"))
(do (adv!) (parse-morph-cmd)))
((and (= typ "keyword") (= val "open"))
(do (adv!) (parse-open-cmd)))
((and (= typ "keyword") (= val "close"))
@@ -1979,8 +2137,10 @@
(= v "empty")
(= v "clear")
(= v "swap")
(= v "morph")
(= v "open")
(= v "close"))))
(= v "close")
(= v "pick"))))
(define
cl-collect
(fn
@@ -2078,9 +2238,24 @@
((and (= (tp-type) "keyword") (or (= (tp-val) "end") (= (tp-val) "on") (= (tp-val) "init") (= (tp-val) "def") (= (tp-val) "behavior") (= (tp-val) "live") (= (tp-val) "when")))
nil)
(true (do (adv!) (pwf-skip))))))
(pwf-skip)
(match-kw "end")
(list (quote when-feat-no-op))))
(if
(or
(= (tp-type) "hat")
(and (= (tp-type) "keyword") (= (tp-val) "dom")))
(let
((expr (parse-expr)))
(if
(match-kw "changes")
(let
((body (parse-cmd-list)))
(do
(match-kw "end")
(list (quote when-changes) expr body)))
(do
(pwf-skip)
(match-kw "end")
(list (quote when-feat-no-op)))))
(do (pwf-skip) (match-kw "end") (list (quote when-feat-no-op))))))
(define
parse-feat
(fn