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

Restore hyperscript work on stable site base (908f4f80)

Browse Source 
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:
giles
2026-04-09 19:29:56 +00:00
parent 908f4f80d4
commit 7492ceac4e
55 changed files with 32933 additions and 437 deletions
Download Patch File Download Diff File Expand all files Collapse all files

230
lib/hyperscript/compiler.sx
View File

@@ -267,6 +267,210 @@
((head (first ast)))
(cond
((= head (quote null-literal)) nil)
((= head (quote object-literal))
(let
((pairs (nth ast 1)))
(if
(= (len pairs) 0)
(list (quote dict))
(cons
(quote hs-make-object)
(list
(cons
(quote list)
(map
(fn
(pair)
(list
(quote list)
(first pair)
(hs-to-sx (nth pair 1))))
pairs)))))))
((= head (quote template))
(let
((raw (nth ast 1)))
(let
((parts (list)) (buf "") (i 0) (n (len raw)))
(define
tpl-flush
(fn
()
(when
(> (len buf) 0)
(set! parts (append parts (list buf)))
(set! buf ""))))
(define
tpl-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 "."))))
(tpl-read-id (+ j 1))
j)))
(define
tpl-find-close
(fn
(j depth)
(if
(>= j n)
j
(if
(= (nth raw j) "}")
(if
(= depth 1)
j
(tpl-find-close (+ j 1) (- depth 1)))
(if
(= (nth raw j) "{")
(tpl-find-close (+ j 1) (+ depth 1))
(tpl-find-close (+ j 1) depth))))))
(define
tpl-collect
(fn
()
(when
(< i n)
(let
((ch (nth raw i)))
(if
(and (= ch "$") (< (+ i 1) n))
(if
(= (nth raw (+ i 1)) "{")
(let
((start (+ i 2)))
(let
((close (tpl-find-close start 1)))
(let
((expr-src (slice raw start close)))
(do
(tpl-flush)
(set!
parts
(append
parts
(list
(hs-to-sx (hs-compile expr-src)))))
(set! i (+ close 1))
(tpl-collect)))))
(let
((start (+ i 1)))
(let
((end (tpl-read-id start)))
(let
((ident (slice raw start end)))
(do
(tpl-flush)
(set!
parts
(append
parts
(list
(hs-to-sx (hs-compile ident)))))
(set! i end)
(tpl-collect))))))
(do
(set! buf (str buf ch))
(set! i (+ i 1))
(tpl-collect)))))))
(tpl-collect)
(tpl-flush)
(cons (quote str) parts))))
((= head (quote beep!))
(list (quote hs-beep) (hs-to-sx (nth ast 1))))
((= head (quote array-index))
(list
(quote nth)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote array-slice))
(list
(quote hs-slice)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 3))))
((= head (quote prop-is))
(list
(quote hs-prop-is)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote coll-where))
(list
(quote filter)
(list
(quote fn)
(list (quote it))
(hs-to-sx (nth ast 2)))
(hs-to-sx (nth ast 1))))
((= head (quote coll-sorted))
(list
(quote hs-sorted-by)
(hs-to-sx (nth ast 1))
(list
(quote fn)
(list (quote it))
(hs-to-sx (nth ast 2)))))
((= head (quote coll-sorted-desc))
(list
(quote hs-sorted-by-desc)
(hs-to-sx (nth ast 1))
(list
(quote fn)
(list (quote it))
(hs-to-sx (nth ast 2)))))
((= head (quote coll-mapped))
(list
(quote map)
(list
(quote fn)
(list (quote it))
(hs-to-sx (nth ast 2)))
(hs-to-sx (nth ast 1))))
((= head (quote coll-split))
(list
(quote hs-split-by)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote coll-joined))
(list
(quote hs-joined-by)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote method-call))
(let
((dot-node (nth ast 1))
(args (map hs-to-sx (nth ast 2))))
(if
(and
(list? dot-node)
(= (first dot-node) (make-symbol ".")))
(let
((obj (hs-to-sx (nth dot-node 1)))
(method (nth dot-node 2)))
(cons
(quote hs-method-call)
(cons obj (cons method args))))
(cons
(quote hs-method-call)
(cons (hs-to-sx dot-node) args)))))
((= head (quote string-postfix))
(list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2)))
((= head (quote block-literal))
(let
((params (map make-symbol (nth ast 1)))
(body (hs-to-sx (nth ast 2))))
(if
(= (len params) 0)
body
(list (quote fn) params body))))
((= head (quote me)) (quote me))
((= head (quote it)) (quote it))
((= head (quote event)) (quote event))
@@ -276,7 +480,7 @@
(cond
((= prop "first") (list (quote hs-first) target))
((= prop "last") (list (quote hs-last) target))
(true (list (quote get) target prop)))))
(true (list (quote host-get) target prop)))))
((= head (quote ref)) (make-symbol (nth ast 1)))
((= head (quote query))
(list (quote dom-query) (nth ast 1)))
@@ -333,10 +537,13 @@
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head pct-sym)
(list
(quote modulo)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
(if
(nil? (nth ast 2))
(list (quote str) (hs-to-sx (nth ast 1)) "%")
(list
(quote modulo)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2)))))
((= head (quote empty?))
(list (quote hs-empty?) (hs-to-sx (nth ast 1))))
((= head (quote exists?))
@@ -348,7 +555,7 @@
(quote hs-matches?)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote hs-contains?))
((= head (quote contains?))
(list
(quote hs-contains?)
(hs-to-sx (nth ast 1))
@@ -367,7 +574,7 @@
(cond
((= prop (quote first)) (list (quote first) target))
((= prop (quote last)) (list (quote last) target))
(true (list (quote get) target prop)))))
(true (list (quote host-get) target prop)))))
((= head "!=")
(list
(quote not)
@@ -466,7 +673,7 @@
((= head (quote wait)) (list (quote hs-wait) (nth ast 1)))
((= head (quote wait-for)) (emit-wait-for ast))
((= head (quote log))
(list (quote log) (hs-to-sx (nth ast 1))))
(list (quote console-log) (hs-to-sx (nth ast 1))))
((= head (quote send)) (emit-send ast))
((= head (quote trigger))
(list
@@ -491,9 +698,10 @@
((= head (quote fetch))
(list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2)))
((= head (quote call))
(cons
(make-symbol (nth ast 1))
(map hs-to-sx (rest (rest ast)))))
(let
((fn-expr (hs-to-sx (nth ast 1)))
(args (map hs-to-sx (nth ast 2))))
(cons fn-expr args)))
((= head (quote return)) (hs-to-sx (nth ast 1)))
((= head (quote throw))
(list (quote raise) (hs-to-sx (nth ast 1))))