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

@@ -49,12 +49,7 @@
;; Toggle a single class on an element.
(define
hs-toggle-class!
(fn
(target cls)
(if
(dom-has-class? target cls)
(dom-remove-class target cls)
(dom-add-class target cls))))
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
;; Toggle between two classes — exactly one is active at a time.
(define
@@ -213,8 +208,27 @@
((= type-name "Float") (+ value 0))
((= type-name "Number") (+ value 0))
((= type-name "String") (str value))
((= type-name "Bool") (if value true false))
((= type-name "Boolean") (if value true false))
((= type-name "Array") (if (list? value) value (list value)))
((= type-name "JSON") (str value))
((= type-name "Object") (if (string? value) value value))
((or (= type-name "Fixed") (string-contains? type-name "Fixed:"))
(let
((digits (if (string-contains? type-name ":") (parse-number (nth (split type-name ":") 1)) 0))
(num (+ value 0)))
(if
(= digits 0)
(str (floor num))
(let
((factor (reduce (fn (acc _) (* acc 10)) 1 (range 0 digits))))
(let
((rounded (/ (floor (+ (* num factor) 0.5)) factor)))
(str rounded))))))
((= type-name "HTML") (str value))
((= type-name "Values") value)
((= type-name "Fragment") (str value))
((= type-name "Date") (str value))
(true value))))
;; ── Object creation ─────────────────────────────────────────────
@@ -323,12 +337,15 @@
((string? collection) (string-contains? collection (str item)))
((list? collection)
(if
(= (len collection) 0)
false
(list? item)
(filter (fn (x) (hs-contains? collection x)) item)
(if
(= (first collection) item)
true
(hs-contains? (rest collection) item))))
(= (len collection) 0)
false
(if
(= (first collection) item)
true
(hs-contains? (rest collection) item)))))
(true false))))
(define
@@ -344,4 +361,170 @@
(define hs-first (fn (lst) (first lst)))
(define hs-last (fn (lst) (last lst)))
(define hs-last (fn (lst) (last lst)))
(define
hs-template
(fn
(raw)
(let
((result "") (i 0) (n (len raw)))
(define
tpl-loop
(fn
()
(when
(< i n)
(let
((ch (nth raw i)))
(if
(and (= ch "$") (< (+ i 1) n))
(if
(= (nth raw (+ i 1)) "{")
(let
((start (+ i 2)))
(define
find-close
(fn
(j depth)
(if
(>= j n)
j
(if
(= (nth raw j) "}")
(if
(= depth 1)
j
(find-close (+ j 1) (- depth 1)))
(if
(= (nth raw j) "{")
(find-close (+ j 1) (+ depth 1))
(find-close (+ j 1) depth))))))
(let
((close (find-close start 1)))
(let
((expr-src (slice raw start close)))
(do
(set!
result
(str
result
(cek-eval (hs-to-sx (hs-compile expr-src)))))
(set! i (+ close 1))
(tpl-loop)))))
(let
((start (+ i 1)))
(define
read-id
(fn
(j)
(if
(and
(< j n)
(let
((c (nth raw j)))
(or
(and (>= c "a") (<= c "z"))
(and (>= c "A") (<= c "Z"))
(and (>= c "0") (<= c "9"))
(= c "_")
(= c "."))))
(read-id (+ j 1))
j)))
(let
((end (read-id start)))
(let
((ident (slice raw start end)))
(do
(set!
result
(str
result
(cek-eval (hs-to-sx (hs-compile ident)))))
(set! i end)
(tpl-loop))))))
(do
(set! result (str result ch))
(set! i (+ i 1))
(tpl-loop)))))))
(do (tpl-loop) result))))
(define
hs-make-object
(fn
(pairs)
(let
((d {}))
(do
(for-each
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
pairs)
d))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define host-get (fn (obj key) (if (= key "length") (len obj) (get obj key))))
;; DOM query stub — sandbox returns empty list
(define dom-query (fn (selector) (list)))
;; Method dispatch — obj.method(args)
(define hs-method-call (fn (obj method &rest args)
(cond
((= method "map") (map (first args) obj))
((= method "push") (do (append! obj (first args)) obj))
((= method "filter") (filter (first args) obj))
((= method "join") (join obj (first args)))
((= method "indexOf")
(let ((item (first args)))
(define idx-loop (fn (lst i)
(if (= (len lst) 0) -1
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
(idx-loop obj 0)))
(true nil))))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define hs-beep (fn (v) v))
;; Property-based is — check obj.key truthiness
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
;; Array slicing (inclusive both ends)
(define hs-slice (fn (col start end)
(let ((s (if (nil? start) 0 start))
(e (if (nil? end) (len col) (+ end 1))))
(slice col s e))))
;; Collection: sorted by
(define hs-sorted-by (fn (col key-fn)
(let ((pairs (map (fn (item) (list (key-fn item) item)) col)))
(map (fn (p) (nth p 1))
(sort (fn (a b) (if (< (first a) (first b)) true false)) pairs)))))
;; Collection: sorted by descending
(define hs-sorted-by-desc (fn (col key-fn)
(let ((pairs (map (fn (item) (list (key-fn item) item)) col)))
(map (fn (p) (nth p 1))
(sort (fn (a b) (if (> (first a) (first b)) true false)) pairs)))))
;; Collection: split by
(define hs-split-by (fn (s sep) (split s sep)))
;; Collection: joined by
(define hs-joined-by (fn (col sep) (join sep col)))
;; Override sorted-by — use decorate-sort-undecorate (no comparator arg to sort)
(define hs-sorted-by (fn (col key-fn)
(let ((decorated (map (fn (item) (list (key-fn item) item)) col)))
(let ((sorted-dec (sort (map first decorated))))
(define reorder (fn (keys acc remaining)
(if (= (len keys) 0) acc
(let ((k (first keys)))
(define find-item (fn (lst)
(if (= (len lst) 0) nil
(if (= (first (first lst)) k) (first lst)
(find-item (rest lst))))))
(let ((found (find-item remaining)))
(reorder (rest keys)
(append acc (list (nth found 1)))
(filter (fn (x) (not (= x found))) remaining)))))))
(reorder sorted-dec (list) decorated)))))
(define hs-sorted-by-desc (fn (col key-fn)
(reverse (hs-sorted-by col key-fn))))