Step 17: streaming render — hyperscript enhancements, WASM builds, live server tests

Streaming chunked transfer with shell-first suspense and resolve scripts.
Hyperscript parser/compiler/runtime expanded for conformance. WASM static
assets added to OCaml host. Playwright streaming and page-level test suites.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-12 08:41:38 +00:00
parent 7aefe4da8f
commit 6e27442d57
29 changed files with 65959 additions and 628 deletions

View File

@@ -70,17 +70,38 @@
((target (if source (hs-to-sx source) (quote me))))
(let
((compiled-body (hs-to-sx body))
(wrapped-body
(if catch-info
(let ((var (make-symbol (first catch-info)))
(catch-body (hs-to-sx (nth catch-info 1))))
(if finally-info
(list (quote do) (list (quote guard) (list var (list true catch-body)) compiled-body) (hs-to-sx finally-info))
(list (quote guard) (list var (list true catch-body)) compiled-body)))
(if finally-info
(list (quote do) compiled-body (hs-to-sx finally-info))
compiled-body)))
(handler (list (quote fn) (list (quote event)) wrapped-body)))
(wrapped-body
(if
catch-info
(let
((var (make-symbol (first catch-info)))
(catch-body
(hs-to-sx (nth catch-info 1))))
(if
finally-info
(list
(quote do)
(list
(quote guard)
(list var (list true catch-body))
compiled-body)
(hs-to-sx finally-info))
(list
(quote guard)
(list var (list true catch-body))
compiled-body)))
(if
finally-info
(list
(quote do)
compiled-body
(hs-to-sx finally-info))
compiled-body)))
(handler
(list
(quote fn)
(list (quote event))
wrapped-body)))
(if
every?
(list
@@ -106,12 +127,37 @@
catch-info
finally-info))
((= (first items) :every)
(scan-on (rest (rest items)) source filter true catch-info finally-info))
(scan-on
(rest (rest items))
source
filter
true
catch-info
finally-info))
((= (first items) :catch)
(scan-on (rest (rest items)) source filter every? (nth items 1) finally-info))
(scan-on
(rest (rest items))
source
filter
every?
(nth items 1)
finally-info))
((= (first items) :finally)
(scan-on (rest (rest items)) source filter every? catch-info (nth items 1)))
(true (scan-on (rest items) source filter every? catch-info finally-info)))))
(scan-on
(rest (rest items))
source
filter
every?
catch-info
(nth items 1)))
(true
(scan-on
(rest items)
source
filter
every?
catch-info
finally-info)))))
(scan-on (rest parts) nil nil false nil nil)))))
(define
emit-send
@@ -223,13 +269,11 @@
(define
emit-inc
(fn
(expr tgt-override)
(let
((t (hs-to-sx expr)))
(if
(and (list? expr) (= (first expr) (quote attr)))
(expr amount tgt-override)
(cond
((and (list? expr) (= (first expr) (quote attr)))
(let
((el (if tgt-override (hs-to-sx tgt-override) (hs-to-sx (nth expr 2)))))
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
(list
(quote dom-set-attr)
el
@@ -239,18 +283,46 @@
(list
(quote parse-number)
(list (quote dom-get-attr) el (nth expr 1)))
1)))
(list (quote set!) t (list (quote +) t 1))))))
amount))))
((and (list? expr) (= (first expr) dot-sym))
(let
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
(list
(quote host-set)
obj
prop
(list
(quote +)
(list
(quote parse-number)
(list (quote host-get) obj prop))
amount))))
((and (list? expr) (= (first expr) (quote style)))
(let
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
(prop (nth expr 1)))
(list
(quote dom-set-style)
el
prop
(list
(quote +)
(list
(quote parse-number)
(list (quote dom-get-style) el prop))
amount))))
(true
(let
((t (hs-to-sx expr)))
(list (quote set!) t (list (quote +) t amount)))))))
(define
emit-dec
(fn
(expr tgt-override)
(let
((t (hs-to-sx expr)))
(if
(and (list? expr) (= (first expr) (quote attr)))
(expr amount tgt-override)
(cond
((and (list? expr) (= (first expr) (quote attr)))
(let
((el (if tgt-override (hs-to-sx tgt-override) (hs-to-sx (nth expr 2)))))
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
(list
(quote dom-set-attr)
el
@@ -260,8 +332,38 @@
(list
(quote parse-number)
(list (quote dom-get-attr) el (nth expr 1)))
1)))
(list (quote set!) t (list (quote -) t 1))))))
amount))))
((and (list? expr) (= (first expr) dot-sym))
(let
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
(list
(quote host-set)
obj
prop
(list
(quote -)
(list
(quote parse-number)
(list (quote host-get) obj prop))
amount))))
((and (list? expr) (= (first expr) (quote style)))
(let
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
(prop (nth expr 1)))
(list
(quote dom-set-style)
el
prop
(list
(quote -)
(list
(quote parse-number)
(list (quote dom-get-style) el prop))
amount))))
(true
(let
((t (hs-to-sx expr)))
(list (quote set!) t (list (quote -) t amount)))))))
(define
emit-behavior
(fn
@@ -654,13 +756,23 @@
(hs-to-sx (nth ast 2))
(nth ast 1)))
((= head (quote multi-add-class))
(let ((target (hs-to-sx (nth ast 1)))
(classes (rest (rest ast))))
(cons (quote do) (map (fn (cls) (list (quote dom-add-class) target cls)) classes))))
(let
((target (hs-to-sx (nth ast 1)))
(classes (rest (rest ast))))
(cons
(quote do)
(map
(fn (cls) (list (quote dom-add-class) target cls))
classes))))
((= head (quote multi-remove-class))
(let ((target (hs-to-sx (nth ast 1)))
(classes (rest (rest ast))))
(cons (quote do) (map (fn (cls) (list (quote dom-remove-class) target cls)) classes))))
(let
((target (hs-to-sx (nth ast 1)))
(classes (rest (rest ast))))
(cons
(quote do)
(map
(fn (cls) (list (quote dom-remove-class) target cls))
classes))))
((= head (quote remove-class))
(list
(quote dom-remove-class)
@@ -677,6 +789,30 @@
(hs-to-sx (nth ast 3))
(nth ast 1)
(nth ast 2)))
((= head (quote toggle-style))
(list
(quote hs-toggle-style!)
(hs-to-sx (nth ast 2))
(nth ast 1)))
((= head (quote toggle-style-between))
(list
(quote hs-toggle-style-between!)
(hs-to-sx (nth ast 4))
(nth ast 1)
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 3))))
((= head (quote toggle-attr))
(list
(quote hs-toggle-attr!)
(hs-to-sx (nth ast 2))
(nth ast 1)))
((= head (quote toggle-attr-between))
(list
(quote hs-toggle-attr-between!)
(hs-to-sx (nth ast 4))
(nth ast 1)
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 3))))
((= head (quote set!))
(emit-set (nth ast 1) (hs-to-sx (nth ast 2))))
((= head (quote put!))
@@ -749,8 +885,21 @@
(list (list (quote me) (hs-to-sx (nth ast 1))))
(hs-to-sx (nth ast 2))))
((= head (quote for)) (emit-for ast))
((= head (quote take))
(list (quote hs-take!) (hs-to-sx (nth ast 2)) (nth ast 1)))
((= head (quote take!))
(let
((kind (nth ast 1))
(name (nth ast 2))
(from-sel (if (> (len ast) 3) (nth ast 3) nil))
(for-tgt (if (> (len ast) 4) (nth ast 4) nil)))
(let
((target (if for-tgt (hs-to-sx for-tgt) (quote me)))
(scope
(cond
((nil? from-sel) nil)
((and (list? from-sel) (= (first from-sel) (quote query)))
(list (quote hs-query-all) (nth from-sel 1)))
(true (hs-to-sx from-sel)))))
(list (quote hs-take!) target kind name scope))))
((= head (quote make)) (emit-make ast))
((= head (quote install))
(cons (quote hs-install) (map hs-to-sx (rest ast))))
@@ -759,11 +908,13 @@
((= head (quote increment!))
(emit-inc
(nth ast 1)
(if (> (len ast) 2) (nth ast 2) nil)))
(nth ast 2)
(if (> (len ast) 3) (nth ast 3) nil)))
((= head (quote decrement!))
(emit-dec
(nth ast 1)
(if (> (len ast) 2) (nth ast 2) nil)))
(nth ast 2)
(if (> (len ast) 3) (nth ast 3) nil)))
((= head (quote on)) (emit-on ast))
((= head (quote init))
(list
@@ -860,6 +1011,23 @@
(list (make-symbol (nth ast 1)))
(hs-to-sx (nth ast 3)))
(hs-to-sx (nth ast 2))))
((= head (quote scroll!))
(list
(quote hs-scroll!)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote select!))
(list (quote hs-select!) (hs-to-sx (nth ast 1))))
((= head (quote reset!))
(list (quote hs-reset!) (hs-to-sx (nth ast 1))))
((= head (quote default!))
(let
((t (hs-to-sx (nth ast 1))) (v (hs-to-sx (nth ast 2))))
(list
(quote when)
(list (quote nil?) t)
(list (quote set!) t v))))
((= head (quote halt!)) (list (quote hs-halt!) (nth ast 1)))
(true ast))))))))
;; ── Convenience: source → SX ─────────────────────────────────

View File

@@ -364,11 +364,15 @@
((match-kw "in")
(list (quote not-in?) left (parse-expr)))
((match-kw "between")
(let ((lo (parse-atom)))
(let
((lo (parse-atom)))
(match-kw "and")
(let ((hi (parse-atom)))
(list (quote not)
(list (quote and)
(let
((hi (parse-atom)))
(list
(quote not)
(list
(quote and)
(list (quote >=) left lo)
(list (quote <=) left hi))))))
((match-kw "really")
@@ -429,10 +433,13 @@
(list (quote >=) left (parse-expr)))
(list (quote >) left (parse-expr)))))
((match-kw "between")
(let ((lo (parse-atom)))
(let
((lo (parse-atom)))
(match-kw "and")
(let ((hi (parse-atom)))
(list (quote and)
(let
((hi (parse-atom)))
(list
(quote and)
(list (quote >=) left lo)
(list (quote <=) left hi)))))
((match-kw "in") (list (quote in?) left (parse-expr)))
@@ -491,10 +498,14 @@
((and (= typ "keyword") (= val "exists"))
(do (adv!) (list (quote exists?) left)))
((and (or (= typ "keyword") (= typ "ident")) (= val "starts"))
(do (adv!) (match-kw "with")
(do
(adv!)
(match-kw "with")
(list (quote starts-with?) left (parse-expr))))
((and (or (= typ "keyword") (= typ "ident")) (= val "ends"))
(do (adv!) (match-kw "with")
(do
(adv!)
(match-kw "with")
(list (quote ends-with?) left (parse-expr))))
((and (= typ "keyword") (= val "matches"))
(do (adv!) (list (quote matches?) left (parse-expr))))
@@ -687,20 +698,26 @@
(if
(= (tp-type) "class")
(let
((cls (get (adv!) "value"))
(extra-classes (list)))
;; Collect additional class refs
(define collect-classes!
(fn ()
(when (= (tp-type) "class")
(set! extra-classes (append extra-classes (list (get (adv!) "value"))))
((cls (get (adv!) "value")) (extra-classes (list)))
(define
collect-classes!
(fn
()
(when
(= (tp-type) "class")
(set!
extra-classes
(append extra-classes (list (get (adv!) "value"))))
(collect-classes!))))
(collect-classes!)
(let
((tgt (parse-tgt-kw "to" (list (quote me)))))
(if (empty? extra-classes)
(if
(empty? extra-classes)
(list (quote add-class) cls tgt)
(cons (quote multi-add-class) (cons tgt (cons cls extra-classes))))))
(cons
(quote multi-add-class)
(cons tgt (cons cls extra-classes))))))
nil)))
(define
parse-remove-cmd
@@ -709,19 +726,26 @@
(if
(= (tp-type) "class")
(let
((cls (get (adv!) "value"))
(extra-classes (list)))
(define collect-classes!
(fn ()
(when (= (tp-type) "class")
(set! extra-classes (append extra-classes (list (get (adv!) "value"))))
((cls (get (adv!) "value")) (extra-classes (list)))
(define
collect-classes!
(fn
()
(when
(= (tp-type) "class")
(set!
extra-classes
(append extra-classes (list (get (adv!) "value"))))
(collect-classes!))))
(collect-classes!)
(let
((tgt (parse-tgt-kw "from" (list (quote me)))))
(if (empty? extra-classes)
(if
(empty? extra-classes)
(list (quote remove-class) cls tgt)
(cons (quote multi-remove-class) (cons tgt (cons cls extra-classes))))))
(cons
(quote multi-remove-class)
(cons tgt (cons cls extra-classes))))))
nil)))
(define
parse-toggle-cmd
@@ -732,12 +756,12 @@
(if
(= (tp-type) "class")
(let
((cls1 (get (adv!) "value")))
((cls1 (do (let ((v (tp-val))) (adv!) v))))
(expect-kw! "and")
(if
(= (tp-type) "class")
(let
((cls2 (get (adv!) "value")))
((cls2 (do (let ((v (tp-val))) (adv!) v))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-between) cls1 cls2 tgt)))
@@ -745,10 +769,47 @@
nil))
((= (tp-type) "class")
(let
((cls (get (adv!) "value")))
((cls (do (let ((v (tp-val))) (adv!) v))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-class) cls tgt))))
((= (tp-type) "style")
(let
((prop (do (let ((v (tp-val))) (adv!) v))))
(if
(match-kw "between")
(let
((val1 (parse-atom)))
(expect-kw! "and")
(let
((val2 (parse-atom)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-style-between) prop val1 val2 tgt))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-style) prop tgt)))))
((= (tp-type) "attr")
(let
((attr-name (do (let ((v (tp-val))) (adv!) v))))
(if
(match-kw "between")
(let
((val1 (parse-atom)))
(expect-kw! "and")
(let
((val2 (parse-atom)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list
(quote toggle-attr-between)
attr-name
val1
val2
tgt))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-attr) attr-name tgt)))))
(true nil))))
(define
parse-set-cmd
@@ -772,9 +833,16 @@
(list (quote put!) value "after" (parse-expr)))
((match-kw "at")
(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)))))
((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
@@ -863,8 +931,10 @@
(let
((expr (parse-expr)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote increment!) expr tgt)))))
((amount (if (match-kw "by") (parse-expr) 1)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote increment!) expr amount tgt))))))
(define
parse-dec-cmd
(fn
@@ -872,8 +942,10 @@
(let
((expr (parse-expr)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote decrement!) expr tgt)))))
((amount (if (match-kw "by") (parse-expr) 1)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote decrement!) expr amount tgt))))))
(define
parse-hide-cmd
(fn
@@ -909,12 +981,25 @@
parse-repeat-cmd
(fn
()
(let
((mode (cond ((match-kw "forever") (list (quote forever))) ((match-kw "while") (list (quote while) (parse-expr))) ((match-kw "until") (list (quote until) (parse-expr))) ((= (tp-type) "number") (let ((n (parse-dur (get (adv!) "value")))) (expect-kw! "times") (list (quote times) n))) (true (list (quote forever))))))
(let
((body (parse-cmd-list)))
(match-kw "end")
(list (quote repeat) mode body)))))
(cond
((and (= (tp-type) "keyword") (= (tp-val) "for"))
(do (adv!) (parse-for-cmd)))
((and (= (tp-type) "keyword") (= (tp-val) "in"))
(do
(adv!)
(let
((collection (parse-expr)))
(let
((body (parse-cmd-list)))
(match-kw "end")
(list (quote for) "it" collection nil body)))))
(true
(let
((mode (cond ((match-kw "forever") (list (quote forever))) ((match-kw "while") (list (quote while) (parse-expr))) ((match-kw "until") (list (quote until) (parse-expr))) (true (let ((n (parse-expr))) (if (match-kw "times") (list (quote times) n) (list (quote forever))))))))
(let
((body (parse-cmd-list)))
(match-kw "end")
(list (quote repeat) mode body)))))))
(define
parse-fetch-cmd
(fn
@@ -959,16 +1044,24 @@
parse-take-cmd
(fn
()
(if
(= (tp-type) "class")
(let
((cls (get (adv!) "value")))
(cond
((= (tp-type) "class")
(let
((tgt (if (match-kw "for")
(parse-expr)
(parse-tgt-kw "from" (list (quote me))))))
(list (quote take) cls tgt)))
nil)))
((cls (do (let ((v (tp-val))) (adv!) v))))
(let
((from-sel (if (match-kw "from") (parse-expr) nil)))
(let
((for-tgt (if (match-kw "for") (parse-expr) nil)))
(list (quote take!) "class" cls from-sel for-tgt)))))
((= (tp-type) "attr")
(let
((attr-name (do (let ((v (tp-val))) (adv!) v))))
(let
((from-sel (if (match-kw "from") (parse-expr) nil)))
(let
((for-tgt (if (match-kw "for") (parse-expr) nil)))
(list (quote take!) "attr" attr-name from-sel for-tgt)))))
(true nil))))
(define
parse-go-cmd
(fn () (match-kw "to") (list (quote go) (parse-expr))))
@@ -1124,6 +1217,44 @@
(let
((tgt (parse-expr)))
(list (quote measure) (if (nil? tgt) (list (quote me)) tgt)))))
(define
parse-scroll-cmd
(fn
()
(let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
(let
((pos (cond ((match-kw "top") "top") ((match-kw "bottom") "bottom") ((match-kw "left") "left") ((match-kw "right") "right") (true "top"))))
(list (quote scroll!) tgt pos)))))
(define
parse-select-cmd
(fn
()
(let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
(list (quote select!) tgt))))
(define
parse-reset-cmd
(fn
()
(let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
(list (quote reset!) tgt))))
(define
parse-default-cmd
(fn
()
(let
((tgt (parse-expr)))
(expect-kw! "to")
(let ((val (parse-expr))) (list (quote default!) tgt val)))))
(define
parse-halt-cmd
(fn
()
(let
((the-event (and (match-kw "the") (or (match-kw "event") (match-kw "default")))))
(list (quote halt!) (if the-event "event" "default")))))
(define
parse-param-list
(fn () (if (= (tp-type) "paren-open") (parse-call-args) (list))))
@@ -1241,7 +1372,6 @@
(let
((typ (tp-type)) (val (tp-val)))
(cond
;; Terminators — these end a command list, not start a command
((and (= typ "keyword") (or (= val "catch") (= val "finally") (= val "end") (= val "else") (= val "otherwise")))
nil)
((and (= typ "keyword") (= val "add"))
@@ -1304,11 +1434,61 @@
(do (adv!) (parse-measure-cmd)))
((and (= typ "keyword") (= val "render"))
(do (adv!) (parse-render-cmd)))
((and (= typ "keyword") (= val "scroll"))
(do (adv!) (parse-scroll-cmd)))
((and (= typ "keyword") (= val "select"))
(do (adv!) (parse-select-cmd)))
((and (= typ "keyword") (= val "reset"))
(do (adv!) (parse-reset-cmd)))
((and (= typ "keyword") (= val "default"))
(do (adv!) (parse-default-cmd)))
((and (= typ "keyword") (= val "halt"))
(do (adv!) (parse-halt-cmd)))
(true (parse-expr))))))
(define
parse-cmd-list
(fn
()
(define
cmd-kw?
(fn
(v)
(or
(= v "add")
(= v "remove")
(= v "toggle")
(= v "set")
(= v "put")
(= v "if")
(= v "wait")
(= v "send")
(= v "trigger")
(= v "log")
(= v "increment")
(= v "decrement")
(= v "hide")
(= v "show")
(= v "transition")
(= v "repeat")
(= v "fetch")
(= v "call")
(= v "take")
(= v "settle")
(= v "go")
(= v "return")
(= v "throw")
(= v "append")
(= v "tell")
(= v "for")
(= v "make")
(= v "install")
(= v "measure")
(= v "render")
(= v "halt")
(= v "default")
(= v "scroll")
(= v "select")
(= v "reset"))))
(define
cl-collect
(fn
@@ -1320,7 +1500,11 @@
acc
(let
((acc2 (append acc (list cmd))))
(if (match-kw "then") (cl-collect acc2) acc2))))))
(cond
((match-kw "then") (cl-collect acc2))
((and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val)))
(cl-collect acc2))
(true acc2)))))))
(let
((cmds (cl-collect (list))))
(cond
@@ -1341,31 +1525,26 @@
((source (if (match-kw "from") (parse-expr) nil)))
(let
((body (parse-cmd-list)))
;; Parse optional catch/finally
(let
((catch-clause
(if (match-kw "catch")
(let ((var (let ((v (tp-val))) (adv!) v))
(handler (parse-cmd-list)))
(list var handler))
nil))
(finally-clause
(if (match-kw "finally")
(parse-cmd-list)
nil)))
(match-kw "end")
(let
((parts (list (quote on) event-name)))
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
(finally-clause
(if (match-kw "finally") (parse-cmd-list) nil)))
(match-kw "end")
(let
((parts (if every? (append parts (list :every true)) parts)))
((parts (list (quote on) event-name)))
(let
((parts (if flt (append parts (list :filter flt)) parts)))
((parts (if every? (append parts (list :every true)) parts)))
(let
((parts (if source (append parts (list :from source)) parts)))
(let ((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
(let ((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
(let ((parts (append parts (list body))))
parts)))))))))))))))
((parts (if flt (append parts (list :filter flt)) parts)))
(let
((parts (if source (append parts (list :from source)) parts)))
(let
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
(let
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
(let
((parts (append parts (list body))))
parts)))))))))))))))
(define
parse-init-feat
(fn
@@ -1403,5 +1582,4 @@
(first features)
(cons (quote do) features))))))
;; ── Convenience: source string → AST ─────────────────────────────
(define hs-compile (fn (src) (hs-parse (hs-tokenize src) src)))

View File

@@ -64,22 +64,50 @@
;; Take a class from siblings — add to target, remove from others.
;; (hs-take! target cls) — like radio button class behavior
(define
hs-take!
hs-toggle-style!
(fn
(target cls)
(target prop)
(let
((parent (dom-parent target)))
(when
parent
(for-each
(fn (child) (dom-remove-class child cls))
(dom-child-list parent)))
(dom-add-class target cls))))
((cur (dom-get-style target prop)))
(cond
((= prop "visibility")
(if
(= cur "hidden")
(dom-set-style target prop "visible")
(dom-set-style target prop "hidden")))
((or (= prop "display") (= prop "opacity"))
(if
(or (= cur "none") (= cur "0"))
(dom-set-style target prop "")
(dom-set-style target prop (if (= prop "display") "none" "0"))))
(true
(if
(or (= cur "") (= cur nil))
(dom-set-style target prop "hidden")
(dom-set-style target prop "")))))))
;; ── DOM insertion ───────────────────────────────────────────────
;; Put content at a position relative to a target.
;; pos: "into" | "before" | "after"
(define
hs-take!
(fn
(target kind name scope)
(let
((els (if scope (if (list? scope) scope (list scope)) (let ((parent (host-get target "parentNode"))) (if parent (dom-child-list parent) (list))))))
(if
(= kind "class")
(do
(for-each (fn (el) (dom-remove-class el name)) els)
(dom-add-class target name))
(do
(for-each (fn (el) (dom-remove-attr el name)) els)
(dom-set-attr target name "true"))))))
;; ── Navigation / traversal ──────────────────────────────────────
;; Navigate to a URL.
(define
hs-put!
(fn
@@ -92,12 +120,38 @@
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
((= pos "end") (dom-insert-adjacent-html target "beforeend" value)))))
;; ── Navigation / traversal ──────────────────────────────────────
;; Navigate to a URL.
;; Find next sibling matching a selector (or any sibling).
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
;; Find next sibling matching a selector (or any sibling).
;; Find previous sibling matching a selector.
(define
hs-scroll!
(fn
(target position)
(host-call
target
"scrollIntoView"
(list
(cond
((= position "bottom") (dict :block "end"))
(true (dict :block "start")))))))
;; First element matching selector within a scope.
(define
hs-halt!
(fn
(mode)
(when
event
(host-call event "preventDefault" (list))
(when (= mode "event") (host-call event "stopPropagation" (list))))))
;; Last element matching selector.
(define hs-select! (fn (target) (host-call target "select" (list))))
;; First/last within a specific scope.
(define hs-reset! (fn (target) (host-call target "reset" (list))))
(define
hs-next
(fn
@@ -117,7 +171,9 @@
(true (find-next (dom-next-sibling el))))))
(find-next sibling)))))
;; Find previous sibling matching a selector.
;; ── Iteration ───────────────────────────────────────────────────
;; Repeat a thunk N times.
(define
hs-previous
(fn
@@ -137,12 +193,27 @@
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
(find-prev sibling)))))
;; First element matching selector within a scope.
;; Repeat forever (until break — relies on exception/continuation).
(define
hs-query-all
(fn
(sel)
(dom-query-all
(host-call (host-global "document") "querySelector" (list "body"))
sel)))
;; ── Fetch ───────────────────────────────────────────────────────
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(define
hs-query-first
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
;; Last element matching selector.
;; ── Type coercion ───────────────────────────────────────────────
;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define
hs-query-last
(fn
@@ -151,9 +222,17 @@
((all (dom-query-all (dom-body) sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; First/last within a specific scope.
;; ── Object creation ─────────────────────────────────────────────
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
;; ── Behavior installation ───────────────────────────────────────
;; Install a behavior on an element.
;; A behavior is a function that takes (me ...params) and sets up features.
;; (hs-install behavior-fn me ...args)
(define
hs-last
(fn
@@ -162,9 +241,10 @@
((all (dom-query-all scope sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; ── Iteration ───────────────────────────────────────────────────
;; ── Measurement ─────────────────────────────────────────────────
;; Repeat a thunk N times.
;; Measure an element's bounding rect, store as local variables.
;; Returns a dict with x, y, width, height, top, left, right, bottom.
(define
hs-repeat-times
(fn
@@ -174,7 +254,10 @@
(fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1))))))
(do-repeat 0)))
;; Repeat forever (until break — relies on exception/continuation).
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
hs-repeat-forever
(fn
@@ -182,10 +265,6 @@
(define do-forever (fn () (thunk) (do-forever)))
(do-forever)))
;; ── Fetch ───────────────────────────────────────────────────────
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(define
hs-fetch
(fn
@@ -198,10 +277,6 @@
((= format "html") (perform (list (quote io-parse-html) response)))
(true response)))))
;; ── Type coercion ───────────────────────────────────────────────
;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define
hs-coerce
(fn
@@ -235,19 +310,10 @@
((= type-name "Date") (str value))
(true value))))
;; ── Object creation ─────────────────────────────────────────────
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
(define
hs-add
(fn (a b) (if (or (string? a) (string? b)) (str a b) (+ a b))))
;; ── Behavior installation ───────────────────────────────────────
;; Install a behavior on an element.
;; A behavior is a function that takes (me ...params) and sets up features.
;; (hs-install behavior-fn me ...args)
(define
hs-make
(fn
@@ -259,16 +325,8 @@
((= type-name "Map") (dict))
(true (dict)))))
;; ── Measurement ─────────────────────────────────────────────────
;; Measure an element's bounding rect, store as local variables.
;; Returns a dict with x, y, width, height, top, left, right, bottom.
(define hs-install (fn (behavior-fn) (behavior-fn me)))
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
hs-measure
(fn (target) (perform (list (quote io-measure) target))))
@@ -311,6 +369,10 @@
hs-strict-eq
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
(define
hs-falsy?
(fn
@@ -331,7 +393,8 @@
(string? target)
(if (= pattern ".*") true (string-contains? target pattern))
false)))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define
hs-contains?
(fn
@@ -351,7 +414,7 @@
true
(hs-contains? (rest collection) item)))))
(true false))))
;; DOM query stub — sandbox returns empty list
(define
hs-empty?
(fn
@@ -362,15 +425,13 @@
((list? v) (= (len v) 0))
((dict? v) (= (len (keys v)) 0))
(true false))))
;; Method dispatch — obj.method(args)
(define hs-first (fn (lst) (first lst)))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define hs-last (fn (lst) (last lst)))
;; Property-based is — check obj.key truthiness
(define
hs-template
(fn
@@ -456,7 +517,7 @@
(set! i (+ i 1))
(tpl-loop)))))))
(do (tpl-loop) result))))
;; Array slicing (inclusive both ends)
(define
hs-make-object
(fn
@@ -468,8 +529,7 @@
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
pairs)
d))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
;; Collection: sorted by
(define
hs-method-call
(fn
@@ -492,13 +552,11 @@
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
(idx-loop obj 0)))
(true nil))))
;; DOM query stub — sandbox returns empty list
;; Collection: sorted by descending
(define hs-beep (fn (v) v))
;; Method dispatch — obj.method(args)
;; Collection: split by
(define hs-prop-is (fn (obj key) (not (hs-falsy? (host-get obj key)))))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
;; Collection: joined by
(define
hs-slice
(fn
@@ -507,7 +565,7 @@
((s (if (nil? start) 0 start))
(e (if (nil? end) (len col) (+ end 1))))
(slice col s e))))
;; Property-based is — check obj.key truthiness
(define
hs-sorted-by
(fn
@@ -517,7 +575,7 @@
(map
(fn (p) (nth p 1))
(sort (fn (a b) (if (< (first a) (first b)) true false)) pairs)))))
;; Array slicing (inclusive both ends)
(define
hs-sorted-by-desc
(fn
@@ -527,11 +585,11 @@
(map
(fn (p) (nth p 1))
(sort (fn (a b) (if (> (first a) (first b)) true false)) pairs)))))
;; Collection: sorted by
(define hs-split-by (fn (s sep) (split s sep)))
;; Collection: sorted by descending
(define hs-joined-by (fn (col sep) (join sep col)))
;; Collection: split by
(define
hs-sorted-by
(fn
@@ -567,7 +625,7 @@
(append acc (list (nth found 1)))
(filter (fn (x) (not (= x found))) remaining)))))))
(reorder sorted-dec (list) decorated)))))
;; Collection: joined by
(define
hs-sorted-by-desc
(fn (col key-fn) (reverse (hs-sorted-by col key-fn))))

View File

@@ -161,7 +161,12 @@
"split"
"joined"
"descending"
"ascending"))
"ascending"
"scroll"
"select"
"reset"
"default"
"halt"))
(define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords)))