Rebuild hyperscript WASM bytecode bundles (hs-*.sxbc + manifest)

Updates the pre-bundled HS tokenizer/parser/compiler/runtime/integration
sx + sxbc pairs plus module-manifest.json in shared/static/wasm/sx/,
matching the current HS source after recent patches (call command,
event destructuring, halt/append, break/continue, CSS block syntax, etc.).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-22 09:09:56 +00:00
parent 5c42f4842b
commit 7357988af6
11 changed files with 504 additions and 241 deletions

View File

@@ -110,47 +110,32 @@
(let
((target (if source (hs-to-sx source) (quote me))))
(let
((compiled-body (hs-to-sx body))
(wrapped-body
(if
catch-info
((event-refs (if (and (list? body) (= (first body) (quote do))) (filter (fn (x) (and (list? x) (= (first x) (quote ref)))) (rest body)) (list))))
(let
((stripped-body (if (> (len event-refs) 0) (let ((remaining (filter (fn (x) (not (and (list? x) (= (first x) (quote ref))))) (rest body)))) (if (= (len remaining) 1) (first remaining) (cons (quote do) remaining))) body)))
(let
((raw-compiled (hs-to-sx stripped-body)))
(let
((compiled-body (if (> (len event-refs) 0) (let ((bindings (map (fn (r) (let ((name (nth r 1))) (list (make-symbol name) (list (quote get) (list (quote get) (quote event) "detail") name)))) event-refs))) (list (quote let) bindings raw-compiled)) raw-compiled)))
(let
((var (make-symbol (first catch-info)))
(catch-body
(hs-to-sx (nth catch-info 1))))
(if
finally-info
(list
(quote do)
((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (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 guard)
(list var (list true catch-body))
compiled-body)
(hs-to-sx finally-info))
(quote fn)
(list (quote event))
wrapped-body)))
(if
every?
(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
(quote hs-on-every)
target
event-name
handler)
(list (quote hs-on) target event-name handler))))))
(quote hs-on-every)
target
event-name
handler)
(list
(quote hs-on)
target
event-name
handler))))))))))
((= (first items) :from)
(scan-on
(rest (rest items))
@@ -267,14 +252,14 @@
(if
(and (> (len ast) 4) (= (nth ast 4) :index))
(list
(quote for-each)
(quote map-indexed)
(list
(quote fn)
(list (make-symbol var-name) (make-symbol (nth ast 5)))
(list (make-symbol (nth ast 5)) (make-symbol var-name))
body)
collection)
(list
(quote for-each)
(quote hs-for-each)
(list (quote fn) (list (make-symbol var-name)) body)
collection)))))
(define
@@ -364,10 +349,7 @@
(true
(let
((t (hs-to-sx expr)))
(list
(quote set!)
t
(list (quote +) (list (quote or) t 0) amount)))))))
(list (quote set!) t (list (quote +) t amount)))))))
(define
emit-dec
(fn
@@ -416,10 +398,7 @@
(true
(let
((t (hs-to-sx expr)))
(list
(quote set!)
t
(list (quote -) (list (quote or) t 0) amount)))))))
(list (quote set!) t (list (quote -) t amount)))))))
(define
emit-behavior
(fn
@@ -856,6 +835,22 @@
(quote dom-add-class)
(hs-to-sx raw-tgt)
(nth ast 1)))))
((= head (quote set-style))
(list
(quote dom-set-style)
(hs-to-sx (nth ast 3))
(nth ast 1)
(nth ast 2)))
((= head (quote set-styles))
(let
((pairs (nth ast 1)) (tgt (hs-to-sx (nth ast 2))))
(cons
(quote do)
(map
(fn
(p)
(list (quote dom-set-style) tgt (first p) (nth p 1)))
pairs))))
((= head (quote multi-add-class))
(let
((target (hs-to-sx (nth ast 1)))
@@ -1002,6 +997,14 @@
(nth ast 1)
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 3))))
((= head (quote toggle-style-cycle))
(list
(quote hs-toggle-style-cycle!)
(hs-to-sx (nth ast 2))
(nth ast 1)
(cons
(quote list)
(map hs-to-sx (slice ast 3 (len ast))))))
((= head (quote toggle-attr))
(list
(quote hs-toggle-attr!)
@@ -1097,6 +1100,16 @@
to-val
(if dur (hs-to-sx dur) nil))))
((= head (quote repeat)) (emit-repeat ast))
((= head (quote repeat-until))
(list
(quote hs-repeat-until)
(list (quote fn) (list) (hs-to-sx (nth ast 1)))
(list (quote fn) (list) (hs-to-sx (nth ast 2)))))
((= head (quote repeat-while))
(list
(quote hs-repeat-while)
(list (quote fn) (list) (hs-to-sx (nth ast 1)))
(list (quote fn) (list) (hs-to-sx (nth ast 2)))))
((= head (quote fetch))
(list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2)))
((= head (quote fetch-gql))
@@ -1106,8 +1119,13 @@
(if (nth ast 2) (hs-to-sx (nth ast 2)) nil)))
((= head (quote call))
(let
((fn-expr (hs-to-sx (nth ast 1)))
(args (map hs-to-sx (nth ast 2))))
((raw-fn (nth ast 1))
(fn-expr
(if
(string? raw-fn)
(make-symbol raw-fn)
(hs-to-sx raw-fn)))
(args (map hs-to-sx (rest (rest ast)))))
(cons fn-expr args)))
((= head (quote return))
(let
@@ -1125,10 +1143,13 @@
((= head (quote go))
(list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
((= head (quote append!))
(list
(quote dom-append)
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 1))))
(let
((tgt (hs-to-sx (nth ast 2)))
(val (hs-to-sx (nth ast 1))))
(if
(symbol? tgt)
(list (quote set!) tgt (list (quote hs-append) tgt val))
(list (quote hs-append!) val tgt))))
((= head (quote tell))
(let
((tgt (hs-to-sx (nth ast 1))))
@@ -1182,6 +1203,10 @@
(nth ast 1)
(nth ast 2)
(if (> (len ast) 3) (nth ast 3) nil)))
((= head (quote break)) (list (quote raise) "hs-break"))
((= head (quote continue))
(list (quote raise) "hs-continue"))
((= head (quote exit)) nil)
((= head (quote on)) (emit-on ast))
((= head (quote init))
(list

File diff suppressed because one or more lines are too long

View File

@@ -10,20 +10,46 @@
;; Returns a function (fn (me) ...) that can be called with a DOM element.
;; Uses eval-expr-cek to turn the SX data structure into a live closure.
(define
hs-handler
(fn
(src)
(let
((sx (hs-to-sx-from-source src)))
(eval-expr-cek
(list
(quote fn)
(list (quote me))
(list
(quote let)
(list (list (quote it) nil) (list (quote event) nil))
sx))))))
(begin
(define
hs-collect-vars
(fn
(sx)
(define vars (list))
(define
walk
(fn
(node)
(when
(list? node)
(when
(and
(> (len node) 1)
(= (first node) (quote set!))
(symbol? (nth node 1)))
(let
((name (nth node 1)))
(when
(not (some (fn (v) (= v name)) vars))
(set! vars (cons name vars)))))
(for-each walk node))))
(walk sx)
vars))
(define
hs-handler
(fn
(src)
(let
((sx (hs-to-sx-from-source src)))
(let
((extra-vars (hs-collect-vars sx)))
(let
((bindings (append (list (list (quote it) nil) (list (quote event) nil)) (map (fn (v) (list v nil)) extra-vars))))
(eval-expr-cek
(list
(quote fn)
(list (quote me))
(list (quote let) bindings sx)))))))))
;; ── Activate a single element ───────────────────────────────────
;; Reads the _="..." attribute, compiles, and executes with me=element.

View File

@@ -1,3 +1,3 @@
(sxbc 1 "99bd2816b1cd7891"
(sxbc 1 "886d830f7097651c"
(code
:constants ("hs-handler" {:upvalue-count 0 :arity 1 :constants ("hs-to-sx-from-source" "eval-expr-cek" "list" fn me let it event) :bytecode (20 0 0 16 0 48 1 17 1 20 1 0 1 3 0 1 4 0 52 2 0 1 1 5 0 1 6 0 2 52 2 0 2 1 7 0 2 52 2 0 2 52 2 0 2 16 1 52 2 0 3 52 2 0 3 49 1 50)} "hs-activate!" {:upvalue-count 0 :arity 1 :constants ("dom-get-attr" "_" "not" "dom-get-data" "hs-active" "dom-set-data" "hs-handler") :bytecode (20 0 0 16 0 1 1 0 48 2 17 1 16 1 6 33 15 0 5 20 3 0 16 0 1 4 0 48 2 52 2 0 1 33 30 0 20 5 0 16 0 1 4 0 3 48 3 5 20 6 0 16 1 48 1 17 2 16 2 16 0 49 1 32 1 0 2 50)} "hs-boot!" {:upvalue-count 0 :arity 0 :constants ("dom-query-all" "host-get" "host-global" "document" "body" "[_]" "for-each" {:upvalue-count 0 :arity 1 :constants ("hs-activate!") :bytecode (20 0 0 16 0 49 1 50)}) :bytecode (20 0 0 1 3 0 52 2 0 1 1 4 0 52 1 0 2 1 5 0 48 2 17 0 51 7 0 16 0 52 6 0 2 50)} "hs-boot-subtree!" {:upvalue-count 0 :arity 1 :constants ("dom-query-all" "[_]" "for-each" {:upvalue-count 0 :arity 1 :constants ("hs-activate!") :bytecode (20 0 0 16 0 49 1 50)} "dom-get-attr" "_" "hs-activate!") :bytecode (20 0 0 16 0 1 1 0 48 2 17 1 51 3 0 16 1 52 2 0 2 5 20 4 0 16 0 1 5 0 48 2 33 10 0 20 6 0 16 0 49 1 32 1 0 2 50)}) :bytecode (51 1 0 128 0 0 5 51 3 0 128 2 0 5 51 5 0 128 4 0 5 51 7 0 128 6 0 50)))
:constants ("hs-collect-vars" {:upvalue-count 0 :arity 3 :constants ("list" {:upvalue-count 2 :arity 1 :constants ("list?" ">" "len" 1 "=" "first" set! "symbol?" "nth" "not" "some" {:upvalue-count 1 :arity 1 :constants ("=") :bytecode (16 0 18 0 52 0 0 2 50)} "cons" "for-each") :bytecode (16 0 52 0 0 1 33 111 0 16 0 52 2 0 1 1 3 0 52 1 0 2 6 33 32 0 5 16 0 52 5 0 1 1 6 0 52 4 0 2 6 33 14 0 5 16 0 1 3 0 52 8 0 2 52 7 0 1 33 46 0 16 0 1 3 0 52 8 0 2 17 1 51 11 0 1 1 18 0 52 10 0 2 52 9 0 1 33 13 0 16 1 18 0 52 12 0 2 19 0 32 1 0 2 32 1 0 2 5 18 1 16 0 52 13 0 2 32 1 0 2 50)}) :bytecode (52 0 0 0 17 1 5 51 1 0 1 1 1 2 17 2 5 16 2 16 0 48 1 5 16 1 50)} "hs-handler" {:upvalue-count 0 :arity 1 :constants ("hs-to-sx-from-source" "hs-collect-vars" "append" "list" it event "map" {:upvalue-count 0 :arity 1 :constants ("list") :bytecode (16 0 2 52 0 0 2 50)} "eval-expr-cek" fn me let) :bytecode (20 0 0 16 0 48 1 17 1 20 1 0 16 1 48 1 17 2 1 4 0 2 52 3 0 2 1 5 0 2 52 3 0 2 52 3 0 2 51 7 0 16 2 52 6 0 2 52 2 0 2 17 3 20 8 0 1 9 0 1 10 0 52 3 0 1 1 11 0 16 3 16 1 52 3 0 3 52 3 0 3 49 1 50)} "hs-activate!" {:upvalue-count 0 :arity 1 :constants ("dom-get-attr" "_" "not" "dom-get-data" "hs-active" "dom-set-data" "hs-handler") :bytecode (20 0 0 16 0 1 1 0 48 2 17 1 16 1 6 33 15 0 5 20 3 0 16 0 1 4 0 48 2 52 2 0 1 33 30 0 20 5 0 16 0 1 4 0 3 48 3 5 20 6 0 16 1 48 1 17 2 16 2 16 0 49 1 32 1 0 2 50)} "hs-boot!" {:upvalue-count 0 :arity 0 :constants ("dom-query-all" "host-get" "host-global" "document" "body" "[_]" "for-each" {:upvalue-count 0 :arity 1 :constants ("hs-activate!") :bytecode (20 0 0 16 0 49 1 50)}) :bytecode (20 0 0 1 3 0 52 2 0 1 1 4 0 52 1 0 2 1 5 0 48 2 17 0 51 7 0 16 0 52 6 0 2 50)} "hs-boot-subtree!" {:upvalue-count 0 :arity 1 :constants ("dom-query-all" "[_]" "for-each" {:upvalue-count 0 :arity 1 :constants ("hs-activate!") :bytecode (20 0 0 16 0 49 1 50)} "dom-get-attr" "_" "hs-activate!") :bytecode (20 0 0 16 0 1 1 0 48 2 17 1 51 3 0 16 1 52 2 0 2 5 20 4 0 16 0 1 5 0 48 2 33 10 0 20 6 0 16 0 49 1 32 1 0 2 50)}) :bytecode (51 1 0 128 0 0 5 51 3 0 128 2 0 5 51 5 0 128 4 0 5 51 7 0 128 6 0 5 51 9 0 128 8 0 50)))

View File

@@ -158,7 +158,7 @@
(do
(adv!)
(list (make-symbol ".") (list (quote event)) "detail")))
((and (= typ "keyword") (= val "my"))
((and (= typ "keyword") (or (= val "my") (= val "your")))
(do (adv!) (parse-poss-tail (list (quote me)))))
((and (= typ "keyword") (= val "its"))
(do (adv!) (parse-poss-tail (list (quote it)))))
@@ -775,50 +775,88 @@
parse-add-cmd
(fn
()
(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"))))
(collect-classes!))))
(collect-classes!)
(cond
((= (tp-type) "class")
(let
((tgt (parse-tgt-kw "to" (list (quote me)))))
((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
((when-clause (if (match-kw "when") (parse-expr) nil)))
(if
(empty? extra-classes)
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
(let
((when-clause (if (match-kw "when") (parse-expr) nil)))
(if
when-clause
(list (quote add-class-when) cls tgt when-clause)
(list (quote add-class) cls tgt))
(if
when-clause
(list
(quote multi-add-class-when)
tgt
(empty? extra-classes)
(if
when-clause
cls
extra-classes)
(cons
(quote multi-add-class)
(cons tgt (cons cls extra-classes))))))))
(let
((value (parse-expr)))
(if
(match-kw "to")
(list (quote add-class-when) cls tgt when-clause)
(list (quote add-class) cls tgt))
(if
when-clause
(list
(quote multi-add-class-when)
tgt
when-clause
cls
extra-classes)
(cons
(quote multi-add-class)
(cons tgt (cons cls extra-classes)))))))))
((= (tp-type) "style")
(let
((prop (get (adv!) "value"))
(value
(if
(= (tp-type) "local")
(get (adv!) "value")
(parse-expr))))
(let
((tgt (parse-expr)))
(list (quote add-value) value tgt))
nil)))))
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
(list (quote set-style) prop value tgt))))
((= (tp-type) "brace-open")
(do
(adv!)
(let
((pairs (list)))
(define
collect-pairs!
(fn
()
(when
(and
(not (= (tp-type) "brace-close"))
(not (at-end?)))
(let
((prop (get (adv!) "value")))
(when (= (tp-type) "colon") (adv!))
(let
((val (tp-val)))
(adv!)
(set! pairs (cons (list prop val) pairs))
(collect-pairs!))))))
(collect-pairs!)
(when (= (tp-type) "brace-close") (adv!))
(let
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
(list (quote set-styles) (reverse pairs) tgt)))))
(true
(let
((value (parse-expr)))
(if
(match-kw "to")
(let
((tgt (parse-expr)))
(list (quote add-value) value tgt))
nil))))))
(define
parse-remove-cmd
(fn
@@ -923,40 +961,64 @@
(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")
((prop (get (adv!) "value")))
(let
((tgt (if (match-kw "of") (parse-expr) (list (quote me)))))
(if
(match-kw "between")
(let
((val2 (parse-atom)))
((val1 (parse-atom)))
(expect-kw! "and")
(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)))))
((val2 (parse-atom)))
(if
(match-kw "and")
(let
((val3 (parse-atom)))
(if
(match-kw "and")
(let
((val4 (parse-atom)))
(list
(quote toggle-style-cycle)
prop
tgt
val1
val2
val3
val4))
(list
(quote toggle-style-cycle)
prop
tgt
val1
val2
val3)))
(list
(quote toggle-style-between)
prop
val1
val2
tgt))))
(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")
((attr-name (get (adv!) "value")))
(let
((tgt (if (match-kw "on") (parse-expr) (list (quote me)))))
(if
(match-kw "between")
(let
((val2 (parse-atom)))
((val1 (parse-expr)))
(expect-kw! "and")
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((val2 (parse-expr)))
(list
(quote toggle-attr-between)
attr-name
val1
val2
tgt))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
tgt)))
(list (quote toggle-attr) attr-name tgt)))))
((and (= (tp-type) "keyword") (= (tp-val) "my"))
(do
@@ -1050,17 +1112,19 @@
((match-kw "after")
(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)))))
(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
@@ -1221,26 +1285,35 @@
(fn
()
(let
((prop (cond ((= (tp-type) "style") (get (adv!) "value")) ((= (tp-val) "my") (do (adv!) (if (= (tp-type) "style") (get (adv!) "value") (get (adv!) "value")))) (true (get (adv!) "value")))))
((prop (cond ((= (tp-type) "style") (get (adv!) "value")) ((= (tp-val) "my") (do (adv!) (if (= (tp-type) "style") (get (adv!) "value") (get (adv!) "value")))) ((= (tp-val) "'s") (do (adv!) (if (= (tp-type) "style") (get (adv!) "value") (get (adv!) "value")))) (true (get (adv!) "value")))))
(let
((from-val (if (match-kw "from") (let ((v (parse-atom))) (if (and (number? v) (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil)))
(expect-kw! "to")
((inner-tgt (if (match-kw "of") (parse-expr) nil)))
(let
((value (let ((v (parse-atom))) (if (and (number? v) (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v))))
((eff-tgt (if inner-tgt inner-tgt tgt)))
(let
((dur (if (match-kw "over") (let ((v (parse-atom))) (if (and (number? v) (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil)))
((from-val (if (match-kw "from") (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil)))
(expect-kw! "to")
(let
((using-val (if (match-kw "using") (parse-expr) nil)))
(if
from-val
(list
(quote transition-from)
prop
from-val
value
dur
tgt)
(list (quote transition) prop value dur tgt)))))))))
((value (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v))))
(let
((dur (if (match-kw "over") (let ((v (parse-atom))) (if (and (number? v) (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil)))
(let
((using-val (if (match-kw "using") (parse-expr) nil)))
(if
from-val
(list
(quote transition-from)
prop
from-val
value
dur
eff-tgt)
(list
(quote transition)
prop
value
dur
eff-tgt)))))))))))
(let
((first-t (parse-one-transition)))
(define
@@ -1278,9 +1351,20 @@
(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)))))))
((body (do (match-kw "then") (parse-cmd-list))))
(cond
((match-kw "until")
(let
((cond-expr (parse-expr)))
(match-kw "end")
(list (quote repeat-until) cond-expr body)))
((match-kw "while")
(let
((cond-expr (parse-expr)))
(match-kw "end")
(list (quote repeat-while) cond-expr body)))
(true
(do (match-kw "end") (list (quote repeat) mode body))))))))))
(define
parse-fetch-cmd
(fn
@@ -1521,9 +1605,9 @@
(let
((collection (parse-expr)))
(let
((idx (if (match-kw "index") (let ((iname (tp-val))) (adv!) iname) nil)))
((idx (cond ((match-kw "index") (let ((iname (tp-val))) (adv!) iname)) ((match-kw "indexed") (do (match-kw "by") (let ((iname (tp-val))) (adv!) iname))) (true nil))))
(let
((body (parse-cmd-list)))
((body (do (match-kw "then") (parse-cmd-list))))
(match-kw "end")
(if
idx
@@ -1599,8 +1683,8 @@
(fn
()
(let
((the-event (and (match-kw "the") (or (match-kw "event") (match-kw "default")))))
(list (quote halt!) (if the-event "event" "default")))))
((mode (cond ((match-kw "the") (do (match-kw "event") (match-kw "'s") "event")) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "event"))))
(list (quote halt!) mode))))
(define
parse-param-list
(fn () (if (= (tp-type) "paren-open") (parse-call-args) (list))))
@@ -1838,6 +1922,12 @@
(do (adv!) (parse-open-cmd)))
((and (= typ "keyword") (= val "close"))
(do (adv!) (parse-close-cmd)))
((and (= typ "keyword") (= val "break"))
(do (adv!) (list (quote break))))
((and (= typ "keyword") (= val "continue"))
(do (adv!) (list (quote continue))))
((and (= typ "keyword") (or (= val "exit") (= val "halt")))
(do (adv!) (list (quote exit))))
(true (parse-expr))))))
(define
parse-cmd-list

File diff suppressed because one or more lines are too long

View File

@@ -99,6 +99,39 @@
;; ── Navigation / traversal ──────────────────────────────────────
;; Navigate to a URL.
(define
hs-toggle-style-between!
(fn
(target prop val1 val2)
(let
((cur (dom-get-style target prop)))
(if
(= cur val1)
(dom-set-style target prop val2)
(dom-set-style target prop val1)))))
;; Find next sibling matching a selector (or any sibling).
(define
hs-toggle-style-cycle!
(fn
(target prop vals)
(let
((cur (dom-get-style target prop)))
(define
find-next
(fn
(remaining)
(cond
((empty? remaining) (first vals))
((= cur (first remaining))
(if
(empty? (rest remaining))
(first vals)
(first (rest remaining))))
(true (find-next (rest remaining))))))
(dom-set-style target prop (find-next vals)))))
;; Find previous sibling matching a selector.
(define
hs-take!
(fn
@@ -122,20 +155,29 @@
(dom-set-attr target name attr-val)
(dom-set-attr target name ""))))))))
;; Find next sibling matching a selector (or any sibling).
;; First element matching selector within a scope.
(define
hs-put!
(fn
(value pos target)
(cond
((= pos "into") (dom-set-inner-html target value))
((= pos "into")
(if (list? target) target (dom-set-inner-html target value)))
((= pos "before")
(dom-insert-adjacent-html target "beforebegin" value))
((= pos "after") (dom-insert-adjacent-html target "afterend" value))
((= pos "start") (dom-insert-adjacent-html target "afterbegin" value))
((= pos "end") (dom-insert-adjacent-html target "beforeend" value)))))
((= pos "start")
(if
(list? target)
(append! target value 0)
(dom-insert-adjacent-html target "afterbegin" value)))
((= pos "end")
(if
(list? target)
(append! target value)
(dom-insert-adjacent-html target "beforeend" value))))))
;; Find previous sibling matching a selector.
;; Last element matching selector.
(define
hs-add-to!
(fn
@@ -145,7 +187,7 @@
(append target (list value))
(host-call target "push" value))))
;; First element matching selector within a scope.
;; First/last within a specific scope.
(define
hs-remove-from!
(fn
@@ -155,16 +197,18 @@
(filter (fn (x) (not (= x value))) target)
(host-call target "splice" (host-call target "indexOf" value) 1))))
;; Last element matching selector.
(define
hs-set-on!
(fn
(props target)
(for-each (fn (k) (host-set! target k (get props k))) (keys props))))
;; First/last within a specific scope.
;; ── Iteration ───────────────────────────────────────────────────
;; Repeat a thunk N times.
(define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
;; Repeat forever (until break — relies on exception/continuation).
(define
hs-scroll!
(fn
@@ -177,31 +221,41 @@
((= position "bottom") (dict :block "end"))
(true (dict :block "start")))))))
;; ── Iteration ───────────────────────────────────────────────────
;; ── Fetch ───────────────────────────────────────────────────────
;; Repeat a thunk N times.
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(define
hs-halt!
(fn
(mode)
(when
event
(host-call event "preventDefault" (list))
(when (= mode "event") (host-call event "stopPropagation" (list))))))
;; Repeat forever (until break — relies on exception/continuation).
(define hs-select! (fn (target) (host-call target "select" (list))))
;; ── Fetch ───────────────────────────────────────────────────────
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(define hs-reset! (fn (target) (host-call target "reset" (list))))
(cond
((= mode "default") (host-call event "preventDefault"))
((= mode "bubbling") (host-call event "stopPropagation"))
(true
(do
(host-call event "preventDefault")
(host-call event "stopPropagation")))))))
;; ── Type coercion ───────────────────────────────────────────────
;; Coerce a value to a type by name.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define hs-select! (fn (target) (host-call target "select" (list))))
;; ── Object creation ─────────────────────────────────────────────
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
(define hs-reset! (fn (target) (host-call target "reset" (list))))
;; ── 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-next
(fn
@@ -221,10 +275,10 @@
(true (find-next (dom-next-sibling el))))))
(find-next sibling)))))
;; ── Object creation ─────────────────────────────────────────────
;; ── Measurement ─────────────────────────────────────────────────
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
;; Measure an element's bounding rect, store as local variables.
;; Returns a dict with x, y, width, height, top, left, right, bottom.
(define
hs-previous
(fn
@@ -244,27 +298,18 @@
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
(find-prev sibling)))))
;; ── 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-query-all
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
;; ── 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-query-first
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define
hs-query-all
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
(define
hs-query-first
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
(define
hs-query-last
(fn
@@ -289,21 +334,95 @@
(n thunk)
(define
do-repeat
(fn (i) (when (< i n) (do (thunk) (do-repeat (+ i 1))))))
(fn
(i)
(when
(< i n)
(let
((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil))))
(cond
((= signal "hs-break") nil)
((= signal "hs-continue") (do-repeat (+ i 1)))
(true (do-repeat (+ i 1))))))))
(do-repeat 0)))
(define
hs-repeat-forever
(fn
(thunk)
(define do-forever (fn () (thunk) (do-forever)))
(define
do-forever
(fn
()
(let
((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil))))
(cond
((= signal "hs-break") nil)
((= signal "hs-continue") (do-forever))
(true (do-forever))))))
(do-forever)))
(define
hs-repeat-while
(fn
(cond-fn thunk)
(when (cond-fn) (thunk) (hs-repeat-while cond-fn thunk))))
(when
(cond-fn)
(let
((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil))))
(cond
((= signal "hs-break") nil)
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
(true (hs-repeat-while cond-fn thunk)))))))
(define
hs-repeat-until
(fn
(cond-fn thunk)
(let
((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil))))
(cond
((= signal "hs-break") nil)
((= signal "hs-continue")
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
(define
hs-for-each
(fn
(fn-body collection)
(let
((items (cond ((list? collection) collection) ((dict? collection) (keys collection)) ((nil? collection) (list)) (true (list)))))
(define
do-loop
(fn
(remaining)
(when
(not (empty? remaining))
(let
((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (fn-body (first remaining)) nil))))
(cond
((= signal "hs-break") nil)
((= signal "hs-continue") (do-loop (rest remaining)))
(true (do-loop (rest remaining))))))))
(do-loop items))))
(begin
(define
hs-append
(fn
(target value)
(cond
((string? target) (str target value))
((list? target) (append target (list value)))
(true (str target value)))))
(define
hs-append!
(fn (value target) (dom-insert-adjacent-html target "beforeend" value))))
(define
hs-fetch
@@ -399,7 +518,8 @@
(map (fn (k) (list k (get value k))) (keys value))
value))
(true value))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define
hs-add
(fn
@@ -409,7 +529,7 @@
((list? b) (cons a b))
((or (string? a) (string? b)) (str a b))
(true (+ a b)))))
;; DOM query stub — sandbox returns empty list
(define
hs-make
(fn
@@ -420,17 +540,15 @@
((= type-name "Set") (list))
((= type-name "Map") (dict))
(true (dict)))))
;; Method dispatch — obj.method(args)
(define hs-install (fn (behavior-fn) (behavior-fn me)))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define
hs-measure
(fn (target) (perform (list (quote io-measure) target))))
;; Property-based is — check obj.key truthiness
(define
hs-transition
(fn
@@ -443,8 +561,7 @@
(str prop " " (/ duration 1000) "s")))
(dom-set-style target prop value)
(when duration (hs-settle target))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
;; Array slicing (inclusive both ends)
(define
hs-transition-from
(fn
@@ -458,7 +575,7 @@
(str prop " " (/ duration 1000) "s")))
(dom-set-style target prop (str to-val))
(when duration (hs-settle target))))
;; DOM query stub — sandbox returns empty list
;; Collection: sorted by
(define
hs-type-check
(fn
@@ -478,33 +595,31 @@
(= (host-typeof value) "element")
(= (host-typeof value) "text")))
(true (= (host-typeof value) (downcase type-name)))))))
;; Method dispatch — obj.method(args)
;; Collection: sorted by descending
(define
hs-type-check-strict
(fn
(value type-name)
(if (nil? value) false (hs-type-check value type-name))))
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
;; Collection: split by
(define
hs-strict-eq
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
;; Property-based is — check obj.key truthiness
;; Collection: joined by
(define
hs-eq-ignore-case
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
;; Array slicing (inclusive both ends)
(define
hs-starts-with-ic?
(fn (str prefix) (starts-with? (downcase str) (downcase prefix))))
;; Collection: sorted by
(define
hs-contains-ignore-case?
(fn
(haystack needle)
(contains? (downcase (str haystack)) (downcase (str needle)))))
;; Collection: sorted by descending
(define
hs-falsy?
(fn
@@ -516,7 +631,7 @@
((and (list? v) (= (len v) 0)) true)
((= v 0) true)
(true false))))
;; Collection: split by
(define
hs-matches?
(fn
@@ -527,7 +642,7 @@
((= (host-typeof target) "element")
(if (string? pattern) (host-call target "matches" pattern) false))
(true false))))
;; Collection: joined by
(define
hs-contains?
(fn

File diff suppressed because one or more lines are too long

View File

@@ -104,6 +104,7 @@
"detail"
"sender"
"index"
"indexed"
"increment"
"decrement"
"append"

File diff suppressed because one or more lines are too long

View File

@@ -990,8 +990,13 @@
"hs-toggle-class!",
"hs-toggle-between!",
"hs-toggle-style!",
"hs-toggle-style-between!",
"hs-toggle-style-cycle!",
"hs-take!",
"hs-put!",
"hs-add-to!",
"hs-remove-from!",
"hs-set-on!",
"hs-navigate!",
"hs-scroll!",
"hs-halt!",
@@ -1007,6 +1012,8 @@
"hs-repeat-times",
"hs-repeat-forever",
"hs-repeat-while",
"hs-repeat-until",
"hs-for-each",
"hs-fetch",
"hs-coerce",
"hs-add",
@@ -1056,7 +1063,6 @@
"hs-runtime"
],
"exports": [
"hs-handler",
"hs-activate!",
"hs-boot!",
"hs-boot-subtree!"