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,34 +110,15 @@
(let (let
((target (if source (hs-to-sx source) (quote me)))) ((target (if source (hs-to-sx source) (quote me))))
(let (let
((compiled-body (hs-to-sx body)) ((event-refs (if (and (list? body) (= (first body) (quote do))) (filter (fn (x) (and (list? x) (= (first x) (quote ref)))) (rest body)) (list))))
(wrapped-body
(if
catch-info
(let (let
((var (make-symbol (first catch-info))) ((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)))
(catch-body (let
(hs-to-sx (nth catch-info 1)))) ((raw-compiled (hs-to-sx stripped-body)))
(if (let
finally-info ((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)))
(list (let
(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)))
(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 (handler
(list (list
(quote fn) (quote fn)
@@ -150,7 +131,11 @@
target target
event-name event-name
handler) handler)
(list (quote hs-on) target event-name handler)))))) (list
(quote hs-on)
target
event-name
handler))))))))))
((= (first items) :from) ((= (first items) :from)
(scan-on (scan-on
(rest (rest items)) (rest (rest items))
@@ -267,14 +252,14 @@
(if (if
(and (> (len ast) 4) (= (nth ast 4) :index)) (and (> (len ast) 4) (= (nth ast 4) :index))
(list (list
(quote for-each) (quote map-indexed)
(list (list
(quote fn) (quote fn)
(list (make-symbol var-name) (make-symbol (nth ast 5))) (list (make-symbol (nth ast 5)) (make-symbol var-name))
body) body)
collection) collection)
(list (list
(quote for-each) (quote hs-for-each)
(list (quote fn) (list (make-symbol var-name)) body) (list (quote fn) (list (make-symbol var-name)) body)
collection))))) collection)))))
(define (define
@@ -364,10 +349,7 @@
(true (true
(let (let
((t (hs-to-sx expr))) ((t (hs-to-sx expr)))
(list (list (quote set!) t (list (quote +) t amount)))))))
(quote set!)
t
(list (quote +) (list (quote or) t 0) amount)))))))
(define (define
emit-dec emit-dec
(fn (fn
@@ -416,10 +398,7 @@
(true (true
(let (let
((t (hs-to-sx expr))) ((t (hs-to-sx expr)))
(list (list (quote set!) t (list (quote -) t amount)))))))
(quote set!)
t
(list (quote -) (list (quote or) t 0) amount)))))))
(define (define
emit-behavior emit-behavior
(fn (fn
@@ -856,6 +835,22 @@
(quote dom-add-class) (quote dom-add-class)
(hs-to-sx raw-tgt) (hs-to-sx raw-tgt)
(nth ast 1))))) (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)) ((= head (quote multi-add-class))
(let (let
((target (hs-to-sx (nth ast 1))) ((target (hs-to-sx (nth ast 1)))
@@ -1002,6 +997,14 @@
(nth ast 1) (nth ast 1)
(hs-to-sx (nth ast 2)) (hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 3)))) (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)) ((= head (quote toggle-attr))
(list (list
(quote hs-toggle-attr!) (quote hs-toggle-attr!)
@@ -1097,6 +1100,16 @@
to-val to-val
(if dur (hs-to-sx dur) nil)))) (if dur (hs-to-sx dur) nil))))
((= head (quote repeat)) (emit-repeat ast)) ((= 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)) ((= head (quote fetch))
(list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2))) (list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2)))
((= head (quote fetch-gql)) ((= head (quote fetch-gql))
@@ -1106,8 +1119,13 @@
(if (nth ast 2) (hs-to-sx (nth ast 2)) nil))) (if (nth ast 2) (hs-to-sx (nth ast 2)) nil)))
((= head (quote call)) ((= head (quote call))
(let (let
((fn-expr (hs-to-sx (nth ast 1))) ((raw-fn (nth ast 1))
(args (map hs-to-sx (nth ast 2)))) (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))) (cons fn-expr args)))
((= head (quote return)) ((= head (quote return))
(let (let
@@ -1125,10 +1143,13 @@
((= head (quote go)) ((= head (quote go))
(list (quote hs-navigate!) (hs-to-sx (nth ast 1)))) (list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
((= head (quote append!)) ((= head (quote append!))
(list (let
(quote dom-append) ((tgt (hs-to-sx (nth ast 2)))
(hs-to-sx (nth ast 2)) (val (hs-to-sx (nth ast 1))))
(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)) ((= head (quote tell))
(let (let
((tgt (hs-to-sx (nth ast 1)))) ((tgt (hs-to-sx (nth ast 1))))
@@ -1182,6 +1203,10 @@
(nth ast 1) (nth ast 1)
(nth ast 2) (nth ast 2)
(if (> (len ast) 3) (nth ast 3) nil))) (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 on)) (emit-on ast))
((= head (quote init)) ((= head (quote init))
(list (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. ;; 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. ;; Uses eval-expr-cek to turn the SX data structure into a live closure.
(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 (define
hs-handler hs-handler
(fn (fn
(src) (src)
(let (let
((sx (hs-to-sx-from-source src))) ((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 (eval-expr-cek
(list (list
(quote fn) (quote fn)
(list (quote me)) (list (quote me))
(list (list (quote let) bindings sx)))))))))
(quote let)
(list (list (quote it) nil) (list (quote event) nil))
sx))))))
;; ── Activate a single element ─────────────────────────────────── ;; ── Activate a single element ───────────────────────────────────
;; Reads the _="..." attribute, compiles, and executes with me=element. ;; Reads the _="..." attribute, compiles, and executes with me=element.

View File

@@ -1,3 +1,3 @@
(sxbc 1 "99bd2816b1cd7891" (sxbc 1 "886d830f7097651c"
(code (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 (do
(adv!) (adv!)
(list (make-symbol ".") (list (quote event)) "detail"))) (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))))) (do (adv!) (parse-poss-tail (list (quote me)))))
((and (= typ "keyword") (= val "its")) ((and (= typ "keyword") (= val "its"))
(do (adv!) (parse-poss-tail (list (quote it))))) (do (adv!) (parse-poss-tail (list (quote it)))))
@@ -775,8 +775,8 @@
parse-add-cmd parse-add-cmd
(fn (fn
() ()
(if (cond
(= (tp-type) "class") ((= (tp-type) "class")
(let (let
((cls (get (adv!) "value")) (extra-classes (list))) ((cls (get (adv!) "value")) (extra-classes (list)))
(define (define
@@ -791,7 +791,7 @@
(collect-classes!)))) (collect-classes!))))
(collect-classes!) (collect-classes!)
(let (let
((tgt (parse-tgt-kw "to" (list (quote me))))) ((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
(let (let
((when-clause (if (match-kw "when") (parse-expr) nil))) ((when-clause (if (match-kw "when") (parse-expr) nil)))
(if (if
@@ -810,7 +810,45 @@
extra-classes) extra-classes)
(cons (cons
(quote multi-add-class) (quote multi-add-class)
(cons tgt (cons cls extra-classes)))))))) (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 (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 (let
((value (parse-expr))) ((value (parse-expr)))
(if (if
@@ -818,7 +856,7 @@
(let (let
((tgt (parse-expr))) ((tgt (parse-expr)))
(list (quote add-value) value tgt)) (list (quote add-value) value tgt))
nil))))) nil))))))
(define (define
parse-remove-cmd parse-remove-cmd
(fn (fn
@@ -923,7 +961,9 @@
(list (quote toggle-class) cls tgt))))) (list (quote toggle-class) cls tgt)))))
((= (tp-type) "style") ((= (tp-type) "style")
(let (let
((prop (do (let ((v (tp-val))) (adv!) v)))) ((prop (get (adv!) "value")))
(let
((tgt (if (match-kw "of") (parse-expr) (list (quote me)))))
(if (if
(match-kw "between") (match-kw "between")
(let (let
@@ -931,32 +971,54 @@
(expect-kw! "and") (expect-kw! "and")
(let (let
((val2 (parse-atom))) ((val2 (parse-atom)))
(if
(match-kw "and")
(let (let
((tgt (parse-tgt-kw "on" (list (quote me))))) ((val3 (parse-atom)))
(list (quote toggle-style-between) prop val1 val2 tgt)))) (if
(match-kw "and")
(let (let
((tgt (parse-tgt-kw "on" (list (quote me))))) ((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))))) (list (quote toggle-style) prop tgt)))))
((= (tp-type) "attr") ((= (tp-type) "attr")
(let (let
((attr-name (do (let ((v (tp-val))) (adv!) v)))) ((attr-name (get (adv!) "value")))
(let
((tgt (if (match-kw "on") (parse-expr) (list (quote me)))))
(if (if
(match-kw "between") (match-kw "between")
(let (let
((val1 (parse-atom))) ((val1 (parse-expr)))
(expect-kw! "and") (expect-kw! "and")
(let (let
((val2 (parse-atom))) ((val2 (parse-expr)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (list
(quote toggle-attr-between) (quote toggle-attr-between)
attr-name attr-name
val1 val1
val2 val2
tgt)))) tgt)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-attr) attr-name tgt))))) (list (quote toggle-attr) attr-name tgt)))))
((and (= (tp-type) "keyword") (= (tp-val) "my")) ((and (= (tp-type) "keyword") (= (tp-val) "my"))
(do (do
@@ -1050,6 +1112,8 @@
((match-kw "after") ((match-kw "after")
(list (quote put!) value "after" (parse-expr))) (list (quote put!) value "after" (parse-expr)))
((match-kw "at") ((match-kw "at")
(do
(match-kw "the")
(cond (cond
((match-kw "start") ((match-kw "start")
(do (do
@@ -1060,7 +1124,7 @@
(expect-kw! "of") (expect-kw! "of")
(list (quote put!) value "end" (parse-expr)))) (list (quote put!) value "end" (parse-expr))))
(true (true
(error (str "Expected start/end after at, position " p))))) (error (str "Expected start/end after at, position " p))))))
(true (true
(error (str "Expected into/before/after/at at position " p))))))) (error (str "Expected into/before/after/at at position " p)))))))
(define (define
@@ -1221,12 +1285,16 @@
(fn (fn
() ()
(let (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 (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))) ((inner-tgt (if (match-kw "of") (parse-expr) nil)))
(let
((eff-tgt (if inner-tgt inner-tgt tgt)))
(let
((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") (expect-kw! "to")
(let (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)))) ((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 (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))) ((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 (let
@@ -1239,8 +1307,13 @@
from-val from-val
value value
dur dur
tgt) eff-tgt)
(list (quote transition) prop value dur tgt))))))))) (list
(quote transition)
prop
value
dur
eff-tgt)))))))))))
(let (let
((first-t (parse-one-transition))) ((first-t (parse-one-transition)))
(define (define
@@ -1278,9 +1351,20 @@
(let (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)))))))) ((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 (let
((body (parse-cmd-list))) ((body (do (match-kw "then") (parse-cmd-list))))
(cond
((match-kw "until")
(let
((cond-expr (parse-expr)))
(match-kw "end") (match-kw "end")
(list (quote repeat) mode body))))))) (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 (define
parse-fetch-cmd parse-fetch-cmd
(fn (fn
@@ -1521,9 +1605,9 @@
(let (let
((collection (parse-expr))) ((collection (parse-expr)))
(let (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 (let
((body (parse-cmd-list))) ((body (do (match-kw "then") (parse-cmd-list))))
(match-kw "end") (match-kw "end")
(if (if
idx idx
@@ -1599,8 +1683,8 @@
(fn (fn
() ()
(let (let
((the-event (and (match-kw "the") (or (match-kw "event") (match-kw "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!) (if the-event "event" "default"))))) (list (quote halt!) mode))))
(define (define
parse-param-list parse-param-list
(fn () (if (= (tp-type) "paren-open") (parse-call-args) (list)))) (fn () (if (= (tp-type) "paren-open") (parse-call-args) (list))))
@@ -1838,6 +1922,12 @@
(do (adv!) (parse-open-cmd))) (do (adv!) (parse-open-cmd)))
((and (= typ "keyword") (= val "close")) ((and (= typ "keyword") (= val "close"))
(do (adv!) (parse-close-cmd))) (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)))))) (true (parse-expr))))))
(define (define
parse-cmd-list parse-cmd-list

File diff suppressed because one or more lines are too long

View File

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

File diff suppressed because one or more lines are too long

View File

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

File diff suppressed because one or more lines are too long

View File

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