Restore hyperscript work on stable site base (908f4f80)

Reset to last known-good state (908f4f80) where links, stepper, and
islands all work, then recovered all hyperscript implementation,
conformance tests, behavioral tests, Playwright specs, site sandbox,
IO-aware server loading, and upstream test suite from f271c88a.

Excludes runtime changes (VM resolve hook, VmSuspended browser handler,
sx_ref.ml guard recovery) that need careful re-integration.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-09 19:29:56 +00:00
parent 908f4f80d4
commit 7492ceac4e
55 changed files with 32933 additions and 437 deletions

View File

@@ -71,9 +71,16 @@
(if
(and (= (tp-type) "class") (not (at-end?)))
(let
((prop (get (adv!) "value")))
(parse-prop-chain (list (quote .) base prop)))
base)))
((prop (tp-val)))
(do
(adv!)
(parse-prop-chain (list (make-symbol ".") base prop))))
(if
(= (tp-type) "paren-open")
(let
((args (parse-call-args)))
(parse-prop-chain (list (quote method-call) base args)))
base))))
(define
parse-trav
(fn
@@ -109,12 +116,18 @@
(cond
((= typ "number") (do (adv!) (parse-dur val)))
((= typ "string") (do (adv!) val))
((= typ "template") (do (adv!) (list (quote template) val)))
((and (= typ "keyword") (= val "true")) (do (adv!) true))
((and (= typ "keyword") (= val "false")) (do (adv!) false))
((and (= typ "keyword") (or (= val "null") (= val "nil")))
(do (adv!) (list (quote null-literal))))
((and (= typ "keyword") (= val "undefined"))
(do (adv!) (list (quote null-literal))))
((and (= typ "keyword") (= val "beep"))
(do
(adv!)
(when (and (= (tp-type) "op") (= (tp-val) "!")) (adv!))
(list (quote beep!) (parse-expr))))
((and (= typ "keyword") (= val "not"))
(do (adv!) (list (quote not) (parse-expr))))
((and (= typ "keyword") (= val "no"))
@@ -166,7 +179,8 @@
((= typ "style")
(do (adv!) (list (quote style) val (list (quote me)))))
((= typ "local") (do (adv!) (list (quote local) val)))
((= typ "class") (do (adv!) (str "." val)))
((= typ "class")
(do (adv!) (list (quote query) (str "." val))))
((= typ "ident") (do (adv!) (list (quote ref) val)))
((= typ "paren-open")
(do
@@ -175,6 +189,50 @@
((expr (parse-expr)))
(if (= (tp-type) "paren-close") (adv!) nil)
expr)))
((= typ "brace-open")
(do
(adv!)
(define
obj-collect
(fn
(acc)
(if
(or (at-end?) (= (tp-type) "brace-close"))
(do (when (= (tp-type) "brace-close") (adv!)) acc)
(let
((key (cond ((= (tp-type) "string") (let ((k (tp-val))) (do (adv!) k))) (true (let ((k (tp-val))) (do (adv!) k))))))
(let
((value (cond ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (cond ((= v "true") true) ((= v "false") false) ((= v "null") nil) (true (list (quote ref) v)))))) ((= (tp-type) "colon") (do (adv!) (parse-expr))) (true (parse-expr)))))
(do
(when (= (tp-type) "comma") (adv!))
(obj-collect (cons (list key value) acc))))))))
(list (quote object-literal) (obj-collect (list)))))
((and (= typ "op") (= val "\\"))
(do
(adv!)
(define
bl-params
(fn
(acc)
(cond
((and (= (tp-type) "op") (= (tp-val) "-"))
(if
(and
(< (+ p 1) (len tokens))
(= (get (nth tokens (+ p 1)) "value") ">"))
(do (adv!) (adv!) acc)
acc))
((= (tp-type) "ident")
(let
((name (tp-val)))
(do
(adv!)
(when (= (tp-type) "comma") (adv!))
(bl-params (append acc name)))))
(true acc))))
(let
((params (bl-params (list))))
(list (quote block-literal) params (parse-expr)))))
((= typ "bracket-open") (do (adv!) (parse-array-lit)))
((and (= typ "op") (= val "-"))
(do
@@ -233,6 +291,47 @@
((and (= (tp-type) "op") (= (tp-val) "'s"))
(do (adv!) (parse-poss-tail obj)))
((= (tp-type) "class") (parse-prop-chain obj))
((= (tp-type) "paren-open")
(let
((args (parse-call-args)))
(list (quote call) obj args)))
((= (tp-type) "bracket-open")
(do
(adv!)
(if
(and (= (tp-type) "op") (= (tp-val) ".."))
(do
(adv!)
(let
((end-expr (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(parse-poss
(list (quote array-slice) obj nil end-expr))))
(let
((start-expr (parse-expr)))
(if
(and (= (tp-type) "op") (= (tp-val) ".."))
(do
(adv!)
(if
(= (tp-type) "bracket-close")
(do
(adv!)
(parse-poss
(list (quote array-slice) obj start-expr nil)))
(let
((end-expr (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(parse-poss
(list
(quote array-slice)
obj
start-expr
end-expr)))))
(do
(when (= (tp-type) "bracket-close") (adv!))
(parse-poss
(list (quote array-index) obj start-expr))))))))
(true obj))))
(define
parse-cmp
@@ -344,9 +443,16 @@
(list (quote type-check-strict) left type-name)
(list (quote type-check) left type-name))))))
(true
(let
((right (parse-expr)))
(list (quote =) left right))))))
(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)))
(list (quote =) left right)))))))
((and (= typ "keyword") (= val "am"))
(do
(adv!)
@@ -373,17 +479,41 @@
(do (adv!) (list (quote matches?) left (parse-expr))))
((and (= typ "keyword") (= val "contains"))
(do (adv!) (list (quote contains?) left (parse-expr))))
((and (= typ "keyword") (= val "and"))
(do (adv!) (list (quote and) left (parse-expr))))
((and (= typ "keyword") (= val "or"))
(do (adv!) (list (quote or) left (parse-expr))))
((and (= typ "keyword") (= val "as"))
(do
(adv!)
(when (or (= (tp-val) "a") (= (tp-val) "an")) (adv!))
(let
((type-name (tp-val)))
(do
(adv!)
(if
(and (= (tp-type) "colon") (not (at-end?)))
(do
(adv!)
(let
((param (tp-val)))
(do
(adv!)
(list
(quote as)
left
(str type-name ":" param)))))
(list (quote as) left type-name))))))
((and (= typ "colon"))
(do
(adv!)
(let
((type-name (tp-val)))
(adv!)
(list (quote as) left type-name))))
(do
(adv!)
(let
((strict (and (= (tp-type) "op") (= (tp-val) "!"))))
(when strict (adv!))
(if
strict
(list (quote type-check-strict) left type-name)
(list (quote type-check) left type-name)))))))
((and (= typ "keyword") (= val "of"))
(do
(adv!)
@@ -425,6 +555,61 @@
((and (= typ "keyword") (or (= val "contain") (= val "include") (= val "includes")))
(do (adv!) (list (quote contains?) left (parse-expr))))
(true left)))))
(define
parse-collection
(fn
(left)
(cond
((match-kw "where")
(let
((cond-expr (parse-cmp (parse-arith (parse-poss (parse-atom))))))
(parse-collection (list (quote coll-where) left cond-expr))))
((match-kw "sorted")
(do
(match-kw "by")
(let
((key-expr (parse-cmp (parse-arith (parse-poss (parse-atom))))))
(let
((desc (match-kw "descending")))
(when (not desc) (match-kw "ascending"))
(parse-collection
(if
desc
(list (quote coll-sorted-desc) left key-expr)
(list (quote coll-sorted) left key-expr)))))))
((match-kw "mapped")
(do
(match-kw "to")
(let
((map-expr (parse-cmp (parse-arith (parse-poss (parse-atom))))))
(parse-collection (list (quote coll-mapped) left map-expr)))))
((match-kw "split")
(do
(match-kw "by")
(let
((sep (parse-cmp (parse-arith (parse-poss (parse-atom))))))
(parse-collection (list (quote coll-split) left sep)))))
((match-kw "joined")
(do
(match-kw "by")
(let
((sep (parse-cmp (parse-arith (parse-poss (parse-atom))))))
(parse-collection (list (quote coll-joined) left sep)))))
(true left))))
(define
parse-logical
(fn
(left)
(cond
((match-kw "and")
(let
((right (parse-collection (parse-cmp (parse-arith (parse-poss (parse-atom)))))))
(parse-logical (list (quote and) left right))))
((match-kw "or")
(let
((right (parse-collection (parse-cmp (parse-arith (parse-poss (parse-atom)))))))
(parse-logical (list (quote or) left right))))
(true left))))
(define
parse-expr
(fn
@@ -434,9 +619,43 @@
(if
(nil? left)
nil
(let
((left2 (parse-poss left)))
(let ((left3 (parse-arith left2))) (parse-cmp left3)))))))
(do
(when
(and (number? left) (= (tp-type) "ident"))
(let
((unit (tp-val)))
(do
(adv!)
(set! left (list (quote string-postfix) left unit)))))
(let
((l2 (parse-poss left)))
(let
((l3 (parse-arith l2)))
(let
((l4 (parse-cmp l3)))
(let
((l5 (parse-collection l4)))
(let
((result (parse-logical l5)))
(if
(and
result
(or
(and
(= (tp-type) "ident")
(not
(or
(= (tp-val) "then")
(= (tp-val) "end")
(= (tp-val) "else")
(= (tp-val) "otherwise"))))
(and (= (tp-type) "op") (= (tp-val) "%"))))
(let
((unit (tp-val)))
(do
(adv!)
(list (quote string-postfix) result unit)))
result)))))))))))
(define
parse-tgt-kw
(fn (kw default) (if (match-kw kw) (parse-expr) default)))