12 Commits

Author SHA1 Message Date
97180b4aa3 js-on-sx: wrapper constructor-detection, Array.prototype.toString, >>> operator
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 11s
Number.__callable__ and String.__callable__ now check this.__proto__ ===
Number/String.prototype before writing wrapper slots, preventing false-positive
mutation when called as plain function. js-to-number extended to unwrap
wrapper dicts and call valueOf/toString for plain objects. Array.prototype.toString
replaced with a direct js-list-join implementation (eliminates infinite recursion
via js-invoke-method on dict-based arrays). >>> added to transpiler + runtime.

String test262 subset: 62→66/100. 529/530 unit, 147/148 slice.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 19:22:53 +00:00
ea63b6d9bb plans: log precision number-to-string iteration
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
2026-04-25 14:42:44 +00:00
5d7f931cf1 js-on-sx: high-precision number-to-string via round-trip + digit extraction
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
- js-big-int-str-loop: extract decimal digits from integer-valued float
- js-find-decimal-k: find min decimal places k where round(n*10^k)/10^k == n
- js-format-decimal-digits: insert decimal point into digit string at position (len-k)
- js-number-to-string: if 6-sig-fig round-trip fails AND n in [1e-6, 1e21),
  use digit extraction for full precision (up to 17 sig figs)
- String(1.0000001)="1.0000001", String(1/3)="0.3333333333333333"
- String test262 subset: 58→62/100

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 14:42:32 +00:00
79f3e1ada2 plans: log String wrapper + number-to-string sci notation iteration
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
2026-04-25 14:27:25 +00:00
4d00250233 js-on-sx: String wrapper objects + number-to-string sci notation expansion
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
- js-to-string: return __js_string_value__ for String wrapper dicts
- js-loose-eq: coerce String wrapper objects to primitive before compare
- String.__callable__: set __js_string_value__ + length on 'this' when called as constructor
- js-expand-sci-notation: new helper converts mantissa+exp to decimal or integer form
- js-number-to-string: expand 1e-06→0.000001, 1e+06→1000000; fix 1e+21 (was 1e21)
- String test262 subset: 45→58/100

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 14:27:13 +00:00
80c21cbabb js-on-sx: String fixes — fromCodePoint, multi-arg indexOf/split/lastIndexOf, matchAll, constructor, js-to-string dict
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
- String.fromCodePoint added (BMP + surrogate pairs)
- indexOf/lastIndexOf/split now accept optional second argument (fromIndex / limit)
- matchAll stub added to js-string-method and String.prototype
- String property else-branch now falls back to String.prototype (fixes 'a'.constructor === String)
- js-to-string for dict returns [object Object] instead of recursing into circular String.prototype.constructor structure
- js-list-take helper added for split limit

Scoreboard: String 42→43, timeouts 32→13, total 162→202/300 (54%→67.3%). 529/530 unit, 148/148 slice.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 13:41:58 +00:00
70f91ef3d8 plans: log Math methods iteration
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
2026-04-25 12:47:27 +00:00
5f38e49ba4 js-on-sx: add missing Math methods (trig, log, hyperbolic, clz32, imul, fround)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
2026-04-25 12:47:12 +00:00
0f9d361a92 plans: tick var hoisting, add progress log entry
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
2026-04-25 12:19:07 +00:00
11315d91cc js-on-sx: var hoisting — hoist var names as undefined before funcdecls
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
2026-04-25 12:18:42 +00:00
f16e1b69c0 js-on-sx: tick ASI checkbox, append progress log entry
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 11:53:45 +00:00
ae86579ae8 js-on-sx: ASI — :nl token flag + return restricted production (525/526 unit, 148/148 slice)
Lexer: adds :nl (newline-before) boolean to every token. scan! resets the flag
before each skip-ws! call; skip-ws! sets it true when it consumes \n or \r.
Parser: jp-token-nl? reads the flag; jp-parse-return-stmt stops before the
expression when a newline precedes it (return\n42 → return undefined). Four
new tests cover the restricted production and the raw flag.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 11:53:33 +00:00
25 changed files with 4082 additions and 7766 deletions

File diff suppressed because it is too large Load Diff

View File

@@ -19,7 +19,6 @@
(define (define
reserved reserved
(list (list
(quote beingTold)
(quote me) (quote me)
(quote it) (quote it)
(quote event) (quote event)
@@ -66,10 +65,7 @@
(list (quote me)) (list (quote me))
(list (list
(quote let) (quote let)
(list (list (list (quote it) nil) (list (quote event) nil))
(list (quote beingTold) (quote me))
(list (quote it) nil)
(list (quote event) nil))
guarded)))))))))) guarded))))))))))
;; ── Activate a single element ─────────────────────────────────── ;; ── Activate a single element ───────────────────────────────────
@@ -77,51 +73,23 @@
;; Marks the element to avoid double-activation. ;; Marks the element to avoid double-activation.
(define (define
hs-register-scripts! hs-activate!
(fn (fn
() (el)
(for-each (let
(fn ((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
(script) (when
(when (and src (not (= src prev)))
(not (dom-get-data script "hs-script-loaded")) (hs-log-event! "hyperscript:init")
(let (dom-set-data el "hs-script" src)
((src (host-get script "innerHTML"))) (dom-set-data el "hs-active" true)
(when (dom-set-attr el "data-hyperscript-powered" "true")
(and src (not (= src ""))) (let ((handler (hs-handler src))) (handler el))))))
(guard
(_e (true nil))
(eval-expr-cek (hs-to-sx-from-source src)))
(dom-set-data script "hs-script-loaded" true)))))
(hs-query-all "script[type=text/hyperscript]"))))
;; ── Boot: scan entire document ────────────────────────────────── ;; ── Boot: scan entire document ──────────────────────────────────
;; Called once at page load. Finds all elements with _ attribute, ;; Called once at page load. Finds all elements with _ attribute,
;; compiles their hyperscript, and activates them. ;; compiles their hyperscript, and activates them.
(define
hs-activate!
(fn
(el)
(do
(hs-register-scripts!)
(let
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
(when
(and src (not (= src prev)))
(when
(dom-dispatch el "hyperscript:before:init" nil)
(hs-log-event! "hyperscript:init")
(dom-set-data el "hs-script" src)
(dom-set-data el "hs-active" true)
(dom-set-attr el "data-hyperscript-powered" "true")
(let ((handler (hs-handler src))) (handler el))
(dom-dispatch el "hyperscript:after:init" nil)))))))
;; ── Boot subtree: for dynamic content ───────────────────────────
;; Called after HTMX swaps or dynamic DOM insertion.
;; Only activates elements within the given root.
(define (define
hs-deactivate! hs-deactivate!
(fn (fn
@@ -133,6 +101,10 @@
(dom-set-data el "hs-active" false) (dom-set-data el "hs-active" false)
(dom-set-data el "hs-script" nil)))) (dom-set-data el "hs-script" nil))))
;; ── Boot subtree: for dynamic content ───────────────────────────
;; Called after HTMX swaps or dynamic DOM insertion.
;; Only activates elements within the given root.
(define (define
hs-boot! hs-boot!
(fn (fn

View File

@@ -9,11 +9,7 @@
(fn (fn
(tokens src) (tokens src)
(let (let
((tokens (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens)) ((p 0) (tok-len (len tokens)))
(p 0)
(tok-len
(len
(filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))))
(define tp (fn () (if (< p tok-len) (nth tokens p) nil))) (define tp (fn () (if (< p tok-len) (nth tokens p) nil)))
(define (define
tp-type tp-type
@@ -25,16 +21,6 @@
adv! adv!
(fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t))) (fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t)))
(define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof")))) (define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof"))))
(define cur-start (fn () (if (< p tok-len) (get (tp) "pos") 0)))
(define cur-line (fn () (if (< p tok-len) (get (tp) "line") 1)))
(define
prev-end
(fn () (if (> p 0) (get (nth tokens (- p 1)) "end") 0)))
(define
hs-ast-wrap
(fn
(raw kind start end-pos line fields)
(if hs-span-mode {:children raw :end end-pos :kind kind :line line :src src :start start :hs-ast true :fields fields} raw)))
(define (define
match-kw match-kw
(fn (fn
@@ -83,40 +69,19 @@
parse-prop-chain parse-prop-chain
(fn (fn
(base) (base)
(let (if
((base-start (if (and (dict? base) (get base :hs-ast)) (get base :start) (cur-start))) (and (= (tp-type) "class") (not (at-end?)))
(base-line (let
(if ((prop (tp-val)))
(and (dict? base) (get base :hs-ast)) (do
(get base :line) (adv!)
(cur-line)))) (parse-prop-chain (list (make-symbol ".") base prop))))
(if (if
(and (= (tp-type) "class") (not (at-end?))) (= (tp-type) "paren-open")
(let (let
((prop (tp-val))) ((args (parse-call-args)))
(do (parse-prop-chain (list (quote method-call) base args)))
(adv!) base))))
(parse-prop-chain
(hs-ast-wrap
(list (make-symbol ".") base prop)
"member"
base-start
(prev-end)
base-line
{:root base}))))
(if
(= (tp-type) "paren-open")
(let
((args (parse-call-args)))
(parse-prop-chain
(hs-ast-wrap
(list (quote method-call) base args)
"call"
base-start
(prev-end)
base-line
{:root base})))
base)))))
(define (define
parse-trav parse-trav
(fn (fn
@@ -127,23 +92,19 @@
((and (= kind (quote closest)) (= typ "ident") (= val "parent")) ((and (= kind (quote closest)) (= typ "ident") (= val "parent"))
(do (adv!) (parse-trav (quote closest-parent)))) (do (adv!) (parse-trav (quote closest-parent))))
((= typ "selector") ((= typ "selector")
(do (adv!) (list kind val (list (quote beingTold))))) (do (adv!) (list kind val (list (quote me)))))
((= typ "class") ((= typ "class")
(do (do (adv!) (list kind (str "." val) (list (quote me)))))
(adv!)
(list kind (str "." val) (list (quote beingTold)))))
((= typ "id") ((= typ "id")
(do (do (adv!) (list kind (str "#" val) (list (quote me)))))
(adv!)
(list kind (str "#" val) (list (quote beingTold)))))
((= typ "attr") ((= typ "attr")
(do (do
(adv!) (adv!)
(list (list
(quote attr) (quote attr)
val val
(list kind (str "[" val "]") (list (quote beingTold)))))) (list kind (str "[" val "]") (list (quote me))))))
(true (list kind "*" (list (quote beingTold)))))))) (true (list kind "*" (list (quote me))))))))
(define (define
parse-pos-kw parse-pos-kw
(fn (fn
@@ -163,24 +124,8 @@
(let (let
((typ (tp-type)) (val (tp-val))) ((typ (tp-type)) (val (tp-val)))
(cond (cond
((= typ "number") ((= typ "number") (do (adv!) (parse-dur val)))
(let ((= typ "string") (do (adv!) val))
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(parse-dur val)
"number"
s
(prev-end)
l
{}))))
((= typ "string")
(let
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap val "string" s (prev-end) l {}))))
((= typ "template") (do (adv!) (list (quote template) val))) ((= typ "template") (do (adv!) (list (quote template) val)))
((and (= typ "keyword") (= val "true")) (do (adv!) true)) ((and (= typ "keyword") (= val "true")) (do (adv!) true))
((and (= typ "keyword") (= val "false")) (do (adv!) false)) ((and (= typ "keyword") (= val "false")) (do (adv!) false))
@@ -245,51 +190,26 @@
((and (= typ "keyword") (= val "last")) ((and (= typ "keyword") (= val "last"))
(do (adv!) (parse-pos-kw (quote last)))) (do (adv!) (parse-pos-kw (quote last))))
((= typ "id") ((= typ "id")
(let (do (adv!) (list (quote query) (str "#" val))))
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(list (quote query) (str "#" val))
"selector"
s
(prev-end)
l
{}))))
((= typ "selector") ((= typ "selector")
(let (do
((s (cur-start)) (l (cur-line))) (adv!)
(do (if
(adv!) (and (= (tp-type) "keyword") (= (tp-val) "in"))
(hs-ast-wrap (do
(if (adv!)
(and (= (tp-type) "keyword") (= (tp-val) "in")) (list
(do (quote query-scoped)
(adv!) val
(list (parse-cmp (parse-arith (parse-poss (parse-atom))))))
(quote query-scoped) (list (quote query) val))))
val
(parse-cmp
(parse-arith (parse-poss (parse-atom))))))
(list (quote query) val))
"selector"
s
(prev-end)
l
{}))))
((= typ "attr") ((= typ "attr")
(do (do (adv!) (list (quote attr) val (list (quote me)))))
(adv!)
(list (quote attr) val (list (quote beingTold)))))
((= typ "style") ((= typ "style")
(do (do (adv!) (list (quote style) val (list (quote me)))))
(adv!)
(list (quote style) val (list (quote beingTold)))))
((= typ "local") (do (adv!) (list (quote local) val))) ((= typ "local") (do (adv!) (list (quote local) val)))
((= typ "hat") ((= typ "hat")
(do (do (adv!) (list (quote dom-ref) val (list (quote me)))))
(adv!)
(list (quote dom-ref) val (list (quote beingTold)))))
((and (= typ "keyword") (= val "dom")) ((and (= typ "keyword") (= val "dom"))
(do (do
(adv!) (adv!)
@@ -297,31 +217,10 @@
((name (tp-val))) ((name (tp-val)))
(do (do
(adv!) (adv!)
(list (quote dom-ref) name (list (quote beingTold))))))) (list (quote dom-ref) name (list (quote me)))))))
((= typ "class") ((= typ "class")
(let (do (adv!) (list (quote query) (str "." val))))
((s (cur-start)) (l (cur-line))) ((= typ "ident") (do (adv!) (list (quote ref) val)))
(do
(adv!)
(hs-ast-wrap
(list (quote query) (str "." val))
"selector"
s
(prev-end)
l
{}))))
((= typ "ident")
(let
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(list (quote ref) val)
"ref"
s
(prev-end)
l
{}))))
((= typ "paren-open") ((= typ "paren-open")
(do (do
(adv!) (adv!)
@@ -429,8 +328,6 @@
(let (let
((name val) (args (parse-call-args))) ((name val) (args (parse-call-args)))
(cons (quote call) (cons (list (quote ref) name) args))))) (cons (quote call) (cons (list (quote ref) name) args)))))
((= typ "keyword")
(do (adv!) (list (quote ref) val)))
(true nil))))) (true nil)))))
(define (define
parse-poss parse-poss
@@ -440,14 +337,6 @@
((and (= (tp-type) "op") (= (tp-val) "'s")) ((and (= (tp-type) "op") (= (tp-val) "'s"))
(do (adv!) (parse-poss-tail obj))) (do (adv!) (parse-poss-tail obj)))
((= (tp-type) "class") (parse-prop-chain obj)) ((= (tp-type) "class") (parse-prop-chain obj))
((= (tp-type) "dot")
(do
(adv!)
(let ((typ2 (tp-type)) (val2 (tp-val)))
(if
(or (= typ2 "ident") (= typ2 "keyword"))
(do (adv!) (parse-poss (list (make-symbol ".") obj val2)))
obj))))
((= (tp-type) "paren-open") ((= (tp-type) "paren-open")
(let (let
((args (parse-call-args))) ((args (parse-call-args)))
@@ -574,9 +463,7 @@
(list (list
(quote not) (quote not)
(list (quote eq-ignore-case) left right))) (list (quote eq-ignore-case) left right)))
(list (list (quote not) (list (quote =) left right)))))))
(quote not)
(list (quote hs-id=) left right)))))))
((match-kw "empty") (list (quote empty?) left)) ((match-kw "empty") (list (quote empty?) left))
((match-kw "less") ((match-kw "less")
(do (do
@@ -608,8 +495,7 @@
(quote and) (quote and)
(list (quote >=) left lo) (list (quote >=) left lo)
(list (quote <=) left hi))))) (list (quote <=) left hi)))))
((match-kw "in") ((match-kw "in") (list (quote in?) left (parse-expr)))
(list (quote in-bool?) left (parse-expr)))
((match-kw "really") ((match-kw "really")
(do (do
(match-kw "equal") (match-kw "equal")
@@ -685,8 +571,7 @@
(let (let
((right (parse-expr))) ((right (parse-expr)))
(list (quote not) (list (quote =) left right)))))) (list (quote not) (list (quote =) left right))))))
((match-kw "in") ((match-kw "in") (list (quote in?) left (parse-expr)))
(list (quote in-bool?) left (parse-expr)))
((match-kw "empty") (list (quote empty?) left)) ((match-kw "empty") (list (quote empty?) left))
((match-kw "between") ((match-kw "between")
(let (let
@@ -1006,7 +891,7 @@
(collect-classes!)))) (collect-classes!))))
(collect-classes!) (collect-classes!)
(let (let
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold))))) ((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
@@ -1035,7 +920,7 @@
(get (adv!) "value") (get (adv!) "value")
(parse-expr)))) (parse-expr))))
(let (let
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
(list (quote set-style) prop value tgt)))) (list (quote set-style) prop value tgt))))
((= (tp-type) "brace-open") ((= (tp-type) "brace-open")
(do (do
@@ -1054,16 +939,14 @@
((prop (get (adv!) "value"))) ((prop (get (adv!) "value")))
(when (= (tp-type) "colon") (adv!)) (when (= (tp-type) "colon") (adv!))
(let (let
((val (if (and (= (tp-type) "ident") (= (tp-val) "$")) (do (adv!) (when (= (tp-type) "brace-open") (adv!)) (if (= (tp-type) "brace-close") (do (adv!) (if (= (tp-type) "brace-open") (do (adv!) (let ((inner (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) inner)) "")) (let ((expr (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) expr))) (get (adv!) "value")))) ((val (tp-val)))
(adv!)
(set! pairs (cons (list prop val) pairs)) (set! pairs (cons (list prop val) pairs))
(when
(and (= (tp-type) "op") (= (tp-val) ";"))
(adv!))
(collect-pairs!)))))) (collect-pairs!))))))
(collect-pairs!) (collect-pairs!)
(when (= (tp-type) "brace-close") (adv!)) (when (= (tp-type) "brace-close") (adv!))
(let (let
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
(list (quote set-styles) (reverse pairs) tgt))))) (list (quote set-styles) (reverse pairs) tgt)))))
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr")) ((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
(do (do
@@ -1075,7 +958,7 @@
((attr-val (parse-expr))) ((attr-val (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!)) (when (= (tp-type) "bracket-close") (adv!))
(let (let
((tgt (parse-tgt-kw "to" (list (quote beingTold))))) ((tgt (parse-tgt-kw "to" (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
@@ -1093,7 +976,7 @@
(let (let
((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (parse-expr)) ""))) ((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (parse-expr)) "")))
(let (let
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold))))) ((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
@@ -1134,23 +1017,18 @@
(collect-classes!)))) (collect-classes!))))
(collect-classes!) (collect-classes!)
(let (let
((tgt (if (match-kw "from") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
(let (if
((when-clause (if (match-kw "when") (parse-expr) nil))) (empty? extra-classes)
(if (list (quote remove-class) cls tgt)
(empty? extra-classes) (cons
(if (quote multi-remove-class)
when-clause (cons tgt (cons cls extra-classes)))))))
(list (quote remove-class-when) cls tgt when-clause)
(list (quote remove-class) cls tgt))
(cons
(quote multi-remove-class)
(cons tgt (cons cls extra-classes))))))))
((= (tp-type) "attr") ((= (tp-type) "attr")
(let (let
((attr-name (get (adv!) "value"))) ((attr-name (get (adv!) "value")))
(let (let
((tgt (if (match-kw "from") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
(list (quote remove-attr) attr-name tgt)))) (list (quote remove-attr) attr-name tgt))))
((and (= (tp-type) "bracket-open") (= (tp-val) "[")) ((and (= (tp-type) "bracket-open") (= (tp-val) "["))
(do (do
@@ -1212,7 +1090,7 @@
(let (let
((cls2 (do (let ((v (tp-val))) (adv!) v)))) ((cls2 (do (let ((v (tp-val))) (adv!) v))))
(let (let
((tgt (parse-tgt-kw "on" (list (quote beingTold))))) ((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-between) cls1 cls2 tgt))) (list (quote toggle-between) cls1 cls2 tgt)))
nil))) nil)))
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr")) ((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
@@ -1237,7 +1115,7 @@
((v2 (parse-expr))) ((v2 (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!)) (when (= (tp-type) "bracket-close") (adv!))
(let (let
((tgt (parse-tgt-kw "on" (list (quote beingTold))))) ((tgt (parse-tgt-kw "on" (list (quote me)))))
(if (if
(= n1 n2) (= n1 n2)
(list (list
@@ -1271,7 +1149,7 @@
(let (let
((extra-classes (collect-classes (list)))) ((extra-classes (collect-classes (list))))
(let (let
((tgt (parse-tgt-kw "on" (list (quote beingTold))))) ((tgt (parse-tgt-kw "on" (list (quote me)))))
(cond (cond
((> (len extra-classes) 0) ((> (len extra-classes) 0)
(list (list
@@ -1300,7 +1178,7 @@
(let (let
((prop (get (adv!) "value"))) ((prop (get (adv!) "value")))
(let (let
((tgt (if (match-kw "of") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "of") (parse-expr) (list (quote me)))))
(if (if
(match-kw "between") (match-kw "between")
(let (let
@@ -1371,7 +1249,7 @@
(let (let
((attr-name (get (adv!) "value"))) ((attr-name (get (adv!) "value")))
(let (let
((tgt (if (match-kw "on") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "on") (parse-expr) (list (quote me)))))
(if (if
(match-kw "between") (match-kw "between")
(let (let
@@ -1396,7 +1274,7 @@
((attr-val (parse-expr))) ((attr-val (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!)) (when (= (tp-type) "bracket-close") (adv!))
(let (let
((tgt (parse-tgt-kw "on" (list (quote beingTold))))) ((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-attr-val) attr-name attr-val tgt)))))) (list (quote toggle-attr-val) attr-name attr-val tgt))))))
((and (= (tp-type) "keyword") (= (tp-val) "my")) ((and (= (tp-type) "keyword") (= (tp-val) "my"))
(do (do
@@ -1475,9 +1353,7 @@
((match-kw "to") ((match-kw "to")
(let (let
((value (parse-expr))) ((value (parse-expr)))
(if (and (list? tgt) (= (first tgt) (quote query))) (list (quote set!) tgt value)))
(list (quote set-el!) tgt value)
(list (quote set!) tgt value))))
((match-kw "on") ((match-kw "on")
(let (let
((target (parse-expr))) ((target (parse-expr)))
@@ -1626,7 +1502,7 @@
(let (let
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil))) ((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
(let (let
((tgt (parse-tgt-kw "to" (list (quote beingTold))))) ((tgt (parse-tgt-kw "to" (list (quote me)))))
(if (if
dtl dtl
(list (quote send) name dtl tgt) (list (quote send) name dtl tgt)
@@ -1640,7 +1516,7 @@
(let (let
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil))) ((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
(let (let
((tgt (parse-tgt-kw "on" (list (quote beingTold))))) ((tgt (parse-tgt-kw "on" (list (quote me)))))
(if (if
dtl dtl
(list (quote trigger) name dtl tgt) (list (quote trigger) name dtl tgt)
@@ -1679,7 +1555,7 @@
(fn (fn
() ()
(let (let
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr))))) ((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
(let (let
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display"))) ((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
(let (let
@@ -1690,7 +1566,7 @@
(fn (fn
() ()
(let (let
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr))))) ((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
(let (let
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display"))) ((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
(let (let
@@ -1716,7 +1592,7 @@
((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))) ((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 (if (and (= (tp-type) "ident") (= (tp-val) "initial")) (do (adv!) "initial") (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))))) ((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
@@ -1806,7 +1682,7 @@
((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil))) ((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil)))
(list (quote fetch-gql) gql-source url)))) (list (quote fetch-gql) gql-source url))))
(let (let
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (and (= (tp-type) "ident") (not (string-contains? (tp-val) "'"))) (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom)))) ((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (= (tp-type) "ident") (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom))))
(let (let
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom))))) ((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
(let (let
@@ -1822,9 +1698,7 @@
((fmt-after (if (and (not fmt-before) (match-kw "as")) (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil))) ((fmt-after (if (and (not fmt-before) (match-kw "as")) (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil)))
(let (let
((fmt (or fmt-before fmt-after "text"))) ((fmt (or fmt-before fmt-after "text")))
(let (list (quote fetch) url fmt)))))))))
((do-not-throw (cond ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false)) false))) ((and (= (tp-type) "ident") (= (tp-val) "don't")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false))) (true false))))
(list (quote fetch) url fmt do-not-throw))))))))))
(define (define
parse-call-args parse-call-args
(fn (fn
@@ -2145,21 +2019,7 @@
((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%"))))) ((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%")))))
(let (let
((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a))))) ((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a)))))
(let (parse-arith (list op left right)))))
((lhs-start (if (and (dict? left) (get left :hs-ast)) (get left :start) 0))
(lhs-line
(if
(and (dict? left) (get left :hs-ast))
(get left :line)
1)))
(parse-arith
(hs-ast-wrap
(list op left right)
"arith"
lhs-start
(prev-end)
lhs-line
{:rhs right :lhs left}))))))
left)))) left))))
(define (define
parse-the-expr parse-the-expr
@@ -2174,21 +2034,21 @@
(if (if
(match-kw "of") (match-kw "of")
(list (quote style) val (parse-expr)) (list (quote style) val (parse-expr))
(list (quote style) val (list (quote beingTold)))))) (list (quote style) val (list (quote me))))))
((= typ "attr") ((= typ "attr")
(do (do
(adv!) (adv!)
(if (if
(match-kw "of") (match-kw "of")
(list (quote attr) val (parse-expr)) (list (quote attr) val (parse-expr))
(list (quote attr) val (list (quote beingTold)))))) (list (quote attr) val (list (quote me))))))
((= typ "class") ((= typ "class")
(do (do
(adv!) (adv!)
(if (if
(match-kw "of") (match-kw "of")
(list (quote has-class?) (parse-expr) val) (list (quote has-class?) (parse-expr) val)
(list (quote has-class?) (list (quote beingTold)) val)))) (list (quote has-class?) (list (quote me)) val))))
((= typ "selector") ((= typ "selector")
(do (do
(adv!) (adv!)
@@ -2336,15 +2196,13 @@
() ()
(let (let
((tgt (parse-expr))) ((tgt (parse-expr)))
(list (list (quote measure) (if (nil? tgt) (list (quote me)) tgt)))))
(quote measure)
(if (nil? tgt) (list (quote beingTold)) tgt)))))
(define (define
parse-scroll-cmd parse-scroll-cmd
(fn (fn
() ()
(let (let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr)))) ((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
(let (let
((pos (cond ((match-kw "top") "top") ((match-kw "bottom") "bottom") ((match-kw "left") "left") ((match-kw "right") "right") (true "top")))) ((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))))) (list (quote scroll!) tgt pos)))))
@@ -2353,14 +2211,14 @@
(fn (fn
() ()
(let (let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr)))) ((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)))) (list (quote select!) tgt))))
(define (define
parse-reset-cmd parse-reset-cmd
(fn (fn
() ()
(let (let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr)))) ((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)))) (list (quote reset!) tgt))))
(define (define
parse-default-cmd parse-default-cmd
@@ -2385,7 +2243,7 @@
(fn (fn
() ()
(let (let
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr))))) ((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
(list (quote focus!) tgt)))) (list (quote focus!) tgt))))
(define (define
parse-feat-body parse-feat-body
@@ -2499,7 +2357,7 @@
(fn (fn
() ()
(let (let
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr))))) ((target (cond ((at-end?) (list (quote ref) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote ref) "me")) (true (parse-expr)))))
(list (quote empty-target) target)))) (list (quote empty-target) target))))
(define (define
parse-swap-cmd parse-swap-cmd
@@ -2524,42 +2382,15 @@
(fn (fn
() ()
(let (let
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr))))) ((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
(list (quote open-element) target)))) (list (quote open-element) target))))
(define (define
parse-close-cmd parse-close-cmd
(fn (fn
() ()
(let (let
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr))))) ((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
(list (quote close-element) target)))) (list (quote close-element) target))))
(define
parse-js-block
(fn
()
(let
((params (if (= (tp-type) "paren-open") (do (adv!) (define collect-params! (fn (acc) (cond ((or (at-end?) (= (tp-type) "paren-close")) (do (when (= (tp-type) "paren-close") (adv!)) acc)) ((= (tp-type) "comma") (do (adv!) (collect-params! acc))) (true (let ((pname (tp-val))) (do (adv!) (collect-params! (append acc pname)))))))) (collect-params! (list))) (list))))
(let
((js-start (cur-start)))
(define
skip-to-end!
(fn
()
(if
(or
(at-end?)
(and (= (tp-type) "keyword") (= (tp-val) "end")))
nil
(do (adv!) (skip-to-end!)))))
(skip-to-end!)
(let
((js-end (cur-start)))
(let
((js-src (substring src js-start js-end)))
(when
(and (= (tp-type) "keyword") (= (tp-val) "end"))
(adv!))
(list (quote js-block) params js-src)))))))
(define (define
parse-cmd parse-cmd
(fn (fn
@@ -2588,21 +2419,7 @@
((and (= typ "keyword") (= val "put")) ((and (= typ "keyword") (= val "put"))
(do (adv!) (parse-put-cmd))) (do (adv!) (parse-put-cmd)))
((and (= typ "keyword") (= val "if")) ((and (= typ "keyword") (= val "if"))
(let (do (adv!) (parse-if-cmd)))
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(let
((r (parse-if-cmd)))
(let
((tb (if (and (list? r) (> (len r) 2)) (nth r 2) nil)))
(hs-ast-wrap
r
"if"
s
(prev-end)
l
(if tb {:true-branch (if (and (list? tb) (= (first tb) (quote do))) (nth tb 1) tb)} {})))))))
((and (= typ "keyword") (= val "wait")) ((and (= typ "keyword") (= val "wait"))
(do (adv!) (parse-wait-cmd))) (do (adv!) (parse-wait-cmd)))
((and (= typ "keyword") (= val "send")) ((and (= typ "keyword") (= val "send"))
@@ -2610,17 +2427,7 @@
((and (= typ "keyword") (= val "trigger")) ((and (= typ "keyword") (= val "trigger"))
(do (adv!) (parse-trigger-cmd))) (do (adv!) (parse-trigger-cmd)))
((and (= typ "keyword") (= val "log")) ((and (= typ "keyword") (= val "log"))
(let (do (adv!) (parse-log-cmd)))
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(parse-log-cmd)
"cmd"
s
(prev-end)
l
{}))))
((and (= typ "keyword") (= val "increment")) ((and (= typ "keyword") (= val "increment"))
(do (adv!) (parse-inc-cmd))) (do (adv!) (parse-inc-cmd)))
((and (= typ "keyword") (= val "decrement")) ((and (= typ "keyword") (= val "decrement"))
@@ -2660,17 +2467,7 @@
((and (= typ "keyword") (= val "tell")) ((and (= typ "keyword") (= val "tell"))
(do (adv!) (parse-tell-cmd))) (do (adv!) (parse-tell-cmd)))
((and (= typ "keyword") (= val "for")) ((and (= typ "keyword") (= val "for"))
(let (do (adv!) (parse-for-cmd)))
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(parse-for-cmd)
"cmd"
s
(prev-end)
l
{}))))
((and (= typ "keyword") (= val "make")) ((and (= typ "keyword") (= val "make"))
(do (adv!) (parse-make-cmd))) (do (adv!) (parse-make-cmd)))
((and (= typ "keyword") (= val "install")) ((and (= typ "keyword") (= val "install"))
@@ -2709,18 +2506,6 @@
(do (adv!) (list (quote continue)))) (do (adv!) (list (quote continue))))
((and (= typ "keyword") (or (= val "exit") (= val "halt"))) ((and (= typ "keyword") (or (= val "exit") (= val "halt")))
(do (adv!) (list (quote exit)))) (do (adv!) (list (quote exit))))
((and (= typ "keyword") (= val "js"))
(do (adv!) (parse-js-block)))
((and (= typ "keyword") (= val "start"))
(do
(adv!)
(expect-kw! "view")
(expect-kw! "transition")
(let ((using (if (match-kw "using") (parse-expr) nil)))
(match-kw "then")
(let ((body (parse-cmd-list)))
(match-kw "end")
(list (quote view-transition!) using body)))))
(true (parse-expr)))))) (true (parse-expr))))))
(define (define
parse-cmd-list parse-cmd-list
@@ -2776,148 +2561,103 @@
(= v "close") (= v "close")
(= v "pick") (= v "pick")
(= v "ask") (= v "ask")
(= v "answer") (= v "answer"))))
(= v "js")
(= v "start"))))
(define (define
cl-collect cl-collect
(fn (fn
(acc) (acc)
(do (let
(when ((cmd (parse-cmd)))
(and (= (tp-type) "keyword") (= (tp-val) "then")) (if
(adv!)) (nil? cmd)
(let acc
((cmd (parse-cmd))) (let
(if ((acc2 (append acc (list cmd))))
(nil? cmd) (cond
acc ((match-kw "unless")
(let (let
((acc2 (append acc (list cmd)))) ((cnd (parse-expr)))
(cond (cl-collect
((match-kw "unless") (append
(let acc
((cnd (parse-expr))) (list
(cl-collect (list (quote if) (list (quote no) cnd) cmd))))))
(append ((match-kw "then")
acc (cl-collect (append acc2 (list (quote __then__)))))
(list ((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
(list (cl-collect acc2))
(quote if) (true acc2)))))))
(list (quote no) cnd)
cmd))))))
((match-kw "then")
(cl-collect (append acc2 (list (quote __then__)))))
((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
(cl-collect acc2))
(true acc2))))))))
(let (let
((cmds (cl-collect (list)))) ((cmds (cl-collect (list))))
(define (cond
link-next-cmds ((= (len cmds) 0) nil)
(fn ((= (len cmds) 1) (first cmds))
(cmds-list) (true
(define (cons
loop (quote do)
(fn (filter (fn (c) (not (= c (quote __then__)))) cmds)))))))
(i)
(when
(< i (- (len cmds-list) 1))
(let
((cur-node (nth cmds-list i))
(nxt-node (nth cmds-list (+ i 1))))
(when
(and (dict? cur-node) (get cur-node :hs-ast))
(dict-set! (get cur-node :fields) "next" nxt-node)))
(loop (+ i 1)))))
(loop 0)
cmds-list))
(let
((linked (if hs-span-mode (link-next-cmds cmds) cmds)))
(cond
((= (len linked) 0) nil)
((= (len linked) 1) (first linked))
(true
(cons
(quote do)
(filter (fn (c) (not (= c (quote __then__)))) linked))))))))
(define (define
parse-on-feat parse-on-feat
(fn (fn
() ()
(let (let
((every? (match-kw "every")) (first? (match-kw "first"))) ((every? (match-kw "every")))
(let (let
((event-name (parse-compound-event-name))) ((event-name (parse-compound-event-name)))
(let (let
((count-filter (let ((mn nil) (mx nil)) (when first? (do (set! mn 1) (set! mx 1))) (when (= (tp-type) "number") (let ((n (parse-number (tp-val)))) (do (adv!) (set! mn n) (cond ((match-kw "to") (cond ((= (tp-type) "number") (let ((mv (parse-number (tp-val)))) (do (adv!) (set! mx mv)))) (true (set! mx n)))) ((match-kw "and") (cond ((match-kw "on") (set! mx -1)) (true (set! mx n)))) (true (set! mx n)))))) (if mn (dict "min" mn "max" mx) nil)))) ((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
(let (let
((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil))))) ((source (if (match-kw "from") (parse-expr) nil)))
(let (let
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil))) ((h-margin nil) (h-threshold nil))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
(let (let
((elsewhere? (cond ((match-kw "elsewhere") true) ((and (= (tp-type) "keyword") (= (tp-val) "from") (let ((nxt (if (< (+ p 1) tok-len) (nth tokens (+ p 1)) nil))) (and nxt (= (get nxt "type") "keyword") (= (get nxt "value") "elsewhere")))) (do (adv!) (adv!) true)) (true false))) ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
(source (if (match-kw "from") (parse-expr) nil)))
(let (let
((h-margin nil) (h-threshold nil)) ((body (parse-cmd-list)))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
(when (and (= (tp-type) "keyword") (= (tp-val) "queue")) (do (adv!) (adv!)))
(let (let
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil))) ((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 (let
((body (parse-cmd-list))) ((parts (list (quote on) event-name)))
(let (let
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil)) ((parts (if every? (append parts (list :every true)) parts)))
(finally-clause
(if
(match-kw "finally")
(parse-cmd-list)
nil)))
(match-kw "end")
(let (let
((parts (list (quote on) event-name))) ((parts (if flt (append parts (list :filter flt)) parts)))
(let (let
((parts (if every? (append parts (list :every true)) parts))) ((parts (if source (append parts (list :from source)) parts)))
(let (let
((parts (if flt (append parts (list :filter flt)) parts))) ((parts (if having (append parts (list :having having)) parts)))
(let (let
((parts (if elsewhere? (append parts (list :elsewhere true)) parts))) ((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
(let (let
((parts (if source (append parts (list :from source)) parts))) ((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
(let (let
((parts (if count-filter (append parts (list :count-filter count-filter)) parts))) ((parts (append parts (list body))))
(let parts))))))))))))))))))
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
(let
((parts (if having (append parts (list :having having)) 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 (define
parse-init-feat parse-init-feat
(fn (fn
@@ -2993,9 +2733,6 @@
((= val "behavior") (do (adv!) (parse-behavior-feat))) ((= val "behavior") (do (adv!) (parse-behavior-feat)))
((= val "live") (do (adv!) (parse-live-feat))) ((= val "live") (do (adv!) (parse-live-feat)))
((= val "when") (do (adv!) (parse-when-feat))) ((= val "when") (do (adv!) (parse-when-feat)))
((= val "worker")
(error
"worker plugin is not installed — see https://hyperscript.org/features/worker"))
(true (parse-cmd-list)))))) (true (parse-cmd-list))))))
(define (define
coll-feats coll-feats
@@ -3014,13 +2751,4 @@
(first features) (first features)
(cons (quote do) features)))))) (cons (quote do) features))))))
(define hs-span-mode false)
(define hs-compile (fn (src) (hs-parse (hs-tokenize src) src))) (define hs-compile (fn (src) (hs-parse (hs-tokenize src) src)))
(define hs-parse-ast
(fn (src)
(do
(set! hs-span-mode true)
(let ((result (hs-parse (hs-tokenize src) src)))
(do (set! hs-span-mode false) result)))))

View File

@@ -43,47 +43,29 @@
;; Run an initializer function immediately. ;; Run an initializer function immediately.
;; (hs-init thunk) — called at element boot time ;; (hs-init thunk) — called at element boot time
(define meta (host-new "Object")) (define
hs-on
(fn
(target event-name handler)
(let
((wrapped (fn (event) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (dom-dispatch target "exception" {:error e})) (true (raise e))) (handler event)))))
(let
((unlisten (dom-listen target event-name wrapped))
(prev (or (dom-get-data target "hs-unlisteners") (list))))
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
unlisten))))
;; ── Async / timing ────────────────────────────────────────────── ;; ── Async / timing ──────────────────────────────────────────────
;; Wait for a duration in milliseconds. ;; Wait for a duration in milliseconds.
;; In hyperscript, wait is async-transparent — execution pauses. ;; In hyperscript, wait is async-transparent — execution pauses.
;; Here we use perform/IO suspension for true pause semantics. ;; Here we use perform/IO suspension for true pause semantics.
(define
_hs-on-caller
(let
((_ctx (host-new "Object"))
(_m (host-new "Object"))
(_f (host-new "Object")))
(do
(host-set! _f "type" "onFeature")
(host-set! _m "feature" _f)
(host-set! _ctx "meta" _m)
_ctx)))
;; Wait for a DOM event on a target.
;; (hs-wait-for target event-name) — suspends until event fires
(define
hs-on
(fn
(target event-name handler)
(let
((wrapped (fn (event) (do (host-set! meta "caller" _hs-on-caller) (host-set! meta "owner" target) (let ((__hs-no-stop false)) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (do (when (and (list? e) (= (first e) "hs-halt-default")) (set! __hs-no-stop true)) (when (not __hs-no-stop) (dom-dispatch target "exception" {:error e})))) (true (raise e))) (handler event)) (when (not __hs-no-stop) (host-call event "stopPropagation")))))))
(let
((unlisten (dom-listen target event-name wrapped))
(prev (or (dom-get-data target "hs-unlisteners") (list))))
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
unlisten))))
;; Wait for CSS transitions/animations to settle on an element.
(define (define
hs-on-every hs-on-every
(fn (target event-name handler) (dom-listen target event-name handler))) (fn (target event-name handler) (dom-listen target event-name handler)))
;; ── Class manipulation ────────────────────────────────────────── ;; Wait for a DOM event on a target.
;; (hs-wait-for target event-name) — suspends until event fires
;; Toggle a single class on an element.
(define (define
hs-on-intersection-attach! hs-on-intersection-attach!
(fn (fn
@@ -99,40 +81,15 @@
(host-call observer "observe" target) (host-call observer "observe" target)
observer))))) observer)))))
;; Toggle between two classes — exactly one is active at a time. ;; Wait for CSS transitions/animations to settle on an element.
(define
hs-on-mutation-attach!
(fn
(target mode attr-list)
(let
((cfg-attributes (or (= mode "any") (= mode "attributes") (= mode "attrs")))
(cfg-childList (or (= mode "any") (= mode "childList")))
(cfg-characterData (or (= mode "any") (= mode "characterData"))))
(let
((opts (dict "attributes" cfg-attributes "childList" cfg-childList "characterData" cfg-characterData "subtree" true)))
(when
(and (= mode "attrs") attr-list)
(dict-set! opts "attributeFilter" attr-list))
(let
((cb (fn (records observer) (dom-dispatch target "mutation" (dict "records" records)))))
(let
((observer (host-new "MutationObserver" cb)))
(host-call observer "observe" target opts)
observer))))))
;; Take a class from siblings — add to target, remove from others.
;; (hs-take! target cls) — like radio button class behavior
(define hs-init (fn (thunk) (thunk))) (define hs-init (fn (thunk) (thunk)))
;; ── DOM insertion ─────────────────────────────────────────────── ;; ── Class manipulation ──────────────────────────────────────────
;; Put content at a position relative to a target. ;; Toggle a single class on an element.
;; pos: "into" | "before" | "after"
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms)))) (define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
;; ── Navigation / traversal ────────────────────────────────────── ;; Toggle between two classes — exactly one is active at a time.
;; Navigate to a URL.
(begin (begin
(define (define
hs-wait-for hs-wait-for
@@ -145,15 +102,21 @@
(target event-name timeout-ms) (target event-name timeout-ms)
(perform (list (quote io-wait-event) target event-name timeout-ms))))) (perform (list (quote io-wait-event) target event-name timeout-ms)))))
;; Find next sibling matching a selector (or any sibling). ;; Take a class from siblings — add to target, remove from others.
;; (hs-take! target cls) — like radio button class behavior
(define hs-settle (fn (target) (perform (list (quote io-settle) target)))) (define hs-settle (fn (target) (perform (list (quote io-settle) target))))
;; Find previous sibling matching a selector. ;; ── DOM insertion ───────────────────────────────────────────────
;; Put content at a position relative to a target.
;; pos: "into" | "before" | "after"
(define (define
hs-toggle-class! hs-toggle-class!
(fn (target cls) (host-call (host-get target "classList") "toggle" cls))) (fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
;; First element matching selector within a scope. ;; ── Navigation / traversal ──────────────────────────────────────
;; Navigate to a URL.
(define (define
hs-toggle-between! hs-toggle-between!
(fn (fn
@@ -163,7 +126,7 @@
(do (dom-remove-class target cls1) (dom-add-class target cls2)) (do (dom-remove-class target cls1) (dom-add-class target cls2))
(do (dom-remove-class target cls2) (dom-add-class target cls1))))) (do (dom-remove-class target cls2) (dom-add-class target cls1)))))
;; Last element matching selector. ;; Find next sibling matching a selector (or any sibling).
(define (define
hs-toggle-style! hs-toggle-style!
(fn (fn
@@ -187,7 +150,7 @@
(dom-set-style target prop "hidden") (dom-set-style target prop "hidden")
(dom-set-style target prop ""))))))) (dom-set-style target prop "")))))))
;; First/last within a specific scope. ;; Find previous sibling matching a selector.
(define (define
hs-toggle-style-between! hs-toggle-style-between!
(fn (fn
@@ -199,6 +162,7 @@
(dom-set-style target prop val2) (dom-set-style target prop val2)
(dom-set-style target prop val1))))) (dom-set-style target prop val1)))))
;; First element matching selector within a scope.
(define (define
hs-toggle-style-cycle! hs-toggle-style-cycle!
(fn (fn
@@ -219,9 +183,7 @@
(true (find-next (rest remaining)))))) (true (find-next (rest remaining))))))
(dom-set-style target prop (find-next vals))))) (dom-set-style target prop (find-next vals)))))
;; ── Iteration ─────────────────────────────────────────────────── ;; Last element matching selector.
;; Repeat a thunk N times.
(define (define
hs-take! hs-take!
(fn (fn
@@ -261,7 +223,7 @@
(dom-set-attr target name attr-val) (dom-set-attr target name attr-val)
(dom-set-attr target name "")))))))) (dom-set-attr target name ""))))))))
;; Repeat forever (until break — relies on exception/continuation). ;; First/last within a specific scope.
(begin (begin
(define (define
hs-element? hs-element?
@@ -311,26 +273,7 @@
hs-set-inner-html! hs-set-inner-html!
(fn (fn
(target value) (target value)
(let (do (dom-set-inner-html target value) (hs-boot-subtree! target))))
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
(do (dom-set-inner-html target str-val) (hs-boot-subtree! target)))))
(define
hs-set-element!
(fn
(target value)
(let ((parent (dom-parent target)))
(when parent
(let ((tmp (dom-create-element "div"))
(str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
(do
(dom-set-inner-html tmp str-val)
(let ((children (host-get tmp "children")))
(if (> (len children) 0)
(let ((new-el (first children)))
(do
(host-call parent "replaceChild" new-el target)
(hs-boot-subtree! new-el)))
(hs-set-inner-html! target str-val)))))))))
(define (define
hs-put! hs-put!
(fn (fn
@@ -392,10 +335,6 @@
(dom-insert-adjacent-html target "beforeend" value) (dom-insert-adjacent-html target "beforeend" value)
(hs-boot-subtree! target))))))))) (hs-boot-subtree! target)))))))))
;; ── Fetch ───────────────────────────────────────────────────────
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(define (define
hs-add-to! hs-add-to!
(fn (fn
@@ -408,10 +347,9 @@
(append target (list value)))) (append target (list value))))
(true (do (host-call target "push" value) target))))) (true (do (host-call target "push" value) target)))))
;; ── Type coercion ─────────────────────────────────────────────── ;; ── Iteration ───────────────────────────────────────────────────
;; Coerce a value to a type by name. ;; Repeat a thunk N times.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define (define
hs-remove-from! hs-remove-from!
(fn (fn
@@ -421,10 +359,7 @@
(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))))
;; ── Object creation ───────────────────────────────────────────── ;; Repeat forever (until break — relies on exception/continuation).
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
(define (define
hs-splice-at! hs-splice-at!
(fn (fn
@@ -448,11 +383,10 @@
(host-call target "splice" i 1)))) (host-call target "splice" i 1))))
target)))) target))))
;; ── Behavior installation ─────────────────────────────────────── ;; ── Fetch ───────────────────────────────────────────────────────
;; Install a behavior on an element. ;; Fetch a URL, parse response according to format.
;; A behavior is a function that takes (me ...params) and sets up features. ;; (hs-fetch url format) — format is "json" | "text" | "html"
;; (hs-install behavior-fn me ...args)
(define (define
hs-index hs-index
(fn (fn
@@ -464,10 +398,10 @@
((string? obj) (nth obj key)) ((string? obj) (nth obj key))
(true (host-get obj key))))) (true (host-get obj key)))))
;; ── Measurement ───────────────────────────────────────────────── ;; ── Type coercion ───────────────────────────────────────────────
;; Measure an element's bounding rect, store as local variables. ;; Coerce a value to a type by name.
;; Returns a dict with x, y, width, height, top, left, right, bottom. ;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define (define
hs-put-at! hs-put-at!
(fn (fn
@@ -489,10 +423,10 @@
((= pos "start") (host-call target "unshift" value))) ((= pos "start") (host-call target "unshift" value)))
target))))))) target)))))))
;; Return the current text selection as a string. In the browser this is ;; ── Object creation ─────────────────────────────────────────────
;; `window.getSelection().toString()`. In the mock test runner, a test
;; setup stashes the desired selection text at `window.__test_selection` ;; Make a new object of a given type.
;; and the fallback path returns that so tests can assert on the result. ;; (hs-make type-name) — creates empty object/collection
(define (define
hs-dict-without hs-dict-without
(fn (fn
@@ -513,19 +447,27 @@
(host-call (host-global "Reflect") "deleteProperty" out key) (host-call (host-global "Reflect") "deleteProperty" out key)
out))))) out)))))
;; ── Behavior installation ───────────────────────────────────────
;; ── Transition ────────────────────────────────────────────────── ;; Install a behavior on an element.
;; A behavior is a function that takes (me ...params) and sets up features.
;; Transition a CSS property to a value, optionally with duration. ;; (hs-install behavior-fn me ...args)
;; (hs-transition target prop value duration)
(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))))
;; ── 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-navigate! (fn (url) (perform (list (quote io-navigate) url)))) (define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
;; Return the current text selection as a string. In the browser this is
;; `window.getSelection().toString()`. In the mock test runner, a test
;; setup stashes the desired selection text at `window.__test_selection`
;; and the fallback path returns that so tests can assert on the result.
(define (define
hs-ask hs-ask
(fn (fn
@@ -534,6 +476,11 @@
((w (host-global "window"))) ((w (host-global "window")))
(if w (host-call w "prompt" msg) nil)))) (if w (host-call w "prompt" msg) nil))))
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define (define
hs-answer hs-answer
(fn (fn
@@ -580,7 +527,7 @@
(do (do
(host-call ev "preventDefault") (host-call ev "preventDefault")
(host-call ev "stopPropagation"))))) (host-call ev "stopPropagation")))))
(when (not (= mode "the-event")) (raise (list (if (= mode "default") "hs-halt-default" "hs-return") nil)))))) (when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
(define hs-select! (fn (target) (host-call target "select" (list)))) (define hs-select! (fn (target) (host-call target "select" (list))))
@@ -664,10 +611,6 @@
(true (find-next (dom-next-sibling el)))))) (true (find-next (dom-next-sibling el))))))
(find-next sibling))))) (find-next sibling)))))
(define (define
hs-previous hs-previous
(fn (fn
@@ -690,8 +633,7 @@
(define (define
hs-query-all hs-query-all
(fn (sel) (host-call (dom-body) "querySelectorAll" sel))) (fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define (define
hs-query-all-in hs-query-all-in
(fn (fn
@@ -700,23 +642,26 @@
(nil? target) (nil? target)
(hs-query-all sel) (hs-query-all sel)
(host-call target "querySelectorAll" sel)))) (host-call target "querySelectorAll" sel))))
;; DOM query stub — sandbox returns empty list
(define (define
hs-list-set hs-list-set
(fn (fn
(lst idx val) (lst idx val)
(append (take lst idx) (cons val (drop lst (+ idx 1)))))) (append (take lst idx) (cons val (drop lst (+ idx 1))))))
;; Method dispatch — obj.method(args)
(define (define
hs-to-number hs-to-number
(fn (v) (if (number? v) v (or (parse-number (str v)) 0)))) (fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; ── 0.9.90 features ───────────────────────────────────────────── ;; Property access — dot notation and .length
;; beep! — debug logging, returns value unchanged
(define (define
hs-query-first hs-query-first
(fn (sel) (host-call (host-global "document") "querySelector" sel))) (fn (sel) (host-call (host-global "document") "querySelector" sel)))
;; Property-based is — check obj.key truthiness ;; DOM query stub — sandbox returns empty list
(define (define
hs-query-last hs-query-last
(fn (fn
@@ -724,9 +669,11 @@
(let (let
((all (dom-query-all (dom-body) sel))) ((all (dom-query-all (dom-body) sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil)))) (if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; Array slicing (inclusive both ends) ;; Method dispatch — obj.method(args)
(define hs-first (fn (scope sel) (dom-query-all scope sel))) (define hs-first (fn (scope sel) (dom-query-all scope sel)))
;; Collection: sorted by
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define (define
hs-last hs-last
(fn (fn
@@ -734,7 +681,7 @@
(let (let
((all (dom-query-all scope sel))) ((all (dom-query-all scope sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil)))) (if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; Collection: sorted by descending ;; Property-based is — check obj.key truthiness
(define (define
hs-repeat-times hs-repeat-times
(fn (fn
@@ -752,7 +699,7 @@
((= signal "hs-continue") (do-repeat (+ i 1))) ((= signal "hs-continue") (do-repeat (+ i 1)))
(true (do-repeat (+ i 1)))))))) (true (do-repeat (+ i 1))))))))
(do-repeat 0))) (do-repeat 0)))
;; Collection: split by ;; Array slicing (inclusive both ends)
(define (define
hs-repeat-forever hs-repeat-forever
(fn (fn
@@ -768,7 +715,7 @@
((= signal "hs-continue") (do-forever)) ((= signal "hs-continue") (do-forever))
(true (do-forever)))))) (true (do-forever))))))
(do-forever))) (do-forever)))
;; Collection: joined by ;; Collection: sorted by
(define (define
hs-repeat-while hs-repeat-while
(fn (fn
@@ -781,7 +728,7 @@
((= signal "hs-break") nil) ((= signal "hs-break") nil)
((= signal "hs-continue") (hs-repeat-while cond-fn thunk)) ((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
(true (hs-repeat-while cond-fn thunk))))))) (true (hs-repeat-while cond-fn thunk)))))))
;; Collection: sorted by descending
(define (define
hs-repeat-until hs-repeat-until
(fn (fn
@@ -793,13 +740,13 @@
((= signal "hs-continue") ((= signal "hs-continue")
(if (cond-fn) nil (hs-repeat-until cond-fn thunk))) (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk))))))) (true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
;; Collection: split by
(define (define
hs-for-each hs-for-each
(fn (fn
(fn-body collection) (fn-body collection)
(let (let
((items (cond ((list? collection) collection) ((nil? collection) (list)) ((host-iter? collection) (host-to-list collection)) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) (true (list))))) ((items (cond ((list? collection) collection) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) ((nil? collection) (list)) (true (list)))))
(define (define
do-loop do-loop
(fn (fn
@@ -813,7 +760,7 @@
((= signal "hs-continue") (do-loop (rest remaining))) ((= signal "hs-continue") (do-loop (rest remaining)))
(true (do-loop (rest remaining)))))))) (true (do-loop (rest remaining))))))))
(do-loop items)))) (do-loop items))))
;; Collection: joined by
(begin (begin
(define (define
hs-append hs-append
@@ -829,8 +776,7 @@
(append target (list value)))) (append target (list value))))
((hs-element? target) ((hs-element? target)
(do (do
(dom-insert-adjacent-html target "beforeend" (dom-insert-adjacent-html target "beforeend" (str value))
(if (hs-element? value) (host-get value "outerHTML") (str value)))
target)) target))
(true (str target value))))) (true (str target value)))))
(define (define
@@ -840,8 +786,7 @@
(cond (cond
((nil? target) nil) ((nil? target) nil)
((hs-element? target) ((hs-element? target)
(dom-insert-adjacent-html target "beforeend" (dom-insert-adjacent-html target "beforeend" (str value)))
(if (hs-element? value) (host-get value "outerHTML") (str value))))
(true nil))))) (true nil)))))
(define (define
@@ -907,44 +852,14 @@
out))))))))))) out)))))))))))
(define (define
hs-fetch-impl hs-fetch
(fn (fn
(url format no-throw) (url format)
(let (let
((fmt (cond ((fmt (cond ((nil? format) "text") ((or (= format "json") (= format "JSON") (= format "Object")) "json") ((or (= format "html") (= format "HTML")) "html") ((or (= format "response") (= format "Response")) "response") ((or (= format "text") (= format "Text")) "text") (true format))))
((nil? format) "text")
((or (= format "json") (= format "JSON") (= format "Object")) "json")
((or (= format "html") (= format "HTML")) "html")
((or (= format "response") (= format "Response")) "response")
((or (= format "text") (= format "Text")) "text")
((or (= format "number") (= format "Number")) "number")
(true "text"))))
(let
((_hs-before-caller (host-get meta "owner")))
(when _hs-before-caller
(dom-dispatch _hs-before-caller "hyperscript:beforeFetch" {:url url})))
(let (let
((raw (perform (list "io-fetch" url fmt)))) ((raw (perform (list "io-fetch" url fmt))))
(begin (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
(when (= (host-get raw "_network-error") true)
(raise (or (host-get raw "message") "Network error")))
(when (and (not no-throw) (not (= fmt "response")) (= (host-get raw "ok") false))
(raise (str "HTTP Error: " (host-get raw "status"))))
(cond
((= fmt "response") raw)
((= fmt "json")
(hs-host-to-sx (perform (list "io-parse-json" raw))))
((= fmt "number")
(hs-to-number (perform (list "io-parse-text" raw))))
(true (perform (list "io-parse-text" raw)))))))))
(define
hs-fetch
(fn (url format) (hs-fetch-impl url format false)))
(define
hs-fetch-no-throw
(fn (url format) (hs-fetch-impl url format true)))
(define (define
hs-json-escape hs-json-escape
@@ -1035,10 +950,9 @@
(true (str value)))) (true (str value))))
((= type-name "JSON") ((= type-name "JSON")
(cond (cond
((string? value) (guard (_e (true value)) (hs-host-to-sx (json-parse value)))) ((string? value) (guard (_e (true value)) (json-parse value)))
((not (nil? (host-get value "_json"))) ((dict? value) (hs-json-stringify value))
(hs-host-to-sx (perform (list "io-parse-json" value)))) ((list? value) (hs-json-stringify value))
((dict? value) value)
(true value))) (true value)))
((= type-name "Object") ((= type-name "Object")
(if (if
@@ -1197,17 +1111,7 @@
(if (if
(host-get node "multiple") (host-get node "multiple")
(hs-select-multi-values node) (hs-select-multi-values node)
(let (host-get node "value")))
((idx (host-get node "selectedIndex"))
(opts (host-get node "options"))
(raw-val (host-get node "value")))
(if
(and (not (nil? raw-val)) (not (= raw-val "")))
raw-val
(if
(and (not (nil? opts)) (>= idx 0))
(host-get (if (list? opts) (nth opts idx) (host-get opts idx)) "value")
"")))))
((or (= typ "checkbox") (= typ "radio")) ((or (= typ "checkbox") (= typ "radio"))
(if (host-get node "checked") (host-get node "value") nil)) (if (host-get node "checked") (host-get node "value") nil))
(true (host-get node "value")))))) (true (host-get node "value"))))))
@@ -1424,21 +1328,14 @@
hs-transition hs-transition
(fn (fn
(target prop value duration) (target prop value duration)
(let (when
((init-attr (str "data-hs-init-" prop))) duration
(when (dom-set-style
(not (dom-get-attr target init-attr)) target
(dom-set-attr target init-attr (dom-get-style target prop))) "transition"
(let (str prop " " (/ duration 1000) "s")))
((actual-value (if (= value "initial") (dom-get-attr target init-attr) value))) (dom-set-style target prop value)
(when (when duration (hs-settle target))))
duration
(dom-set-style
target
"transition"
(str prop " " (/ duration 1000) "s")))
(dom-set-style target prop actual-value)
(when duration (hs-settle target))))))
(define (define
hs-transition-from hs-transition-from
@@ -1501,15 +1398,6 @@
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))))
(define
hs-id=
(fn
(a b)
(if
(and (= (host-typeof a) "element") (= (host-typeof b) "element"))
(hs-ref-eq a b)
(= a b))))
(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)))))
@@ -1627,25 +1515,6 @@
(hs-contains? (rest collection) item)))))) (hs-contains? (rest collection) item))))))
(true false)))) (true false))))
(define
hs-in?
(fn
(collection item)
(cond
((nil? collection) (list))
((list? collection)
(cond
((nil? item) (list))
((list? item)
(filter (fn (x) (hs-contains? collection x)) item))
((hs-contains? collection item) (list item))
(true (list))))
(true (list)))))
(define
hs-in-bool?
(fn (collection item) (not (hs-falsy? (hs-in? collection item)))))
(define (define
hs-is hs-is
(fn (fn
@@ -2189,13 +2058,20 @@
(fn (fn
(pairs) (pairs)
(let (let
((d {})) ((d {}) (order (list)))
(do (do
(for-each (for-each
(fn (fn
(pair) (pair)
(dict-set! d (first pair) (nth pair 1))) (let
((k (first pair)))
(do
(when
(not (dict-has? d k))
(set! order (append order (list k))))
(dict-set! d k (nth pair 1)))))
pairs) pairs)
(when (not (empty? order)) (dict-set! d "_order" order))
d)))) d))))
(define (define
@@ -2219,13 +2095,7 @@
-1 -1
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1)))))) (if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
(idx-loop obj 0))) (idx-loop obj 0)))
(true (true nil))))
(let
((fn-val (host-get obj method)))
(cond
((and fn-val (callable? fn-val)) (apply fn-val args))
(fn-val (apply host-call (cons obj (cons method args))))
(true nil)))))))
(define hs-beep (fn (v) v)) (define hs-beep (fn (v) v))
@@ -2596,8 +2466,6 @@
((nth entry 2) val))) ((nth entry 2) val)))
_hs-dom-watchers))) _hs-dom-watchers)))
;; ── SourceInfo API ────────────────────────────────────────────────
(define (define
hs-dom-is-ancestor? hs-dom-is-ancestor?
(fn (fn
@@ -2606,215 +2474,3 @@
((nil? b) false) ((nil? b) false)
((= a b) true) ((= a b) true)
(true (hs-dom-is-ancestor? a (dom-parent b)))))) (true (hs-dom-is-ancestor? a (dom-parent b))))))
(define
hs-win-call
(fn
(fn-name args)
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
(define
hs-source-for
(fn
(node)
(substring (get node :src) (get node :start) (get node :end))))
(define
hs-line-for
(fn
(node)
(let
((lines (split (get node :src) "\n"))
(line-idx (- (get node :line) 1)))
(if (< line-idx (len lines)) (nth lines line-idx) ""))))
(define hs-node-get (fn (node key) (get (get node :fields) key)))
(define hs-src (fn (src-str) (hs-source-for (hs-parse-ast src-str))))
(define
hs-src-at
(fn
(src-str path)
(define
walk
(fn
(node keys)
(if
(or (nil? keys) (= (len keys) 0))
node
(walk (hs-node-get node (first keys)) (rest keys)))))
(hs-source-for (walk (hs-parse-ast src-str) path))))
(define
hs-line-at
(fn
(src-str path)
(define
walk
(fn
(node keys)
(if
(or (nil? keys) (= (len keys) 0))
node
(walk (hs-node-get node (first keys)) (rest keys)))))
(hs-line-for (walk (hs-parse-ast src-str) path))))
(define
hs-js-exec
(fn
(param-names js-src bound-args)
(let
((js-fn (host-new-function param-names js-src)))
(let
((result (host-call-fn js-fn bound-args)))
(if
(= (host-typeof result) "promise")
(let
((state (host-promise-state result)))
(if
(and state (= (host-get state "ok") false))
(raise (host-get state "value"))
(if state (host-get state "value") result)))
result)))))
(define
hs-raw->api-token
(fn
(raw)
(let
((type (dict-get raw :type)) (value (dict-get raw :value)))
(cond
(= type "ident")
{:value value :type "IDENTIFIER" :op false}
(= type "keyword")
{:value value :type "IDENTIFIER" :op false}
(= type "number")
{:value value :type "NUMBER" :op false}
(= type "string")
{:value value :type "STRING" :op false}
(= type "class")
{:value (str "." value) :type "CLASS_REF" :op false}
(= type "id")
{:value (str "#" value) :type "ID_REF" :op false}
(= type "attr")
{:value value :type "ATTRIBUTE_REF" :op false}
(= type "style")
{:value value :type "STYLE_REF" :op false}
(= type "selector")
{:value value :type "QUERY_REF" :op false}
(= type "eof")
{:value "<<<EOF>>>" :type "EOF" :op false}
(= type "paren-open")
{:value value :type "L_PAREN" :op true}
(= type "paren-close")
{:value value :type "R_PAREN" :op true}
(= type "bracket-open")
{:value value :type "L_BRACKET" :op true}
(= type "bracket-close")
{:value value :type "R_BRACKET" :op true}
(= type "brace-open")
{:value value :type "L_BRACE" :op true}
(= type "brace-close")
{:value value :type "R_BRACE" :op true}
(= type "comma")
{:value value :type "COMMA" :op true}
(= type "dot")
{:value value :type "PERIOD" :op true}
(= type "colon")
{:value value :type "COLON" :op true}
(= type "op")
(cond
(= value "+") {:value value :type "PLUS" :op true}
(= value "-") {:value value :type "MINUS" :op true}
(= value "*") {:value value :type "MULTIPLY" :op true}
(= value "/") {:value value :type "SLASH" :op true}
(= value "!") {:value value :type "EXCLAMATION" :op true}
(= value "?") {:value value :type "QUESTION" :op true}
(= value "#") {:value value :type "POUND" :op true}
(= value "&") {:value value :type "AMPERSAND" :op true}
(= value "=") {:value value :type "EQUALS" :op true}
(= value "<") {:value value :type "L_ANG" :op true}
(= value ">") {:value value :type "R_ANG" :op true}
(= value "<=") {:value value :type "LTE_ANG" :op true}
(= value ">=") {:value value :type "GTE_ANG" :op true}
(= value "==") {:value value :type "EQ" :op true}
(= value "===") {:value value :type "EQQ" :op true}
(= value "..") {:value value :type "PERIOD_PERIOD" :op true}
:else {:value value :type value :op true})
:else {:value (or value "") :type (str type) :op false}))))
(define hs-eof-sentinel {:value "<<<EOF>>>" :type "EOF" :op false})
(define
hs-tokens-of
(fn
(src &rest args)
(let
((template (some (fn (a) (equal? a :template)) args)))
(let
((raw (if template (hs-tokenize-template src) (hs-tokenize src))))
{:pos 0 :list (filter (fn (t) (not (= (dict-get t :type) "EOF"))) (map hs-raw->api-token raw)) :source src}))))
(define
hs-stream-token
(fn
(s i)
(let
((lst (dict-get s :list))
(n (len (dict-get s :list))))
(define
find
(fn
(pos count)
(if
(>= pos n)
hs-eof-sentinel
(let
((tok (nth lst pos)))
(if
(= (dict-get tok :type) "whitespace")
(find (+ pos 1) count)
(if
(= count 0)
tok
(find (+ pos 1) (- count 1))))))))
(find (dict-get s :pos) i))))
(define
hs-stream-consume
(fn
(s)
(let
((lst (dict-get s :list))
(n (len (dict-get s :list))))
(define
find-pos
(fn
(pos)
(if
(>= pos n)
pos
(if
(= (dict-get (nth lst pos) :type) "whitespace")
(find-pos (+ pos 1))
pos))))
(let
((p (find-pos (dict-get s :pos))))
(let
((tok (if (>= p n) hs-eof-sentinel (nth lst p))))
(do
(when
(not (= (dict-get tok :type) "EOF"))
(dict-set! s :pos (+ p 1)))
tok))))))
(define
hs-stream-has-more
(fn (s) (not (= (dict-get (hs-stream-token s 0) :type) "EOF"))))
(define hs-token-type (fn (tok) (dict-get tok :type)))
(define hs-token-value (fn (tok) (dict-get tok :value)))
(define hs-token-op? (fn (tok) (dict-get tok :op)))

View File

@@ -28,27 +28,6 @@
(define hs-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r")))) (define hs-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
(define
hs-hex-digit?
(fn
(c)
(or
(and (>= c "0") (<= c "9"))
(and (>= c "a") (<= c "f"))
(and (>= c "A") (<= c "F")))))
(define
hs-hex-val
(fn
(c)
(let
((code (char-code c)))
(cond
((and (>= code 48) (<= code 57)) (- code 48))
((and (>= code 65) (<= code 70)) (- code 55))
((and (>= code 97) (<= code 102)) (- code 87))
(true 0)))))
;; ── Keyword set ─────────────────────────────────────────────────── ;; ── Keyword set ───────────────────────────────────────────────────
(define (define
@@ -131,7 +110,6 @@
"append" "append"
"settle" "settle"
"transition" "transition"
"view"
"over" "over"
"closest" "closest"
"next" "next"
@@ -257,15 +235,10 @@
read-number read-number
(fn (fn
(start) (start)
(define (when
read-int (and (< pos src-len) (hs-digit? (hs-cur)))
(fn (hs-advance! 1)
() (read-number start))
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-int))))
(read-int)
(when (when
(and (and
(< pos src-len) (< pos src-len)
@@ -273,7 +246,15 @@
(< (+ pos 1) src-len) (< (+ pos 1) src-len)
(hs-digit? (hs-peek 1))) (hs-digit? (hs-peek 1)))
(hs-advance! 1) (hs-advance! 1)
(read-int)) (define
read-frac
(fn
()
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-frac))))
(read-frac))
(do (do
(when (when
(and (and
@@ -291,7 +272,15 @@
(< pos src-len) (< pos src-len)
(or (= (hs-cur) "+") (= (hs-cur) "-"))) (or (= (hs-cur) "+") (= (hs-cur) "-")))
(hs-advance! 1)) (hs-advance! 1))
(read-int)) (define
read-exp-digits
(fn
()
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-exp-digits))))
(read-exp-digits))
(let (let
((num-end pos)) ((num-end pos))
(when (when
@@ -319,7 +308,7 @@
() ()
(cond (cond
(>= pos src-len) (>= pos src-len)
(error "Unterminated string") nil
(= (hs-cur) "\\") (= (hs-cur) "\\")
(do (do
(hs-advance! 1) (hs-advance! 1)
@@ -329,37 +318,15 @@
((ch (hs-cur))) ((ch (hs-cur)))
(cond (cond
(= ch "n") (= ch "n")
(do (append! chars "\n") (hs-advance! 1)) (append! chars "\n")
(= ch "t") (= ch "t")
(do (append! chars "\t") (hs-advance! 1)) (append! chars "\t")
(= ch "r")
(do (append! chars "\r") (hs-advance! 1))
(= ch "b")
(do (append! chars (char-from-code 8)) (hs-advance! 1))
(= ch "f")
(do (append! chars (char-from-code 12)) (hs-advance! 1))
(= ch "v")
(do (append! chars (char-from-code 11)) (hs-advance! 1))
(= ch "\\") (= ch "\\")
(do (append! chars "\\") (hs-advance! 1)) (append! chars "\\")
(= ch quote-char) (= ch quote-char)
(do (append! chars quote-char) (hs-advance! 1)) (append! chars quote-char)
(= ch "x") :else (do (append! chars "\\") (append! chars ch)))
(do (hs-advance! 1)))
(hs-advance! 1)
(if
(and
(< (+ pos 1) src-len)
(hs-hex-digit? (hs-cur))
(hs-hex-digit? (hs-peek 1)))
(let
((d1 (hs-hex-val (hs-cur)))
(d2 (hs-hex-val (hs-peek 1))))
(append! chars (char-from-code (+ (* d1 16) d2)))
(hs-advance! 2))
(error "Invalid hexadecimal escape: \\x")))
:else
(do (append! chars "\\") (append! chars ch) (hs-advance! 1)))))
(loop)) (loop))
(= (hs-cur) quote-char) (= (hs-cur) quote-char)
(hs-advance! 1) (hs-advance! 1)
@@ -461,23 +428,12 @@
hs-emit! hs-emit!
(fn (fn
(type value start) (type value start)
(let (append! tokens (hs-make-token type value start))))
((tok (hs-make-token type value start))
(end-pos (max pos (+ start (if (nil? value) 0 (len (str value)))))))
(do
(dict-set! tok "end" end-pos)
(dict-set! tok "line" (len (split (slice src 0 start) "\n")))
(append! tokens tok)))))
(define (define
scan! scan!
(fn (fn
() ()
(let (skip-ws!)
((ws-start pos))
(skip-ws!)
(when
(and (> (len tokens) 0) (> pos ws-start))
(hs-emit! "whitespace" (slice src ws-start pos) ws-start)))
(when (when
(< pos src-len) (< pos src-len)
(let (let
@@ -501,15 +457,6 @@
(do (hs-emit! "selector" (read-selector) start) (scan!)) (do (hs-emit! "selector" (read-selector) start) (scan!))
(and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) ".")) (and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) "."))
(do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!)) (do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!))
(and
(= ch ".")
(< (+ pos 1) src-len)
(or (hs-letter? (hs-peek 1)) (= (hs-peek 1) "-") (= (hs-peek 1) "_"))
(> (len tokens) 0)
(let
((lt (dict-get (nth tokens (- (len tokens) 1)) :type)))
(or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close"))))
(do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!))
(and (and
(= ch ".") (= ch ".")
(< (+ pos 1) src-len) (< (+ pos 1) src-len)
@@ -521,15 +468,6 @@
(hs-advance! 1) (hs-advance! 1)
(hs-emit! "class" (read-class-name pos) start) (hs-emit! "class" (read-class-name pos) start)
(scan!)) (scan!))
(and
(= ch "#")
(< (+ pos 1) src-len)
(hs-ident-start? (hs-peek 1))
(> (len tokens) 0)
(let
((lt (dict-get (nth tokens (- (len tokens) 1)) :type)))
(or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close"))))
(do (hs-emit! "op" "#" start) (hs-advance! 1) (scan!))
(and (and
(= ch "#") (= ch "#")
(< (+ pos 1) src-len) (< (+ pos 1) src-len)
@@ -598,26 +536,10 @@
(do (do
(let (let
((word (read-ident start))) ((word (read-ident start)))
(let (hs-emit!
((full-word (if (hs-keyword? word) "keyword" "ident")
(if word
(and start))
(< pos src-len)
(= (hs-cur) "'")
(< (+ pos 1) src-len)
(hs-letter? (hs-peek 1))
(not
(and
(= (hs-peek 1) "s")
(or
(>= (+ pos 2) src-len)
(not (hs-ident-char? (hs-peek 2)))))))
(do (hs-advance! 1) (str word "'" (read-ident pos)))
word)))
(hs-emit!
(if (hs-keyword? full-word) "keyword" "ident")
full-word
start)))
(scan!)) (scan!))
(and (and
(or (= ch "=") (= ch "!") (= ch "<") (= ch ">")) (or (= ch "=") (= ch "!") (= ch "<") (= ch ">"))
@@ -698,82 +620,7 @@
(do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!)) (do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!))
(= ch "|") (= ch "|")
(do (hs-emit! "op" "|" start) (hs-advance! 1) (scan!)) (do (hs-emit! "op" "|" start) (hs-advance! 1) (scan!))
(= ch "&")
(do (hs-emit! "op" "&" start) (hs-advance! 1) (scan!))
(= ch "#")
(do (hs-emit! "op" "#" start) (hs-advance! 1) (scan!))
(= ch "?")
(do (hs-emit! "op" "?" start) (hs-advance! 1) (scan!))
(= ch ";")
(do (hs-emit! "op" ";" start) (hs-advance! 1) (scan!))
:else (do (hs-advance! 1) (scan!))))))) :else (do (hs-advance! 1) (scan!)))))))
(scan!) (scan!)
(hs-emit! "eof" nil pos) (hs-emit! "eof" nil pos)
tokens)))
;; ── Template-mode tokenizer (E37 API) ────────────────────────────────
;; Used by hs-tokens-of when :template flag is set.
;; Emits outer " chars as single STRING tokens; ${ ... } as $ { <inner-tokens> };
;; inner content is tokenized with the regular hs-tokenize.
(define
hs-tokenize-template
(fn
(src)
(let
((tokens (list)) (pos 0) (src-len (len src)))
(define t-cur (fn () (if (< pos src-len) (nth src pos) nil)))
(define t-peek (fn (n) (if (< (+ pos n) src-len) (nth src (+ pos n)) nil)))
(define t-advance! (fn (n) (set! pos (+ pos n))))
(define t-emit! (fn (type value) (append! tokens (hs-make-token type value pos))))
(define
scan-to-close!
(fn
(depth)
(when
(and (< pos src-len) (> depth 0))
(cond
(= (t-cur) "{")
(do (t-advance! 1) (scan-to-close! (+ depth 1)))
(= (t-cur) "}")
(when (> (- depth 1) 0) (t-advance! 1) (scan-to-close! (- depth 1)))
:else (do (t-advance! 1) (scan-to-close! depth))))))
(define
scan-template!
(fn
()
(when
(< pos src-len)
(let
((ch (t-cur)))
(cond
(= ch "\"")
(do (t-emit! "string" "\"") (t-advance! 1) (scan-template!))
(and (= ch "$") (= (t-peek 1) "{"))
(do
(t-emit! "op" "$")
(t-advance! 1)
(t-emit! "brace-open" "{")
(t-advance! 1)
(let
((inner-start pos))
(scan-to-close! 1)
(let
((inner-src (slice src inner-start pos))
(inner-toks (hs-tokenize inner-src)))
(for-each
(fn (tok)
(when (not (= (get tok "type") "eof"))
(append! tokens tok)))
inner-toks))
(t-emit! "brace-close" "}")
(when (< pos src-len) (t-advance! 1)))
(scan-template!))
(= ch "$")
(do (t-emit! "op" "$") (t-advance! 1) (scan-template!))
(hs-ws? ch)
(do (t-advance! 1) (scan-template!))
:else (do (t-advance! 1) (scan-template!)))))))
(scan-template!)
(t-emit! "eof" nil)
tokens))) tokens)))

View File

@@ -94,7 +94,7 @@
(fn (fn
(src) (src)
(let (let
((tokens (list)) (pos 0) (src-len (len src))) ((tokens (list)) (pos 0) (src-len (len src)) (nl-before false))
(define (define
js-peek js-peek
(fn (fn
@@ -109,11 +109,7 @@
(let (let
((sl (len s))) ((sl (len s)))
(and (<= (+ pos sl) src-len) (= (slice src pos (+ pos sl)) s))))) (and (<= (+ pos sl) src-len) (= (slice src pos (+ pos sl)) s)))))
(define (define js-emit! (fn (type value start) (append! tokens {:pos start :value value :type type :nl nl-before})))
js-emit!
(fn
(type value start)
(append! tokens (js-make-token type value start))))
(define (define
skip-line-comment! skip-line-comment!
(fn (fn
@@ -136,7 +132,13 @@
() ()
(cond (cond
((>= pos src-len) nil) ((>= pos src-len) nil)
((js-ws? (cur)) (do (advance! 1) (skip-ws!))) ((js-ws? (cur))
(do
(when
(or (= (cur) "\n") (= (cur) "\r"))
(set! nl-before true))
(advance! 1)
(skip-ws!)))
((and (= (cur) "/") (< (+ pos 1) src-len) (= (js-peek 1) "/")) ((and (= (cur) "/") (< (+ pos 1) src-len) (= (js-peek 1) "/"))
(do (advance! 2) (skip-line-comment!) (skip-ws!))) (do (advance! 2) (skip-line-comment!) (skip-ws!)))
((and (= (cur) "/") (< (+ pos 1) src-len) (= (js-peek 1) "*")) ((and (= (cur) "/") (< (+ pos 1) src-len) (= (js-peek 1) "*"))
@@ -568,6 +570,7 @@
(fn (fn
() ()
(do (do
(set! nl-before false)
(skip-ws!) (skip-ws!)
(when (when
(< pos src-len) (< pos src-len)

View File

@@ -835,6 +835,12 @@
jp-eat-semi jp-eat-semi
(fn (st) (if (jp-at? st "punct" ";") (do (jp-advance! st) nil) nil))) (fn (st) (if (jp-at? st "punct" ";") (do (jp-advance! st) nil) nil)))
(define
jp-token-nl?
(fn
(st)
(let ((tok (jp-peek st))) (if tok (= (get tok :nl) true) false))))
(define (define
jp-parse-vardecl jp-parse-vardecl
(fn (fn
@@ -1166,6 +1172,7 @@
(or (or
(jp-at? st "punct" ";") (jp-at? st "punct" ";")
(jp-at? st "punct" "}") (jp-at? st "punct" "}")
(jp-token-nl? st)
(jp-at? st "eof" nil)) (jp-at? st "eof" nil))
(do (jp-eat-semi st) (list (quote js-return) nil)) (do (jp-eat-semi st) (list (quote js-return) nil))
(let (let

View File

@@ -904,6 +904,36 @@
((= v false) 0) ((= v false) 0)
((= (type-of v) "number") v) ((= (type-of v) "number") v)
((= (type-of v) "string") (js-string-to-number v)) ((= (type-of v) "string") (js-string-to-number v))
((= (type-of v) "dict")
(cond
((contains? (keys v) "__js_number_value__")
(get v "__js_number_value__"))
((contains? (keys v) "__js_boolean_value__")
(if (get v "__js_boolean_value__") 1 0))
((contains? (keys v) "__js_string_value__")
(js-string-to-number (get v "__js_string_value__")))
(else
(let
((valueof-fn (js-get-prop v "valueOf")))
(if
(= (type-of valueof-fn) "lambda")
(let
((result (js-call-with-this v valueof-fn ())))
(if
(not (= (type-of result) "dict"))
(js-to-number result)
(let
((tostr-fn (js-get-prop v "toString")))
(if
(= (type-of tostr-fn) "lambda")
(let
((result2 (js-call-with-this v tostr-fn ())))
(if
(not (= (type-of result2) "dict"))
(js-to-number result2)
(js-nan-value)))
(js-nan-value)))))
(js-nan-value))))))
(else 0)))) (else 0))))
(define (define
@@ -1169,7 +1199,39 @@
((= v false) "false") ((= v false) "false")
((= (type-of v) "string") v) ((= (type-of v) "string") v)
((= (type-of v) "number") (js-number-to-string v)) ((= (type-of v) "number") (js-number-to-string v))
(else (str v))))) (else
(if
(= (type-of v) "dict")
(cond
((contains? (keys v) "__js_string_value__")
(get v "__js_string_value__"))
((contains? (keys v) "__js_number_value__")
(js-number-to-string (get v "__js_number_value__")))
((contains? (keys v) "__js_boolean_value__")
(if (get v "__js_boolean_value__") "true" "false"))
(else
(let
((tostr-fn (js-get-prop v "toString")))
(if
(= (type-of tostr-fn) "lambda")
(let
((result (js-call-with-this v tostr-fn ())))
(if
(= (type-of result) "dict")
(let
((valueof-fn (js-get-prop v "valueOf")))
(if
(= (type-of valueof-fn) "lambda")
(let
((result2 (js-call-with-this v valueof-fn ())))
(if
(= (type-of result2) "dict")
"[object Object]"
(js-to-string result2)))
"[object Object]"))
(js-to-string result)))
"[object Object]"))))
(str v))))))
(define (define
js-template-concat js-template-concat
@@ -1187,6 +1249,79 @@
(+ i 1) (+ i 1)
(str acc (js-to-string (nth parts i))))))) (str acc (js-to-string (nth parts i)))))))
(define
js-big-int-str-loop
(fn
(n acc)
(if
(< n 1)
(if (= acc "") "0" acc)
(let
((d (floor (- n (* 10 (floor (/ n 10)))))))
(js-big-int-str-loop
(floor (/ n 10))
(str (js-string-slice "0123456789" d (+ d 1)) acc))))))
(define
js-find-decimal-k
(fn
(n k)
(if
(> k 17)
17
(let
((big-int (round (* n (js-pow-int 10 k)))))
(if
(= (/ big-int (js-pow-int 10 k)) n)
k
(js-find-decimal-k n (+ k 1)))))))
(define
js-format-decimal-digits
(fn
(digits k)
(if
(= k 0)
digits
(let
((dlen (len digits)))
(if
(> dlen k)
(str
(js-string-slice digits 0 (- dlen k))
"."
(js-string-slice digits (- dlen k) dlen))
(if
(= dlen k)
(str "0." digits)
(str "0." (js-string-repeat "0" (- k dlen)) digits)))))))
(define
js-expand-sci-notation
(fn
(mant exp-n)
(let
((di (js-string-index-of mant "." 0)))
(let
((int-part (if (< di 0) mant (js-string-slice mant 0 di)))
(frac-part
(if (< di 0) "" (js-string-slice mant (+ di 1) (len mant)))))
(let
((all-digits (str int-part frac-part))
(frac-len (if (< di 0) 0 (- (- (len mant) di) 1))))
(if
(>= exp-n 0)
(if
(>= exp-n frac-len)
(str all-digits (js-string-repeat "0" (- exp-n frac-len)))
(let
((dot-pos (+ (len int-part) exp-n)))
(str
(js-string-slice all-digits 0 dot-pos)
"."
(js-string-slice all-digits dot-pos (len all-digits)))))
(str "0." (js-string-repeat "0" (- (- 0 exp-n) 1)) all-digits)))))))
(define (define
js-number-to-string js-number-to-string
(fn (fn
@@ -1195,7 +1330,16 @@
((js-number-is-nan n) "NaN") ((js-number-is-nan n) "NaN")
((= n (js-infinity-value)) "Infinity") ((= n (js-infinity-value)) "Infinity")
((= n (- 0 (js-infinity-value))) "-Infinity") ((= n (- 0 (js-infinity-value))) "-Infinity")
(else (js-normalize-num-str (str n)))))) (else
(let
((pos-n (if (< n 0) (- 0 n) n)))
(let
((s0 (js-normalize-num-str (str pos-n))))
(let
((n2 (js-to-number s0)))
(let
((precise (if (= n2 pos-n) (let ((ei (js-string-index-of s0 "e" 0))) (if (< ei 0) s0 (let ((exp-n (js-to-number (js-string-slice s0 (+ ei 1) (len s0))))) (if (and (>= exp-n -6) (<= exp-n 20)) (js-expand-sci-notation (js-string-slice s0 0 ei) exp-n) (if (>= exp-n 0) (str (js-string-slice s0 0 (+ ei 1)) "+" (str exp-n)) s0))))) (if (and (>= pos-n 1e-06) (< pos-n 1e+21)) (let ((k (js-find-decimal-k pos-n 0))) (let ((big-int (round (* pos-n (js-pow-int 10 k))))) (js-format-decimal-digits (js-big-int-str-loop big-int "") k))) (let ((ei (js-string-index-of s0 "e" 0))) (if (< ei 0) s0 (let ((exp-n (js-to-number (js-string-slice s0 (+ ei 1) (len s0))))) (if (>= exp-n 0) (str (js-string-slice s0 0 (+ ei 1)) "+" (str exp-n)) s0))))))))
(if (< n 0) (str "-" precise) precise)))))))))
(define (define
js-normalize-num-str js-normalize-num-str
@@ -1259,6 +1403,15 @@
(define js-mod (fn (a b) (mod (js-to-number a) (js-to-number b)))) (define js-mod (fn (a b) (mod (js-to-number a) (js-to-number b))))
(define
js-unsigned-rshift
(fn
(l r)
(let
((lu32 (modulo (js-math-trunc (js-to-number l)) 4294967296))
(shift (modulo (js-math-trunc (js-to-number r)) 32)))
(floor (/ lu32 (js-math-pow 2 shift))))))
(define js-pow (fn (a b) (pow (js-to-number a) (js-to-number b)))) (define js-pow (fn (a b) (pow (js-to-number a) (js-to-number b))))
(define js-neg (fn (a) (- 0 (js-to-number a)))) (define js-neg (fn (a) (- 0 (js-to-number a))))
@@ -1296,6 +1449,10 @@
(= (js-to-number a) b)) (= (js-to-number a) b))
((= (type-of a) "boolean") (js-loose-eq (js-to-number a) b)) ((= (type-of a) "boolean") (js-loose-eq (js-to-number a) b))
((= (type-of b) "boolean") (js-loose-eq a (js-to-number b))) ((= (type-of b) "boolean") (js-loose-eq a (js-to-number b)))
((and (dict? a) (contains? (keys a) "__js_string_value__"))
(js-loose-eq (get a "__js_string_value__") b))
((and (dict? b) (contains? (keys b) "__js_string_value__"))
(js-loose-eq a (get b "__js_string_value__")))
(else false)))) (else false))))
(define js-loose-neq (fn (a b) (not (js-loose-eq a b)))) (define js-loose-neq (fn (a b) (not (js-loose-eq a b))))
@@ -1897,13 +2054,21 @@
(fn (fn
(i) (i)
(let (let
((idx (js-num-to-int i))) ((idx (js-num-to-int (js-to-number i))))
(if (if
(and (>= idx 0) (< idx (len s))) (and (>= idx 0) (< idx (unicode-len s)))
(char-code (char-at s idx)) (unicode-char-code-at s idx)
0)))) (js-nan-value)))))
((= name "indexOf") ((= name "indexOf")
(fn (needle) (js-string-index-of s (js-to-string needle) 0))) (fn
(&rest args)
(if
(empty? args)
-1
(js-string-index-of
s
(js-to-string (nth args 0))
(if (< (len args) 2) 0 (max 0 (js-num-to-int (nth args 1))))))))
((= name "slice") ((= name "slice")
(fn (fn
(&rest args) (&rest args)
@@ -1927,7 +2092,16 @@
(js-string-slice s lo (min hi (len s))))))) (js-string-slice s lo (min hi (len s)))))))
((= name "toUpperCase") (fn () (js-upper-case s))) ((= name "toUpperCase") (fn () (js-upper-case s)))
((= name "toLowerCase") (fn () (js-lower-case s))) ((= name "toLowerCase") (fn () (js-lower-case s)))
((= name "split") (fn (sep) (js-string-split s (js-to-string sep)))) ((= name "split")
(fn
(&rest args)
(let
((sep (if (= (len args) 0) :js-undefined (nth args 0)))
(limit
(if (< (len args) 2) -1 (js-num-to-int (nth args 1)))))
(let
((result (js-string-split s (js-to-string sep))))
(if (< limit 0) result (js-list-take result limit))))))
((= name "concat") ((= name "concat")
(fn (&rest args) (js-string-concat-loop s args 0))) (fn (&rest args) (js-string-concat-loop s args 0)))
((= name "includes") ((= name "includes")
@@ -2042,6 +2216,17 @@
(= idx -1) (= idx -1)
nil nil
(let ((res (list))) (append! res needle) res)))))))) (let ((res (list))) (append! res needle) res))))))))
((= name "matchAll")
(fn
(&rest args)
(if
(empty? args)
(list)
(let
((needle (js-to-string (nth args 0))))
(let
((loop (fn (start acc) (let ((idx (js-string-index-of s needle start))) (if (= idx -1) acc (let ((m (list))) (begin (append! m needle) (dict-set! m "index" idx) (loop (+ idx (max 1 (len needle))) (begin (append! acc m) acc)))))))))
(loop 0 (list)))))))
((= name "at") ((= name "at")
(fn (fn
(i) (i)
@@ -2068,7 +2253,14 @@
-1 -1
(let (let
((needle (js-to-string (nth args 0)))) ((needle (js-to-string (nth args 0))))
(js-string-last-index-of s needle (- (len s) (len needle))))))) (let
((default-start (- (len s) (len needle)))
(from
(if (< (len args) 2) -1 (js-num-to-int (nth args 1)))))
(js-string-last-index-of
s
needle
(if (< from 0) default-start (min from default-start))))))))
((= name "localeCompare") ((= name "localeCompare")
(fn (fn
(&rest args) (&rest args)
@@ -2166,6 +2358,15 @@
((not (= (char-at s (+ si ni)) (char-at needle ni))) false) ((not (= (char-at s (+ si ni)) (char-at needle ni))) false)
(else (js-string-matches? s needle si (+ ni 1)))))) (else (js-string-matches? s needle si (+ ni 1))))))
(define
js-list-take
(fn
(lst n)
(if
(or (<= n 0) (empty? lst))
(list)
(cons (first lst) (js-list-take (rest lst) (- n 1))))))
(define (define
js-string-split js-string-split
(fn (fn
@@ -2265,7 +2466,7 @@
(else js-undefined))) (else js-undefined)))
((= (type-of obj) "string") ((= (type-of obj) "string")
(cond (cond
((= key "length") (len obj)) ((= key "length") (unicode-len obj))
((= (type-of key) "number") ((= (type-of key) "number")
(if (if
(and (>= key 0) (< key (len obj))) (and (>= key 0) (< key (len obj)))
@@ -2306,7 +2507,13 @@
(js-string-method obj "toLocaleUpperCase")) (js-string-method obj "toLocaleUpperCase"))
((= key "isWellFormed") (js-string-method obj "isWellFormed")) ((= key "isWellFormed") (js-string-method obj "isWellFormed"))
((= key "toWellFormed") (js-string-method obj "toWellFormed")) ((= key "toWellFormed") (js-string-method obj "toWellFormed"))
(else js-undefined))) (else
(let
((proto (get String "prototype")))
(if
(and (dict? proto) (contains? (keys proto) key))
(get proto key)
js-undefined)))))
((= (type-of obj) "dict") ((= (type-of obj) "dict")
(js-dict-get-walk obj (js-to-string key))) (js-dict-get-walk obj (js-to-string key)))
((and (= obj Promise) (dict-has? __js_promise_statics__ (js-to-string key))) ((and (= obj Promise) (dict-has? __js_promise_statics__ (js-to-string key)))
@@ -2480,7 +2687,49 @@
((n (js-to-number (first args)))) ((n (js-to-number (first args))))
(js-math-hypot-loop (rest args) (+ acc (* n n))))))) (js-math-hypot-loop (rest args) (+ acc (* n n)))))))
(define Math {:random js-math-random :trunc js-math-trunc :LN10 2.30259 :SQRT1_2 0.707107 :floor js-math-floor :PI 3.14159 :sqrt js-math-sqrt :hypot js-math-hypot :LOG2E 1.4427 :round js-math-round :ceil js-math-ceil :abs js-math-abs :pow js-math-pow :max js-math-max :LOG10E 0.434294 :SQRT2 1.41421 :cbrt js-math-cbrt :min js-math-min :sign js-math-sign :E 2.71828 :LN2 0.693147}) (begin
(define js-math-sin (fn (x) (sin (js-to-number x))))
(define js-math-cos (fn (x) (cos (js-to-number x))))
(define js-math-tan (fn (x) (tan (js-to-number x))))
(define js-math-asin (fn (x) (asin (js-to-number x))))
(define js-math-acos (fn (x) (acos (js-to-number x))))
(define js-math-atan (fn (x) (atan (js-to-number x))))
(define
js-math-atan2
(fn (y x) (atan2 (js-to-number y) (js-to-number x))))
(define js-math-sinh (fn (x) (sinh (js-to-number x))))
(define js-math-cosh (fn (x) (cosh (js-to-number x))))
(define js-math-tanh (fn (x) (tanh (js-to-number x))))
(define js-math-asinh (fn (x) (asinh (js-to-number x))))
(define js-math-acosh (fn (x) (acosh (js-to-number x))))
(define js-math-atanh (fn (x) (atanh (js-to-number x))))
(define js-math-exp (fn (x) (exp (js-to-number x))))
(define js-math-log (fn (x) (log (js-to-number x))))
(define js-math-log2 (fn (x) (log2 (js-to-number x))))
(define js-math-log10 (fn (x) (log10 (js-to-number x))))
(define js-math-expm1 (fn (x) (expm1 (js-to-number x))))
(define js-math-log1p (fn (x) (log1p (js-to-number x))))
(define
js-math-clz32
(fn
(&rest args)
(let
((x (if (empty? args) 0 (js-to-number (nth args 0)))))
(let
((n (modulo (floor x) 4294967296)))
(if (= n 0) 32 (- 31 (floor (log2 n))))))))
(define
js-math-imul
(fn
(a b)
(let
((a32 (modulo (floor (js-to-number a)) 4294967296))
(b32 (modulo (floor (js-to-number b)) 4294967296)))
(let
((result (modulo (* a32 b32) 4294967296)))
(if (>= result 2147483648) (- result 4294967296) result)))))
(define js-math-fround (fn (x) (js-to-number x)))
(define Math {:trunc js-math-trunc :expm1 js-math-expm1 :atan2 js-math-atan2 :PI 3.14159 :asinh js-math-asinh :acosh js-math-acosh :hypot js-math-hypot :LOG2E 1.4427 :atanh js-math-atanh :ceil js-math-ceil :pow js-math-pow :sin js-math-sin :max js-math-max :log2 js-math-log2 :SQRT2 1.41421 :cbrt js-math-cbrt :log1p js-math-log1p :fround js-math-fround :E 2.71828 :sinh js-math-sinh :random js-math-random :LN10 2.30259 :SQRT1_2 0.707107 :asin js-math-asin :clz32 js-math-clz32 :floor js-math-floor :exp js-math-exp :tan js-math-tan :sqrt js-math-sqrt :cosh js-math-cosh :log js-math-log :round js-math-round :abs js-math-abs :LOG10E 0.434294 :tanh js-math-tanh :acos js-math-acos :log10 js-math-log10 :min js-math-min :sign js-math-sign :LN2 0.693147 :cos js-math-cos :imul js-math-imul :atan js-math-atan}))
(define (define
js-number-is-finite js-number-is-finite
@@ -2524,6 +2773,52 @@
(dict-set! (get Number "prototype") "constructor" Number) (dict-set! (get Number "prototype") "constructor" Number)
(dict-set!
Number
"__callable__"
(fn
(&rest args)
(let
((raw (if (= (len args) 0) 0 (js-to-number (nth args 0)))))
(let
((this-val (js-this)))
(if
(and
(dict? this-val)
(contains? (keys this-val) "__proto__")
(= (get this-val "__proto__") (get Number "prototype")))
(begin (dict-set! this-val "__js_number_value__" raw) this-val)
raw)))))
(dict-set!
(get Number "prototype")
"valueOf"
(fn
()
(let
((this-val (js-this)))
(if
(and
(dict? this-val)
(contains? (keys this-val) "__js_number_value__"))
(get this-val "__js_number_value__")
this-val))))
(dict-set!
(get Number "prototype")
"toString"
(fn
(&rest args)
(let
((this-raw (js-this)))
(let
((this-val (if (and (dict? this-raw) (contains? (keys this-raw) "__js_number_value__")) (get this-raw "__js_number_value__") this-raw)))
(let
((radix (if (empty? args) 10 (js-to-number (nth args 0)))))
(js-num-to-str-radix
this-val
(if (or (= radix nil) (js-undefined? radix)) 10 radix)))))))
(define isFinite js-global-is-finite) (define isFinite js-global-is-finite)
(define isNaN js-global-is-nan) (define isNaN js-global-is-nan)
@@ -2982,10 +3277,50 @@
(dict-set! Array "name" "Array") (dict-set! Array "name" "Array")
(dict-set!
(get Array "prototype")
"toString"
(fn
(&rest args)
(let
((this-val (js-this)))
(let
((items (cond ((list? this-val) this-val) ((and (dict? this-val) (contains? (keys this-val) "length")) (js-arraylike-to-list this-val)) (else (list)))))
(js-list-join items ",")))))
(define (define
js-string-from-char-code js-string-from-char-code
(fn (&rest args) (js-string-from-char-code-loop args 0 ""))) (fn (&rest args) (js-string-from-char-code-loop args 0 "")))
(define
js-string-from-code-point-loop
(fn
(args i acc)
(if
(>= i (len args))
acc
(let
((cp (floor (js-to-number (nth args i)))))
(if
(< cp 65536)
(js-string-from-code-point-loop
args
(+ i 1)
(str acc (js-code-to-char (js-num-to-int cp))))
(let
((hi (+ 55296 (floor (/ (- cp 65536) 1024))))
(lo (+ 56320 (modulo (- cp 65536) 1024))))
(js-string-from-code-point-loop
args
(+ i 1)
(str
(str acc (js-code-to-char (js-num-to-int hi)))
(js-code-to-char (js-num-to-int lo))))))))))
(define
js-string-from-code-point
(fn (&rest args) (js-string-from-code-point-loop args 0 "")))
(define (define
js-string-from-char-code-loop js-string-from-char-code-loop
(fn (fn
@@ -2993,10 +3328,14 @@
(if (if
(>= i (len args)) (>= i (len args))
acc acc
(js-string-from-char-code-loop (let
args ((n (js-to-number (nth args i))))
(+ i 1) (let
(str acc (js-code-to-char (js-num-to-int (nth args i)))))))) ((code (if (js-global-is-nan n) 0 (modulo (js-math-trunc n) 65536))))
(js-string-from-char-code-loop
args
(+ i 1)
(str acc (char-from-code code))))))))
(define (define
js-string-proto-fn js-string-proto-fn
@@ -3006,7 +3345,9 @@
(&rest args) (&rest args)
(let (let
((this-val (js-this))) ((this-val (js-this)))
(js-invoke-method (js-to-string this-val) name args))))) (let
((s (cond ((= (type-of this-val) "string") this-val) ((and (= (type-of this-val) "dict") (contains? (keys this-val) "__js_string_value__")) (get this-val "__js_string_value__")) (else "[object Object]"))))
(js-invoke-method s name args))))))
(define String {:fromCharCode js-string-from-char-code :__callable__ (fn (&rest args) (if (= (len args) 0) "" (js-to-string (nth args 0)))) :prototype {:toLowerCase (js-string-proto-fn "toLowerCase") :concat (js-string-proto-fn "concat") :startsWith (js-string-proto-fn "startsWith") :padEnd (js-string-proto-fn "padEnd") :codePointAt (js-string-proto-fn "codePointAt") :lastIndexOf (js-string-proto-fn "lastIndexOf") :indexOf (js-string-proto-fn "indexOf") :localeCompare (js-string-proto-fn "localeCompare") :split (js-string-proto-fn "split") :endsWith (js-string-proto-fn "endsWith") :trim (js-string-proto-fn "trim") :valueOf (js-string-proto-fn "valueOf") :at (js-string-proto-fn "at") :normalize (js-string-proto-fn "normalize") :substring (js-string-proto-fn "substring") :replaceAll (js-string-proto-fn "replaceAll") :repeat (js-string-proto-fn "repeat") :padStart (js-string-proto-fn "padStart") :search (js-string-proto-fn "search") :toUpperCase (js-string-proto-fn "toUpperCase") :trimEnd (js-string-proto-fn "trimEnd") :toString (js-string-proto-fn "toString") :toLocaleLowerCase (js-string-proto-fn "toLocaleLowerCase") :charCodeAt (js-string-proto-fn "charCodeAt") :slice (js-string-proto-fn "slice") :charAt (js-string-proto-fn "charAt") :match (js-string-proto-fn "match") :includes (js-string-proto-fn "includes") :trimStart (js-string-proto-fn "trimStart") :toLocaleUpperCase (js-string-proto-fn "toLocaleUpperCase") :replace (js-string-proto-fn "replace")} :raw (fn (&rest args) (if (empty? args) "" (js-to-string (nth args 0))))}) (define String {:fromCharCode js-string-from-char-code :__callable__ (fn (&rest args) (if (= (len args) 0) "" (js-to-string (nth args 0)))) :prototype {:toLowerCase (js-string-proto-fn "toLowerCase") :concat (js-string-proto-fn "concat") :startsWith (js-string-proto-fn "startsWith") :padEnd (js-string-proto-fn "padEnd") :codePointAt (js-string-proto-fn "codePointAt") :lastIndexOf (js-string-proto-fn "lastIndexOf") :indexOf (js-string-proto-fn "indexOf") :localeCompare (js-string-proto-fn "localeCompare") :split (js-string-proto-fn "split") :endsWith (js-string-proto-fn "endsWith") :trim (js-string-proto-fn "trim") :valueOf (js-string-proto-fn "valueOf") :at (js-string-proto-fn "at") :normalize (js-string-proto-fn "normalize") :substring (js-string-proto-fn "substring") :replaceAll (js-string-proto-fn "replaceAll") :repeat (js-string-proto-fn "repeat") :padStart (js-string-proto-fn "padStart") :search (js-string-proto-fn "search") :toUpperCase (js-string-proto-fn "toUpperCase") :trimEnd (js-string-proto-fn "trimEnd") :toString (js-string-proto-fn "toString") :toLocaleLowerCase (js-string-proto-fn "toLocaleLowerCase") :charCodeAt (js-string-proto-fn "charCodeAt") :slice (js-string-proto-fn "slice") :charAt (js-string-proto-fn "charAt") :match (js-string-proto-fn "match") :includes (js-string-proto-fn "includes") :trimStart (js-string-proto-fn "trimStart") :toLocaleUpperCase (js-string-proto-fn "toLocaleUpperCase") :replace (js-string-proto-fn "replace")} :raw (fn (&rest args) (if (empty? args) "" (js-to-string (nth args 0))))})
@@ -3016,12 +3357,85 @@
(dict-set! String "name" "String") (dict-set! String "name" "String")
(dict-set! String "fromCodePoint" js-string-from-code-point)
(dict-set! String "fromCharCode" js-string-from-char-code)
(dict-set!
String
"__callable__"
(fn
(&rest args)
(let
((raw (if (= (len args) 0) "" (js-to-string (nth args 0)))))
(let
((this-val (js-this)))
(if
(and
(dict? this-val)
(contains? (keys this-val) "__proto__")
(= (get this-val "__proto__") (get String "prototype")))
(begin
(dict-set! this-val "__js_string_value__" raw)
(dict-set! this-val "length" (len raw))
this-val)
raw)))))
(define Boolean {:__callable__ (fn (&rest args) (if (= (len args) 0) false (js-to-boolean (nth args 0))))}) (define Boolean {:__callable__ (fn (&rest args) (if (= (len args) 0) false (js-to-boolean (nth args 0))))})
(dict-set!
(get String "prototype")
"matchAll"
(js-string-proto-fn "matchAll"))
(dict-set! Boolean "length" 1) (dict-set! Boolean "length" 1)
(dict-set! Boolean "name" "Boolean") (dict-set! Boolean "name" "Boolean")
(dict-set! Boolean "prototype" {:constructor Boolean})
(dict-set!
Boolean
"__callable__"
(fn
(&rest args)
(let
((val (if (> (len args) 0) (js-to-boolean (nth args 0)) false)))
(let
((this-val (js-this)))
(if
(dict? this-val)
(begin
(dict-set! this-val "__js_boolean_value__" val)
(dict-set! this-val "__proto__" (get Boolean "prototype"))
this-val)
(if val true false))))))
(dict-set!
(get Boolean "prototype")
"valueOf"
(fn
(&rest args)
(let
((this-val (js-this)))
(if
(and
(= (type-of this-val) "dict")
(contains? (keys this-val) "__js_boolean_value__"))
(get this-val "__js_boolean_value__")
this-val))))
(dict-set!
(get Boolean "prototype")
"toString"
(fn
(&rest args)
(let
((this-val (js-this)))
(let
((b (if (and (= (type-of this-val) "dict") (contains? (keys this-val) "__js_boolean_value__")) (get this-val "__js_boolean_value__") this-val)))
(if b "true" "false")))))
(define (define
parseInt parseInt
(fn (fn

View File

@@ -1323,6 +1323,25 @@ cat > "$TMPFILE" << 'EPOCHS'
(epoch 3505) (epoch 3505)
(eval "(js-eval \"var a = {length: 3, 0: 10, 1: 20, 2: 30}; var sum = 0; Array.prototype.forEach.call(a, function(x){sum += x;}); sum\")") (eval "(js-eval \"var a = {length: 3, 0: 10, 1: 20, 2: 30}; var sum = 0; Array.prototype.forEach.call(a, function(x){sum += x;}); sum\")")
;; ── Phase 1.ASI: automatic semicolon insertion ─────────────────
(epoch 4200)
(eval "(js-eval \"function f() { return\n42\n} f()\")")
(epoch 4201)
(eval "(js-eval \"function g() { return 42 } g()\")")
(epoch 4202)
(eval "(let ((toks (js-tokenize \"a\nb\"))) (get (nth toks 1) :nl))")
(epoch 4203)
(eval "(let ((toks (js-tokenize \"a b\"))) (get (nth toks 1) :nl))")
(epoch 4300)
(eval "(js-eval \"var x = 5; x\")")
(epoch 4301)
(eval "(js-eval \"function f() { return x; var x = 42; } f()\")")
(epoch 4302)
(eval "(js-eval \"function f() { var y = 7; return y; } f()\")")
(epoch 4303)
(eval "(js-eval \"function f() { var z; z = 3; return z; } f()\")")
EPOCHS EPOCHS
@@ -2042,6 +2061,17 @@ check 3503 "indexOf.call arrLike" '1'
check 3504 "filter.call arrLike" '"2,3"' check 3504 "filter.call arrLike" '"2,3"'
check 3505 "forEach.call arrLike sum" '60' check 3505 "forEach.call arrLike sum" '60'
# ── Phase 1.ASI: automatic semicolon insertion ────────────────────
check 4200 "return+newline → undefined" '"js-undefined"'
check 4201 "return+space+val → val" '42'
check 4202 "nl-before flag set after newline" 'true'
check 4203 "nl-before flag false on same line" 'false'
check 4300 "var decl program-level" '5'
check 4301 "var hoisted before use → undef" '"js-undefined"'
check 4302 "var in function body" '7'
check 4303 "var then set in function" '3'
TOTAL=$((PASS + FAIL)) TOTAL=$((PASS + FAIL))
if [ $FAIL -eq 0 ]; then if [ $FAIL -eq 0 ]; then
echo "$PASS/$TOTAL JS-on-SX tests passed" echo "$PASS/$TOTAL JS-on-SX tests passed"

View File

@@ -1,81 +1,39 @@
{ {
"totals": { "totals": {
"pass": 162, "pass": 66,
"fail": 128, "fail": 25,
"skip": 1597, "skip": 1130,
"timeout": 10, "timeout": 9,
"total": 1897, "total": 1230,
"runnable": 300, "runnable": 100,
"pass_rate": 54.0 "pass_rate": 66.0
}, },
"categories": [ "categories": [
{
"category": "built-ins/Math",
"total": 327,
"pass": 43,
"fail": 56,
"skip": 227,
"timeout": 1,
"pass_rate": 43.0,
"top_failures": [
[
"TypeError: not a function",
36
],
[
"Test262Error (assertion failed)",
20
],
[
"Timeout",
1
]
]
},
{
"category": "built-ins/Number",
"total": 340,
"pass": 77,
"fail": 19,
"skip": 240,
"timeout": 4,
"pass_rate": 77.0,
"top_failures": [
[
"Test262Error (assertion failed)",
19
],
[
"Timeout",
4
]
]
},
{ {
"category": "built-ins/String", "category": "built-ins/String",
"total": 1223, "total": 1223,
"pass": 42, "pass": 66,
"fail": 53, "fail": 25,
"skip": 1123, "skip": 1123,
"timeout": 5, "timeout": 9,
"pass_rate": 42.0, "pass_rate": 66.0,
"top_failures": [ "top_failures": [
[ [
"Test262Error (assertion failed)", "Test262Error (assertion failed)",
44 14
], ],
[ [
"Timeout", "Timeout",
5 9
],
[
"TypeError: not a function",
6
], ],
[ [
"ReferenceError (undefined symbol)", "ReferenceError (undefined symbol)",
2 2
], ],
[
"Unhandled: Not callable: {:__proto__ {:toLowerCase <lambda(&rest, args)",
2
],
[ [
"Unhandled: Not callable: \\\\\\", "Unhandled: Not callable: \\\\\\",
2 2
@@ -96,24 +54,20 @@
"top_failure_modes": [ "top_failure_modes": [
[ [
"Test262Error (assertion failed)", "Test262Error (assertion failed)",
83 14
],
[
"TypeError: not a function",
36
], ],
[ [
"Timeout", "Timeout",
10 9
],
[
"TypeError: not a function",
6
], ],
[ [
"ReferenceError (undefined symbol)", "ReferenceError (undefined symbol)",
2 2
], ],
[
"Unhandled: Not callable: {:__proto__ {:toLowerCase <lambda(&rest, args)",
2
],
[ [
"Unhandled: Not callable: \\\\\\", "Unhandled: Not callable: \\\\\\",
2 2
@@ -121,17 +75,9 @@
[ [
"SyntaxError (parse/unsupported syntax)", "SyntaxError (parse/unsupported syntax)",
1 1
],
[
"Unhandled: Not callable: {:__proto__ {:valueOf <lambda()> :propertyIsEn",
1
],
[
"Unhandled: js-transpile-binop: unsupported op: >>>\\",
1
] ]
], ],
"pinned_commit": "d5e73fc8d2c663554fb72e2380a8c2bc1a318a33", "pinned_commit": "d5e73fc8d2c663554fb72e2380a8c2bc1a318a33",
"elapsed_seconds": 274.5, "elapsed_seconds": 157.9,
"workers": 1 "workers": 1
} }

View File

@@ -1,47 +1,31 @@
# test262 scoreboard # test262 scoreboard
Pinned commit: `d5e73fc8d2c663554fb72e2380a8c2bc1a318a33` Pinned commit: `d5e73fc8d2c663554fb72e2380a8c2bc1a318a33`
Wall time: 274.5s Wall time: 157.9s
**Total:** 162/300 runnable passed (54.0%). Raw: pass=162 fail=128 skip=1597 timeout=10 total=1897. **Total:** 66/100 runnable passed (66.0%). Raw: pass=66 fail=25 skip=1130 timeout=9 total=1230.
## Top failure modes ## Top failure modes
- **83x** Test262Error (assertion failed) - **14x** Test262Error (assertion failed)
- **36x** TypeError: not a function - **9x** Timeout
- **10x** Timeout - **6x** TypeError: not a function
- **2x** ReferenceError (undefined symbol) - **2x** ReferenceError (undefined symbol)
- **2x** Unhandled: Not callable: {:__proto__ {:toLowerCase <lambda(&rest, args)
- **2x** Unhandled: Not callable: \\\ - **2x** Unhandled: Not callable: \\\
- **1x** SyntaxError (parse/unsupported syntax) - **1x** SyntaxError (parse/unsupported syntax)
- **1x** Unhandled: Not callable: {:__proto__ {:valueOf <lambda()> :propertyIsEn
- **1x** Unhandled: js-transpile-binop: unsupported op: >>>\
## Categories (worst pass-rate first, min 10 runnable) ## Categories (worst pass-rate first, min 10 runnable)
| Category | Pass | Fail | Skip | Timeout | Total | Pass % | | Category | Pass | Fail | Skip | Timeout | Total | Pass % |
|---|---:|---:|---:|---:|---:|---:| |---|---:|---:|---:|---:|---:|---:|
| built-ins/String | 42 | 53 | 1123 | 5 | 1223 | 42.0% | | built-ins/String | 66 | 25 | 1123 | 9 | 1223 | 66.0% |
| built-ins/Math | 43 | 56 | 227 | 1 | 327 | 43.0% |
| built-ins/Number | 77 | 19 | 240 | 4 | 340 | 77.0% |
## Per-category top failures (min 10 runnable, worst first) ## Per-category top failures (min 10 runnable, worst first)
### built-ins/String (42/100 — 42.0%) ### built-ins/String (66/100 — 66.0%)
- **44x** Test262Error (assertion failed) - **14x** Test262Error (assertion failed)
- **5x** Timeout - **9x** Timeout
- **6x** TypeError: not a function
- **2x** ReferenceError (undefined symbol) - **2x** ReferenceError (undefined symbol)
- **2x** Unhandled: Not callable: {:__proto__ {:toLowerCase <lambda(&rest, args)
- **2x** Unhandled: Not callable: \\\ - **2x** Unhandled: Not callable: \\\
### built-ins/Math (43/100 — 43.0%)
- **36x** TypeError: not a function
- **20x** Test262Error (assertion failed)
- **1x** Timeout
### built-ins/Number (77/100 — 77.0%)
- **19x** Test262Error (assertion failed)
- **4x** Timeout

View File

@@ -295,6 +295,11 @@
(list (js-sym "js-undefined?") (js-sym "_a"))) (list (js-sym "js-undefined?") (js-sym "_a")))
(js-transpile r) (js-transpile r)
(js-sym "_a")))) (js-sym "_a"))))
((= op ">>>")
(list
(js-sym "js-unsigned-rshift")
(js-transpile l)
(js-transpile r)))
(else (error (str "js-transpile-binop: unsupported op: " op)))))) (else (error (str "js-transpile-binop: unsupported op: " op))))))
;; ── Object literal ──────────────────────────────────────────────── ;; ── Object literal ────────────────────────────────────────────────
@@ -486,6 +491,51 @@
(append inits (list (js-transpile body)))))))) (append inits (list (js-transpile body))))))))
(list (js-sym "fn") param-syms body-tr)))) (list (js-sym "fn") param-syms body-tr))))
(define
js-collect-var-decl-names
(fn
(decls)
(cond
((empty? decls) (list))
((js-tag? (first decls) "js-vardecl")
(cons
(nth (first decls) 1)
(js-collect-var-decl-names (rest decls))))
(else (js-collect-var-decl-names (rest decls))))))
(define
js-collect-var-names
(fn
(stmts)
(cond
((empty? stmts) (list))
((and (list? (first stmts)) (js-tag? (first stmts) "js-var") (= (nth (first stmts) 1) "var"))
(append
(js-collect-var-decl-names (nth (first stmts) 2))
(js-collect-var-names (rest stmts))))
(else (js-collect-var-names (rest stmts))))))
(define
js-dedup-names
(fn
(names seen)
(cond
((empty? names) (list))
((some (fn (s) (= s (first names))) seen)
(js-dedup-names (rest names) seen))
(else
(cons
(first names)
(js-dedup-names (rest names) (cons (first names) seen)))))))
(define
js-var-hoist-forms
(fn
(names)
(map
(fn (name) (list (js-sym "define") (js-sym name) :js-undefined))
names)))
(define (define
js-transpile-tpl js-transpile-tpl
(fn (fn
@@ -876,7 +926,7 @@
(fn (fn
(stmts) (stmts)
(let (let
((hoisted (js-collect-funcdecls stmts))) ((hoisted (append (js-var-hoist-forms (js-dedup-names (js-collect-var-names stmts) (list))) (js-collect-funcdecls stmts))))
(let (let
((rest-stmts (js-transpile-stmt-list stmts))) ((rest-stmts (js-transpile-stmt-list stmts)))
(cons (js-sym "begin") (append hoisted rest-stmts)))))) (cons (js-sym "begin") (append hoisted rest-stmts))))))
@@ -1297,7 +1347,7 @@
(if (if
(and (list? body) (js-tag? body "js-block")) (and (list? body) (js-tag? body "js-block"))
(let (let
((hoisted (js-collect-funcdecls (nth body 1)))) ((hoisted (append (js-var-hoist-forms (js-dedup-names (js-collect-var-names (nth body 1)) (list))) (js-collect-funcdecls (nth body 1)))))
(append hoisted (js-transpile-stmt-list (nth body 1)))) (append hoisted (js-transpile-stmt-list (nth body 1))))
(list (js-transpile body))))) (list (js-transpile body)))))
(list (list
@@ -1333,7 +1383,7 @@
(if (if
(and (list? body) (js-tag? body "js-block")) (and (list? body) (js-tag? body "js-block"))
(let (let
((hoisted (js-collect-funcdecls (nth body 1)))) ((hoisted (append (js-var-hoist-forms (js-dedup-names (js-collect-var-names (nth body 1)) (list))) (js-collect-funcdecls (nth body 1)))))
(append hoisted (js-transpile-stmt-list (nth body 1)))) (append hoisted (js-transpile-stmt-list (nth body 1))))
(list (js-transpile body))))) (list (js-transpile body)))))
(list (list

View File

@@ -1,96 +0,0 @@
# HS conformance — blockers drain
Goal: take hyperscript conformance from **1277/1496 (85.4%)** to **1496/1496 (100%)** by clearing the blocked clusters and the design-done Bucket E subsystems.
This plan exists because the per-iteration `loops/hs` agent can't fit these into its 30-min budget — they need dedicated multi-commit sit-downs. Track progress here; refer to `plans/hs-conformance-to-100.md` for the canonical cluster ledger.
## Current state (2026-04-25)
- Loop running in `/root/rose-ash-loops/hs` (branch `loops/hs`)
- sx-tree MCP **fixed** (was a session-stale binary issue — restart of claude in the tmux window picked it up). Loop hinted to retry **#32**, **#29** first.
- Recent loop progress: ~1 commit/6h — easy wins drained, what's left needs focused attention.
## Remaining work
### Bucket-A/B/C blockers (small, in-place fixes)
| # | Cluster | Tests | Effort | Blocker | Fix sketch |
|---|---------|------:|--------|---------|------------|
| **17** | `tell` semantics | +3 | ~1h | Implicit-default-target ambiguity. `bare add .bar` inside `tell X` should target `X` but explicit `to me` must reach the original element. | Add `beingTold` symbol distinct from `me`; bare commands compile to `beingTold-or-me`; explicit `me` always the original. |
| **22** | window global fn fallback | +2-4 | ~1h | `foo()` where `foo` isn't SX-defined needs to fall back to `(host-global "foo")`. Three attempts failed: guard (host-level error not catchable), `env-has?` (not in HS kernel), `hs-win-call` (NativeFn not callable from CALL). | Add `symbol-bound?` predicate to HS kernel **OR** a host-call-fn primitive with arity-agnostic dispatch. |
| **29** | `hyperscript:before:init` / `:after:init` / `:parse-error` events | +4-6 | ~30m (post sx-tree fix) | Was sx-tree MCP outage. Now unblocked — loop should retry. 4 of 6 tests need stricter parser error-rejection (out of scope; mark partial). | Edit `integration.sx` to fire DOM events at activation boundaries. |
### Bucket D — medium features
| # | Cluster | Tests | Effort | Status |
|---|---------|------:|--------|--------|
| **31** | runtime null-safety error reporting | **+15-18** | **2-4h** | **THIS SESSION'S TARGET.** Plan node fully spec'd: 5 pieces of work. |
| **32** | MutationObserver mock + `on mutation` | +10-15 | ~2h | Was sx-tree-blocked. Now unblocked — loop hinted to retry. Multi-file: parser, compiler, runtime, runner mock, generator skip-list. |
| **33** | cookie API | +2 (remaining) | ~30m | Partial done (+3). Remaining 2 need `hs-method-call` runtime fallback for unknown methods + `hs-for-each` recognising host-array/proxy collections. |
| 34 | event modifier DSL | +6-8 | ~1-2h | `elsewhere`, `every`, count filters (`once`/`twice`/`3 times`/ranges), `from elsewhere`. Pending. |
| 35 | namespaced `def` | +3 | ~30m | Pending. |
### Bucket E — subsystems (design docs landed, multi-commit each)
Each has a design doc with a step-by-step checklist. These are 1-2 days of focused work each, not loop-fits.
| # | Subsystem | Tests | Design doc | Branch |
|---|-----------|------:|------------|--------|
| 36 | WebSocket + `socket` + RPC Proxy | +12-16 | `plans/designs/e36-websocket.md` | `worktree-agent-a9daf73703f520257` |
| 37 | Tokenizer-as-API | +16-17 | `plans/designs/e37-tokenizer-api.md` | `worktree-agent-a6bb61d59cc0be8b4` |
| 38 | SourceInfo API | +4 | `plans/designs/e38-sourceinfo.md` | `agent-e38-sourceinfo` |
| 39 | WebWorker plugin (parser-only stub) | +1 | `plans/designs/e39-webworker.md` | `hs-design-e39-webworker` |
| 40 | Real Fetch / non-2xx / before-fetch | +7 | `plans/designs/e40-real-fetch.md` | `worktree-agent-a94612a4283eaa5e0` |
### Bucket F — generator translation gaps
~25 tests SKIP'd because `tests/playwright/generate-sx-tests.py` bails with `return None`. Single dedicated generator-repair sit-down once Bucket D is drained. ~half-day.
## Order of attack
In approximate cost-per-test order:
1. **Loop self-heal** (no human work) — wait for #29, #32 to land via the running loop ⏱️ ~next 1-2 hours
2. **#31 null-safety** — biggest scoped single win, dedicated worktree agent (this session)
3. **#33 cookie API remainder** — quick partial completion
4. **#17 / #22 / #34 / #35** — small fiddly fixes, one sit-down each
5. **Bucket E** — pick one subsystem at a time. **#39 (WebWorker stub) first** — single commit, smallest. Then **#38 (SourceInfo)** — 4 commits. Then the bigger three (#36, #37, #40).
6. **Bucket F** — generator repair sweep at the end.
Estimated total to 100%: ~10-15 days of focused work, parallelisable across branches.
## Cluster #31 spec (full detail)
The plan note from `hs-conformance-to-100.md`:
> 18 tests in `runtimeErrors`. When accessing `.foo` on nil, emit a structured error with position info. One coordinated fix in the compiler emit paths for property access, function calls, set/put.
**Required pieces:**
1. **Generator-side `eval-hs-error` helper + recognizer** for `expect(await error("HS")).toBe("MSG")` blocks. In `tests/playwright/generate-sx-tests.py`.
2. **Runtime helpers** in `lib/hyperscript/runtime.sx`:
- `hs-null-error!` raising `'<sel>' is null`
- `hs-named-target` — wraps a query result with the original selector source
- `hs-named-target-list` — same for list results
3. **Compiler patches at every target-position `(query SEL)` emit** — wrap in named-target carrying the original selector source. ~17 command emit paths in `lib/hyperscript/compiler.sx`:
add, remove, hide, show, measure, settle, trigger, send, set, default, increment, decrement, put, toggle, transition, append, take.
4. **Function-call null-check** at bare `(name)`, `hs-method-call`, and `host-get` chains, deriving the leftmost-uncalled-name (`'x'` / `'x.y'`) from the parse tree.
5. **Possessive-base null-check** (`set x's y to true``'x' is null`).
**Files in scope:**
- `lib/hyperscript/runtime.sx` (new helpers)
- `lib/hyperscript/compiler.sx` (~17 emit-path edits)
- `tests/playwright/generate-sx-tests.py` (test recognizer)
- `tests/hs-run-filtered.js` (if mock helpers needed)
- `shared/static/wasm/sx/hs-runtime.sx` + `hs-compiler.sx` (WASM staging copies)
**Approach:** target-named pieces incrementally — runtime helpers first (no compiler change), then compiler emit paths in batches (group similar commands), then function-call/possessive at the end. Each batch is one commit if it lands +N tests; mark partial if it only unlocks part.
**Watch for:** smoke-range regressions (tests flipping pass→fail). Each commit: rerun smoke 0-195 and the `runtimeErrors` suite.
## Notes for future sessions
- `plans/hs-conformance-to-100.md` is the canonical cluster ledger — update it on every commit.
- `plans/hs-conformance-scoreboard.md` is the live tally — bump `Merged:` and the bucket roll-up.
- Loop has scope rule "never edit `spec/evaluator.sx` or broader SX kernel" — most fixes here stay in `lib/hyperscript/**`, `tests/`, generator. If a fix needs kernel work, surface to the user; don't merge silently.
- Cluster #22's `symbol-bound?` predicate would be a kernel addition — that's a real cross-boundary scope expansion.

View File

@@ -4,10 +4,10 @@ Live tally for `plans/hs-conformance-to-100.md`. Update after every cluster comm
``` ```
Baseline: 1213/1496 (81.1%) Baseline: 1213/1496 (81.1%)
Merged: 1330/1496 (88.9%) delta +117 Merged: 1277/1496 (85.4%) delta +64
Worktree: all landed Worktree: all landed
Target: 1496/1496 (100.0%) Target: 1496/1496 (100.0%)
Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial) Remaining: ~219 tests (cluster 29 blocked on sx-tree MCP outage + parser scope)
``` ```
## Cluster ledger ## Cluster ledger
@@ -22,7 +22,7 @@ Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
| 4 | `not` precedence over `or` | done | +3 | 4fe0b649 | | 4 | `not` precedence over `or` | done | +3 | 4fe0b649 |
| 5 | `some` selector for nonempty match | done | +1 | e7b86264 | | 5 | `some` selector for nonempty match | done | +1 | e7b86264 |
| 6 | string template `${x}` | done | +2 | 108e25d4 | | 6 | string template `${x}` | done | +2 | 108e25d4 |
| 7 | `put` hyperscript reprocessing | done | +5 | 247bd85c | | 7 | `put` hyperscript reprocessing | partial | +1 | f21eb008 |
| 8 | `select` returns selected text | done | +1 | d862efe8 | | 8 | `select` returns selected text | done | +1 | d862efe8 |
| 9 | `wait on event` basics | done | +4 | f79f96c1 | | 9 | `wait on event` basics | done | +4 | f79f96c1 |
| 10 | `swap` variable ↔ property | done | +1 | 30f33341 | | 10 | `swap` variable ↔ property | done | +1 | 30f33341 |
@@ -30,7 +30,7 @@ Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
| 12 | `show` multi-element + display retention | done | +2 | 98c957b3 | | 12 | `show` multi-element + display retention | done | +2 | 98c957b3 |
| 13 | `toggle` multi-class + timed + until-event | partial | +2 | bd821c04 | | 13 | `toggle` multi-class + timed + until-event | partial | +2 | bd821c04 |
| 14 | `unless` modifier | done | +1 | c4da0698 | | 14 | `unless` modifier | done | +1 | c4da0698 |
| 15 | `transition` query-ref + multi-prop + initial | partial | +3 | 3d352055 | | 15 | `transition` query-ref + multi-prop + initial | partial | +2 | 3d352055 |
| 16 | `send can reference sender` | done | +1 | ed8d71c9 | | 16 | `send can reference sender` | done | +1 | ed8d71c9 |
| 17 | `tell` semantics | blocked | — | — | | 17 | `tell` semantics | blocked | — | — |
| 18 | `throw` respond async/sync | done | +2 | dda3becb | | 18 | `throw` respond async/sync | done | +2 | dda3becb |
@@ -42,7 +42,7 @@ Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
| 19 | `pick` regex + indices | done | +13 | 4be90bf2 | | 19 | `pick` regex + indices | done | +13 | 4be90bf2 |
| 20 | `repeat` property for-loops + where | done | +3 | c932ad59 | | 20 | `repeat` property for-loops + where | done | +3 | c932ad59 |
| 21 | `possessiveExpression` property access via its | done | +1 | f0c41278 | | 21 | `possessiveExpression` property access via its | done | +1 | f0c41278 |
| 22 | window global fn fallback | done | +1 | d31565d5 | | 22 | window global fn fallback | blocked | | |
| 23 | `me symbol works in from expressions` | done | +1 | 0d38a75b | | 23 | `me symbol works in from expressions` | done | +1 | 0d38a75b |
| 24 | `properly interpolates values 2` | done | +1 | cb37259d | | 24 | `properly interpolates values 2` | done | +1 | cb37259d |
| 25 | parenthesized commands and features | done | +1 | d7a88d85 | | 25 | parenthesized commands and features | done | +1 | d7a88d85 |
@@ -54,50 +54,42 @@ Remaining: ~174 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
| 26 | resize observer mock + `on resize` | done | +3 | 304a52d2 | | 26 | resize observer mock + `on resize` | done | +3 | 304a52d2 |
| 27 | intersection observer mock + `on intersection` | done | +3 | 0c31dd27 | | 27 | intersection observer mock + `on intersection` | done | +3 | 0c31dd27 |
| 28 | `ask`/`answer` + prompt/confirm mock | done | +4 | 6c1da921 | | 28 | `ask`/`answer` + prompt/confirm mock | done | +4 | 6c1da921 |
| 29 | `hyperscript:before:init` / `:after:init` / `:parse-error` | partial | +2 | e01a3baa | | 29 | `hyperscript:before:init` / `:after:init` / `:parse-error` | blocked | | |
| 30 | `logAll` config | done | +1 | 64bcefff | | 30 | `logAll` config | done | +1 | 64bcefff |
### Bucket D — medium features ### Bucket D — medium features
| # | Cluster | Status | Δ | | # | Cluster | Status | Δ |
|---|---------|--------|---| |---|---------|--------|---|
| 31 | runtime null-safety error reporting | blocked | — | | 31 | runtime null-safety error reporting | pending | (+1518 est) |
| 32 | MutationObserver mock + `on mutation` | done | +7 | | 32 | MutationObserver mock + `on mutation` | pending | (+1015 est) |
| 33 | cookie API | partial | +4 | | 33 | cookie API | pending | (+5 est) |
| 34 | event modifier DSL | partial | +7 | | 34 | event modifier DSL | pending | (+68 est) |
| 35 | namespaced `def` | done | +3 | | 35 | namespaced `def` | pending | (+3 est) |
| 36b | `call` result binds to `it` | done | +1 | 35f498ec |
### Bucket E — subsystems (design docs landed, pending review + implementation) ### Bucket E — subsystems (design docs landed, pending review + implementation)
| # | Cluster | Status | Design doc | | # | Cluster | Status | Design doc |
|---|---------|--------|------------| |---|---------|--------|------------|
| 36 | WebSocket + `socket` + RPC proxy | design-done | `plans/designs/e36-websocket.md` | | 36 | WebSocket + `socket` + RPC proxy | design-done | `plans/designs/e36-websocket.md` |
| 37 | Tokenizer-as-API | done | +17 | 54b54f4e | | 37 | Tokenizer-as-API | design-done | `plans/designs/e37-tokenizer-api.md` |
| 38 | SourceInfo API | design-done | `plans/designs/e38-sourceinfo.md` | | 38 | SourceInfo API | design-done | `plans/designs/e38-sourceinfo.md` |
| 39 | WebWorker plugin | design-done | `plans/designs/e39-webworker.md` | | 39 | WebWorker plugin | design-done | `plans/designs/e39-webworker.md` |
| 40 | Fetch non-2xx / before-fetch / real response | done | +7 | d7244d1d | | 40 | Fetch non-2xx / before-fetch / real response | design-done | `plans/designs/e40-real-fetch.md` |
### Bucket F — generator translation gaps ### Bucket F — generator translation gaps
Defer until AD drain. Estimated ~25 recoverable tests. Defer until AD drain. Estimated ~25 recoverable tests.
| # | Cluster | Status | Δ | Commit |
|---|---------|--------|---|--------|
| F1 | add CSS template interpolation | done | +1 | 5a76a040 |
| F2 | empty multi-element (query→for-each) | done | +1 | 875e9ba3 |
| F3 | hs-make-object _order + assert= for dicts | done | +1 | daea2808 |
| F4 | array literal arg to JS fn (sxToJs + reduce→SX) | done | +1 | da2e6b1b |
## Buckets roll-up ## Buckets roll-up
| Bucket | Done | Partial | In-prog | Pending | Blocked | Design-done | Total | | Bucket | Done | Partial | In-prog | Pending | Blocked | Design-done | Total |
|--------|-----:|--------:|--------:|--------:|--------:|------------:|------:| |--------|-----:|--------:|--------:|--------:|--------:|------------:|------:|
| A | 12 | 4 | 0 | 0 | 1 | — | 17 | | A | 12 | 4 | 0 | 0 | 1 | — | 17 |
| B | 7 | 0 | 0 | 0 | 0 | — | 7 | | B | 6 | 0 | 0 | 0 | 1 | — | 7 |
| C | 4 | 1 | 0 | 0 | 0 | — | 5 | | C | 4 | 0 | 0 | 0 | 1 | — | 5 |
| D | 2 | 2 | 0 | 0 | 1 | — | 5 | | D | 0 | 0 | 0 | 5 | 0 | — | 5 |
| E | 2 | 0 | 0 | 0 | 0 | 3 | 5 | | E | 0 | 0 | 0 | 0 | 0 | 5 | 5 |
| F | — | — | — | ~10 | — | — | ~10 | | F | — | — | — | ~10 | — | — | ~10 |
## Maintenance ## Maintenance

View File

@@ -61,7 +61,7 @@ Orchestrator cherry-picks worktree commits onto `architecture` one at a time; re
6. **[done (+2)] string template `${x}`** — `expressions/strings / string templates work w/ props` + `w/ braces` (2 tests). Template interpolation isn't substituting property accesses. Check `hs-template` runtime. Expected: +2. 6. **[done (+2)] string template `${x}`** — `expressions/strings / string templates work w/ props` + `w/ braces` (2 tests). Template interpolation isn't substituting property accesses. Check `hs-template` runtime. Expected: +2.
7. **[done (+5)] `put` hyperscript reprocessing** — `put / properly processes hyperscript at end/start/content/symbol` (4 tests, all `Expected 42, got 40`). After a put operation, newly inserted HS scripts aren't being activated. Fix: `hs-put-at!` should `hs-boot-subtree!` on the target after DOM insertion. Expected: +4. 7. **[done (+1) — partial, 3 tests remain: inserted-button handler doesn't fire for afterbegin/innerHTML paths; might need targeted trace of hs-boot-subtree! or _setInnerHTML timing] `put` hyperscript reprocessing** — `put / properly processes hyperscript at end/start/content/symbol` (4 tests, all `Expected 42, got 40`). After a put operation, newly inserted HS scripts aren't being activated. Fix: `hs-put-at!` should `hs-boot-subtree!` on the target after DOM insertion. Expected: +4.
8. **[done (+1)] `select returns selected text`** (1 test, `hs-upstream-select`). Runtime `hs-get-selection` helper reads `window.__test_selection` stash (or falls back to real `window.getSelection().toString()`). Compiler rewrites `(ref "selection")` to `(hs-get-selection)`. Generator detects the `createRange` / `setStart` / `setEnd` / `addRange` block and emits a single `(host-set! ... __test_selection ...)` op with the resolved text slice of the target element. Expected: +1. 8. **[done (+1)] `select returns selected text`** (1 test, `hs-upstream-select`). Runtime `hs-get-selection` helper reads `window.__test_selection` stash (or falls back to real `window.getSelection().toString()`). Compiler rewrites `(ref "selection")` to `(hs-get-selection)`. Generator detects the `createRange` / `setStart` / `setEnd` / `addRange` block and emits a single `(host-set! ... __test_selection ...)` op with the resolved text slice of the target element. Expected: +1.
@@ -69,7 +69,7 @@ Orchestrator cherry-picks worktree commits onto `architecture` one at a time; re
10. **[done (+1)] `swap` variable ↔ property** — `swap / can swap a variable with a property` (1 test). Swap command doesn't handle mixed var/prop targets. Expected: +1. 10. **[done (+1)] `swap` variable ↔ property** — `swap / can swap a variable with a property` (1 test). Swap command doesn't handle mixed var/prop targets. Expected: +1.
11. **[done (+4)] `hide` strategy** — `hide / can configure hidden as default`, `can hide with custom strategy`, `can set default to custom strategy`, `hide element then show element retains original display` (4 tests). Strategy config plumbing. Expected: +3-4. 11. **[done (+3) — partial, `hide element then show element retains original display` remains; needs `on click N` count-filtered event handlers, out of scope for this cluster] `hide` strategy** — `hide / can configure hidden as default`, `can hide with custom strategy`, `can set default to custom strategy`, `hide element then show element retains original display` (4 tests). Strategy config plumbing. Expected: +3-4.
12. **[done (+2)] `show` multi-element + display retention** — `show / can show multiple elements with inline-block`, `can filter over a set of elements using the its symbol` (2 tests). Expected: +2. 12. **[done (+2)] `show` multi-element + display retention** — `show / can show multiple elements with inline-block`, `can filter over a set of elements using the its symbol` (2 tests). Expected: +2.
@@ -93,7 +93,7 @@ Orchestrator cherry-picks worktree commits onto `architecture` one at a time; re
21. **[done (+1)] `possessiveExpression` property access via its** — `possessive / can access its properties` (1 test, Expected `foo` got ``). Expected: +1. 21. **[done (+1)] `possessiveExpression` property access via its** — `possessive / can access its properties` (1 test, Expected `foo` got ``). Expected: +1.
22. **[done (+1)] window global fn fallback** — `regressions / can invoke functions w/ numbers in name` + `can refer to function in init blocks`. Added `host-call-fn` FFI primitive (commit 337c8265), `hs-win-call` runtime helper, simplified compiler emit (direct hs-win-call, no guard), `def` now also registers fn on `window[name]`. Generator: fixed `\"` escaping in hs-compile string literals. Expected: +2-4. 22. **[blocked: tried three compile-time emits — (1) guard (can't catch Undefined symbol since it's a host-level error, not an SX raise), (2) env-has? (primitive not loaded in HS kernel — `Unhandled exception: "env-has?"`), and (3) hs-win-call runtime helper (works when reached but SX can't CALL a host-handle function directly — `Not callable: {:__host_handle N}` because NativeFn is not callable here). Needs either a host-call-fn primitive with arity-agnostic dispatch OR a symbol-bound? predicate in the HS kernel.] window global fn fallback** — `regressions / can invoke functions w/ numbers in name` + unlocks several others. When calling `foo()` where `foo` isn't SX-defined, fall back to `(host-global "foo")`. Design decision: either compile-time emit `(or foo (host-global "foo"))` via a helper, or add runtime lookup in the dispatch path. Expected: +2-4.
23. **[done (+1)] `me symbol works in from expressions`** — `regressions` (1 test, Expected `Foo`). Check `from` expression compilation. Expected: +1. 23. **[done (+1)] `me symbol works in from expressions`** — `regressions` (1 test, Expected `Foo`). Check `from` expression compilation. Expected: +1.
@@ -109,23 +109,21 @@ Orchestrator cherry-picks worktree commits onto `architecture` one at a time; re
28. **[done (+4)] `ask`/`answer` + prompt/confirm mock** — `askAnswer` 4 tests. **Requires test-name-keyed mock**: first test wants `confirm → true`, second `confirm → false`, third `prompt → "Alice"`, fourth `prompt → null`. Keyed via `_current-test-name` in the runner. Expected: +4. 28. **[done (+4)] `ask`/`answer` + prompt/confirm mock** — `askAnswer` 4 tests. **Requires test-name-keyed mock**: first test wants `confirm → true`, second `confirm → false`, third `prompt → "Alice"`, fourth `prompt → null`. Keyed via `_current-test-name` in the runner. Expected: +4.
29. **[done (+2) — partial, 4 parser-error tests remain (basic parse error messages, parse-error event, EOF newline crash, evaluate-api-first-error). All require stricter parser error-rejection `add - to` currently parses silently to `(set! nil (hs-add-to! (- 0 nil) nil))`, `on click blargh end on mouseenter also_bad` parses silently to `(do (hs-on me "click" (fn (event) blargh)) (hs-on me "mouseenter" (fn (event) also_bad)))`. Plus emit-error-collection runtime + hyperscript:parse-error event with detail.errors. Larger than a single cluster budget; recommend bucket-D plan-first.] `hyperscript:before:init` / `:after:init` / `:parse-error` events** — 6 tests in `bootstrap` + `parser`. Fire DOM events at activation boundaries. Expected: +4-6. 29. **[blocked: sx-tree MCP tools returning Yojson Type_error on every file op. Can't edit integration.sx to add before:init/after:init dispatch. Also 4 of the 6 tests fundamentally require stricter parser error-rejection (add - to currently succeeds as SX expression; on click blargh end accepts blargh as symbol), which is larger than a single cluster budget.] `hyperscript:before:init` / `:after:init` / `:parse-error` events** — 6 tests in `bootstrap` + `parser`. Fire DOM events at activation boundaries. Expected: +4-6.
30. **[done (+1)] `logAll` config** — 1 test. Global config that console.log's each command. Expected: +1. 30. **[done (+1)] `logAll` config** — 1 test. Global config that console.log's each command. Expected: +1.
### Bucket D: medium features (bigger commits, plan-first) ### Bucket D: medium features (bigger commits, plan-first)
31. **[blocked: Bucket-D plan-first scope, doesn't fit one cluster budget. All 18 tests are SKIP (untranslated) — generator has no `error("HS")` helper. Required pieces: (a) generator-side `eval-hs-error` helper + recognizer for `expect(await error("HS")).toBe("MSG")` blocks; (b) runtime helpers `hs-null-error!` / `hs-named-target` / `hs-named-target-list` raising `'<sel>' is null`; (c) compiler patches at every target-position `(query SEL)` emit to wrap in named-target carrying the original selector source — that's ~17 command emit paths (add, remove, hide, show, measure, settle, trigger, send, set, default, increment, decrement, put, toggle, transition, append, take); (d) function-call null-check at bare `(name)`, `hs-method-call`, and `host-get` chains, deriving the leftmost-uncalled-name `'x'` / `'x.y'` from the parse tree; (e) possessive-base null-check (`set x's y to true``'x' is null`). Each piece is straightforward in isolation but the cross-cutting compiler change touches every emit path and needs a coordinated design pass. Recommend a dedicated design doc + multi-commit worktree like buckets E36-E40.] runtime null-safety error reporting** — 18 tests in `runtimeErrors`. When accessing `.foo` on nil, emit a structured error with position info. One coordinated fix in the compiler emit paths for property access, function calls, set/put. Expected: +15-18. 31. **[pending] runtime null-safety error reporting** — 18 tests in `runtimeErrors`. When accessing `.foo` on nil, emit a structured error with position info. One coordinated fix in the compiler emit paths for property access, function calls, set/put. Expected: +15-18.
32. **[done (+7)] MutationObserver mock + `on mutation` dispatch** — 7 tests in `on`. Add MO mock to runner. Compile `on mutation [of attribute/childList/attribute-specific]`. Expected: +10-15. 32. **[pending] MutationObserver mock + `on mutation` dispatch** — 15 tests in `on`. Add MO mock to runner. Compile `on mutation [of attribute/childList/attribute-specific]`. Expected: +10-15.
33. **[done (+4) — partial, 1 test remains: `iterate cookies values work` needs `hs-for-each` to recognise host-array/proxy collections (currently `(list? collection)` returns false for the JS Proxy so the loop body never runs). Out of scope.] cookie API** — 5 tests in `expressions/cookies`. `document.cookie` mock in runner + `the cookies` + `set the xxx cookie` keywords. Expected: +5. 33. **[pending] cookie API** — 5 tests in `expressions/cookies`. `document.cookie` mock in runner + `the cookies` + `set the xxx cookie` keywords. Expected: +5.
34. **[done (+7) — partial, 1 test remains: `every` keyword multi-handler-execute test needs handler-queue semantics where `wait for X` doesn't block subsequent invocations of the same handler — current `hs-on-every` shares the same dom-listen plumbing as `hs-on` and queues events implicitly via JS event loop, so the third synthetic click waits for the prior handler's `wait for customEvent` to settle. Out of single-cluster scope.] event modifier DSL** — 8 tests in `on`. `elsewhere`, `every`, `first click`, count filters (`once / twice / 3 times`, ranges), `from elsewhere`. Expected: +6-8. 34. **[pending] event modifier DSL** — 8 tests in `on`. `elsewhere`, `every`, `first click`, count filters (`once / twice / 3 times`, ranges), `from elsewhere`. Expected: +6-8.
35. **[done (+3)] namespaced `def`** — 3 tests. `def ns.foo() ...` creates `ns.foo`. Expected: +3. 35. **[pending] namespaced `def`** — 3 tests. `def ns.foo() ...` creates `ns.foo`. Expected: +3.
36b. **[done (+1)] `call` result binds to `it`** — `call / call functions that return promises are waited on` (1 test). `call X then put it into Y` wasn't setting `it` because the `call` compiler branch emitted the call expression directly without `emit-set`. Fixed by wrapping in `emit-set (quote the-result) call-expr`. Expected: +1.
### Bucket E: subsystems (DO NOT LOOP — human-driven) ### Bucket E: subsystems (DO NOT LOOP — human-driven)
@@ -133,13 +131,13 @@ All five have design docs on their own worktree branches pending review + merge.
36. **[design-done, pending review — `plans/designs/e36-websocket.md` on `worktree-agent-a9daf73703f520257`] WebSocket + `socket`** — 16 tests. Upstream shape is `socket NAME URL [with timeout N] [on message [as JSON] …] end` with an **implicit `.rpc` Proxy** (ES6 Proxy lives in JS, not SX), not `with proxy { send, receive }` as this row previously claimed. Design doc has 8-commit checklist, +1216 delta estimate. Ship only with intentional design review. 36. **[design-done, pending review — `plans/designs/e36-websocket.md` on `worktree-agent-a9daf73703f520257`] WebSocket + `socket`** — 16 tests. Upstream shape is `socket NAME URL [with timeout N] [on message [as JSON] …] end` with an **implicit `.rpc` Proxy** (ES6 Proxy lives in JS, not SX), not `with proxy { send, receive }` as this row previously claimed. Design doc has 8-commit checklist, +1216 delta estimate. Ship only with intentional design review.
37. **[done +17]** Tokenizer-as-API — `hs-tokens-of` / `hs-stream-token` / `hs-token-type` / `hs-token-value` / `hs-token-op?`; type-map + normalize; `read-number` dot-stop fix; `\$` template escape in compiler + runtime; generator pattern in `generate-sx-tests.py`. 17/17. 37. **[design-done, pending review — `plans/designs/e37-tokenizer-api.md` on `worktree-agent-a6bb61d59cc0be8b4`] Tokenizer-as-API** 17 tests. Expose tokens as inspectable SX data via `hs-tokens-of` / `hs-stream-token` / `hs-token-type` etc; type-map current `hs-tokenize` output to upstream SCREAMING_SNAKE_CASE. 8-step checklist, +1617 delta.
38. **[design-done, pending review — `plans/designs/e38-sourceinfo.md` on `agent-e38-sourceinfo`] SourceInfo API** — 4 tests. Inline span-wrapper strategy (not side-channel dict) with compiler-entry unwrap. 4-commit plan. 38. **[design-done, pending review — `plans/designs/e38-sourceinfo.md` on `agent-e38-sourceinfo`] SourceInfo API** — 4 tests. Inline span-wrapper strategy (not side-channel dict) with compiler-entry unwrap. 4-commit plan.
39. **[design-done, pending review — `plans/designs/e39-webworker.md` on `hs-design-e39-webworker`] WebWorker plugin** — 1 test. Parser-only stub that errors with a link to upstream docs; no runtime, no mock Worker class. Hand-write the test (don't patch the generator). Single commit. 39. **[design-done, pending review — `plans/designs/e39-webworker.md` on `hs-design-e39-webworker`] WebWorker plugin** — 1 test. Parser-only stub that errors with a link to upstream docs; no runtime, no mock Worker class. Hand-write the test (don't patch the generator). Single commit.
40. **[done +7 — d7244d1d] Fetch non-2xx / before-fetch event / real response object** — 7 tests. SX-dict Response wrapper `{:_hs-response :ok :status :url :_body :_json :_html}`; restructured `hs-fetch` that always fetches wrapper then converts by format; test-name-keyed `_fetchScripts`. 11-step checklist. Watch for regression on cluster-1 JSON unwrap. 40. **[design-done, pending review — `plans/designs/e40-real-fetch.md` on `worktree-agent-a94612a4283eaa5e0`] Fetch non-2xx / before-fetch event / real response object** — 7 tests. SX-dict Response wrapper `{:_hs-response :ok :status :url :_body :_json :_html}`; restructured `hs-fetch` that always fetches wrapper then converts by format; test-name-keyed `_fetchScripts`. 11-step checklist. Watch for regression on cluster-1 JSON unwrap.
### Bucket F: generator translation gaps (after bucket A-D) ### Bucket F: generator translation gaps (after bucket A-D)
@@ -177,62 +175,8 @@ Many tests are `SKIP (untranslated)` because `tests/playwright/generate-sx-tests
## Progress log ## Progress log
### 2026-04-26 — Bucket F: array literal arg to JS fn (+1)
- **da2e6b1b** — `HS Bucket F: array literal arg to JS fn fix (+1 test)`. Two-part fix: (a) `generate-sx-tests.py` `js_expr_to_sx` now translates `arr.reduce(fn, init)``(reduce fn init arr)`, `.map(fn)``(map fn arr)`, `.filter(fn)``(filter fn arr)` so SX list arguments work with JS array HO methods. (b) `host-call-fn` in `hs-run-filtered.js` adds `sxToJs` recursive converter that unwraps SX list `._type==='list'` to native JS arrays before calling native JS functions. Together these fix functionCalls "can pass an array literal as an argument". Suite hs-upstream-expressions/functionCalls: 8/12 (unchanged SKIP ratio). Test 597: 0/1 → 1/1. Smoke 0-195: 175/195 unchanged.
### 2026-04-26 — Bucket F: hs-make-object _order + assert= for dicts (+1)
- **daea2808** — `HS Bucket F: fix hs-make-object _order + assert= for dicts (+1 test)`. Two-part fix: (a) `runtime.sx` `hs-make-object` no longer appends `_order` key to HS object literals — V8's native string-key insertion order is sufficient, and the hidden key was breaking structural equality. (b) `generate-sx-tests.py` `emit_eval` now detects when `expected_sx` contains `{` (dict syntax) and emits `assert-equal` (which uses `equal?` for deep structural equality) instead of `assert=` (which uses `=`, reference equality for dicts). Together these fix arrayLiteral "arrays containing objects work". Suite hs-upstream-expressions/arrayLiteral: 7/8 → 8/8. Smoke 0-195 unchanged at 175/195.
### 2026-04-26 — Bucket F: empty multi-element fix (+1)
- **875e9ba3** — `HS: empty multi-element fix (+1 test)`. `empty .class` compiled `(empty-target (query ".class"))` through `hs-to-sx``(hs-empty-target! (hs-query-first ".class"))` which only emptied the first match. Fix: detect `(query ...)` target in the `empty-target` compiler case and emit `(for-each (fn (_el) (hs-empty-target! _el)) (hs-query-all sel))`, mirroring the `add-class` pattern. Suite hs-upstream-empty: 12/13 → 13/13. Smoke 0-195: 175/195 unchanged.
### 2026-04-26 — Bucket F: add CSS template interpolation (+1)
- **5a76a040** — `HS: add CSS template interpolation fix (+1 test)`. `add {color: ${}{"red"}}` uses two consecutive brace groups: the empty `${}` marker followed by `{"red"}` for the actual value. The prior parser fix called `parse-expr` when already at the closing `}` of the empty group, returning nil. Fix: detect the empty-brace case (`brace-open` → immediately `brace-close`), skip it, then read the actual value from the next `{…}` block. Also handles normal `${expr}` correctly. Suite hs-upstream-add: 17/19 → 18/19. Smoke 0-195: 174/195 → 175/195.
### 2026-04-26 — cluster 36b call result binds to it (done +1)
- **35f498ec** — `hs: call command binds result to it via emit-set (+1 test)`. `call X then put it into Y` compiled `call X` without `emit-set`, so `it` remained nil. Wrapped call-expr in `emit-set (quote the-result) ...` so both `it` and `the-result` are updated. Suite hs-upstream-call: 5/6 → 6/6. Smoke 0-195: 173/195 → 174/195.
### 2026-04-26 — cluster 7 put hyperscript reprocessing (done, final +1)
- **247bd85c** — `hs: register promiseAString/promiseAnInt as sync test fixtures (+1 test)`. Upstream test "waits on promises" calls `promiseAString()` via window global. OCaml run_tests.ml registers these as NativeFns returning "foo"/"42" synchronously; JS runner had no equivalent. Added `globalThis.promiseAString = () => 'foo'` and `globalThis.promiseAnInt = () => 42` to hs-run-filtered.js. Suite hs-upstream-put: 37/38 → 38/38 (fully done). Smoke 0-195: 173/195 unchanged.
### 2026-04-26 — cluster 7 put hyperscript reprocessing (partial +3 more)
- **d663c91f** — `hs: stop event propagation after each hs-on handler fires (+3 tests)`. Root cause: click events bubble from b1 (inside d1) to d1, causing d1's `on click put ...` handler to re-fire and replace the just-modified b1 with fresh content (text=40). Fix: `hs-on`'s wrapped handler now calls `event.stopPropagation()` after each handler runs, preventing the bubbled click from reaching ancestor HS listeners. Tests 1147/1149/1150 now pass. Suite hs-upstream-put: 34/38 → 37/38. Smoke 0-195: 173/195 unchanged. One test remains: "waits on promises" (async/Promise issue).
(Reverse chronological — newest at top.) (Reverse chronological — newest at top.)
### 2026-04-25 — Bucket F: in-expression filter semantics (+1)
- **67a5f137** — `HS: in-expression filter semantics (+1 test)`. `1 in [1, 2, 3]` was returning boolean `true` instead of the filtered list `(list 1)`. Root cause: `in?` compiled to `hs-contains?` which returns boolean for scalar items. Fix: (a) `runtime.sx` adds `hs-in?` returning filtered list for all cases, plus `hs-in-bool?` which wraps with `(not (hs-falsy? ...))` for boolean contexts; (b) `compiler.sx` changes `in?` clause to emit `(hs-in? collection item)` and adds new `in-bool?` clause emitting `(hs-in-bool? collection item)`; (c) `parser.sx` changes `is in` and `am in` comparison forms to produce `in-bool?` so those stay boolean. Suite hs-upstream-expressions/in: 8/9 → 9/9. Smoke 0-195: 173/195 unchanged.
### 2026-04-25 — cluster 22 window global fn fallback (+1)
- **d31565d5** — `HS cluster 22: simplify win-call emit + def→window + init-blocks test (+1)`. Two-part change building on 337c8265 (host-call-fn FFI + hs-win-call runtime). (a) `compiler.sx` removes the guard wrapper from bare-call and method-call `hs-win-call` emit paths — direct `(hs-win-call name (list args))` is sufficient since hs-win-call returns nil for unknown names; `def` compilation now also emits `(host-set! (host-global "window") name fn)` so every HS-defined function is reachable via window lookup. (b) `generate-sx-tests.py` fixes a quoting bug: `\"here\"` was being embedded as three SX nodes (`""` + symbol + `""`) instead of a single escaped-quote string; fixed with `\\\"` escaping. Hand-rolled deftest for `can refer to function in init blocks` now passes. Suite hs-upstream-core/regressions: 13/16 → 14/16. Smoke 0-195: 172/195 → 173/195.
### 2026-04-25 — cluster 11/33 followups: hide strategy + cookie clear (+2)
- **5ff2b706** — `HS: cluster 11/33 followups (+2 tests)`. Three orthogonal fixes that pick up tests now unblocked by earlier work. (a) `parser.sx` `parse-hide-cmd`/`parse-show-cmd`: added `on` to the keyword set that flips the implicit-`me` target. Previously `on click 1 hide on click 2 show` silently parsed as `(hs-hide! nil ...)` because `parse-expr` started consuming `on` and returned nil; now hide/show recognise a sibling feature and default to `me`. (b) `runtime.sx` `hs-method-call` fallback for non-built-in methods: SX-callables (lambdas) call via `apply`, JS-native functions (e.g. `cookies.clear`) dispatch via `(apply host-call (cons obj (cons method args)))` so the native receives the args list. (c) Generator `hs-cleanup!` body wrapped in `begin` (fn body evaluates only the last expr) and now resets `hs-set-default-hide-strategy! nil` + `hs-set-log-all! false` between tests — the prior `can set default to custom strategy` cluster-11 test had been leaking `_hs-default-hide-strategy` into the rest of the suite, breaking `hide element then show element retains original display`. New cluster-33 hand-roll for `basic clear cookie values work` exercises the method-call fallback. Suite hs-upstream-hide: 15/16 → 16/16. Suite hs-upstream-expressions/cookies: 3/5 → 4/5. Smoke 0-195 unchanged at 172/195.
### 2026-04-25 — cluster 35 namespaced def + script-tag globals (+3)
- **122053ed** — `HS: namespaced def + script-tag global functions (+3 tests)`. Two-part change: (a) `runtime.sx` `hs-method-call` gains a fallback for unknown methods — `(let ((fn-val (host-get obj method))) (if (callable? fn-val) (apply fn-val args) nil))`. This lets `utils.foo()` dispatch through `(host-get utils "foo")` when `utils` is an SX dict whose `foo` is an SX lambda. (b) Generator hand-rolls 3 deftests since the SX runtime has no `<script type='text/hyperscript'>` tag boot. For `is called synchronously` / `can call asynchronously`: `(eval-expr-cek (hs-to-sx (first (hs-parse (hs-tokenize "def foo() ... end")))))` registers the function in the global eval env (eval-expr-cek processes `(define foo (fn ...))` at top scope), then a click div is built via dom-set-attr + hs-boot-subtree!. For `functions can be namespaced`: define `utils` as a dict, register `__utils_foo` as a fresh-named global def, then `(host-set! utils "foo" __utils_foo)` populates the dict; click handler `call utils.foo()` compiles to `(hs-method-call utils "foo")` which now dispatches through the new runtime fallback. Skip-list cleared of the 3 def entries. Suite hs-upstream-def: 24/27 → 27/27. Smoke 0-195 unchanged at 172/195.
### 2026-04-25 — cluster 34 elsewhere / from-elsewhere modifier (+2)
- **3044a168** — `HS: elsewhere / from elsewhere modifier (+2 tests)`. Three-part change: (a) `parser.sx` `parse-on-feat` parses an optional `elsewhere` (or `from elsewhere`) modifier between event-name and source. The `from elsewhere` variant uses a one-token lookahead so plain `from #target` keeps parsing as a source expression. Emits `:elsewhere true` part. (b) `compiler.sx` `scan-on` threads `elsewhere?` (10th param) through every recursive call + new `:elsewhere` cond branch. The dispatch case becomes a 3-way `cond` over target: elsewhere → `(dom-body)` (listener attaches to body and bubble sees every click), source → from-source, default → `me`. The `compiled-body` build is wrapped with `(when (not (host-call me "contains" (host-get event "target"))) BODY)` so handlers fire only on outside-of-`me` clicks. (c) Generator drops `supports "elsewhere" modifier` and `supports "from elsewhere" modifier` from `SKIP_TEST_NAMES`. Suite hs-upstream-on: 48/70 → 50/70. Smoke 0-195 unchanged at 172/195.
### 2026-04-25 — cluster 34 count-filtered events + first modifier (+5 partial)
- **19c97989** — `HS: count-filtered events + first modifier (+5 tests)`. Three-part change: (a) `parser.sx` `parse-on-feat` accepts `first` keyword before event-name (sets `cnt-min/max=1`), then optionally parses a count expression after event-name: bare number = exact count, `N to M` = inclusive range, `N and on` = unbounded above. Number tokens coerced via `parse-number`. New parts entry `:count-filter {"min" N "max" M-or--1}`. (b) `compiler.sx` `scan-on` gains a 9th `count-filter-info` param threaded through every recursive call + a new `:count-filter` cond branch. The handler binding now wraps the `(fn (event) BODY)` in `(let ((__hs-count 0)) (fn (event) (begin (set! __hs-count (+ __hs-count 1)) (when COUNT-CHECK BODY))))` when count info is present. Each `on EVENT N ...` clause produces its own closure-captured counter, so `on click 1` / `on click 2` / `on click 3` fire on their respective Nth click (mix-ranges test). (c) Generator drops 5 entries from `SKIP_TEST_NAMES``can filter events based on count`/`...count range`/`...unbounded count range`/`can mix ranges`/`on first click fires only once`. Suite hs-upstream-on: 43/70 → 48/70. Smoke 0-195 unchanged at 172/195. Remaining cluster-34 work (`elsewhere`/`from elsewhere`/`every`-keyword multi-handler) is independent from count filters and would need a separate iteration.
### 2026-04-25 — cluster 29 hyperscript init events (+2 partial)
- **e01a3baa** — `HS: hyperscript:before:init / :after:init events (+2 tests)`. `integration.sx` `hs-activate!` now wraps the activation block in `(when (dom-dispatch el "hyperscript:before:init" nil) ...)``dom-dispatch` builds a CustomEvent with `bubbles:true`, the mock El's `cancelable` defaults to true, `dispatchEvent` returns `!ev.defaultPrevented`, so `when` skips the activate body if a listener called `preventDefault()`. After activation completes successfully it dispatches `hyperscript:after:init`. Generator (`tests/playwright/generate-sx-tests.py`) gains two hand-rolled deftests: `fires hyperscript:before:init and hyperscript:after:init` builds a wa container, attaches listeners that append to a captured `events` list, sets innerHTML to a div with `_=`, calls `hs-boot-subtree!`, asserts the events list. `hyperscript:before:init can cancel initialization` attaches a preventDefault listener and asserts `data-hyperscript-powered` is absent on the inner div after boot. Suite hs-upstream-core/bootstrap: 20/26 → 22/26. Smoke 0-195: 170 → 172. Remaining 4 cluster-29 tests (basic parse error messages, parse-error event, EOF newline, eval-API throws on first error) all need stricter parser error-rejection plus a parse-error collector — recommend bucket-D plan-first multi-commit, not a single iteration.
### 2026-04-25 — cluster 32 MutationObserver mock + on mutation dispatch (+7)
- **13e02542** — `HS: MutationObserver mock + on mutation dispatch (+7 tests)`. Five-part change: (a) `parser.sx` `parse-on-feat` now consumes `of <FILTER>` after `mutation` event-name. FILTER is one of `attributes`/`childList`/`characterData` (ident tokens) or one or more `@name` attr-tokens chained by `or`. Emits `:of-filter {"type" T "attrs" L?}` part. (b) `compiler.sx` `scan-on` threads new `of-filter-info` param; the dispatch case becomes a `cond` over `event-name` — for `"mutation"` it emits `(do on-call (hs-on-mutation-attach! target MODE ATTRS))` where ATTRS is `(cons 'list attr-list)` so the list survives compile→eval. (c) `runtime.sx` `hs-on-mutation-attach!` builds a config dict (`attributes`/`childList`/`characterData`/`subtree`/`attributeFilter`) matched to mode, constructs a real `MutationObserver(cb)`, calls `mo.observe(target, opts)`, and the cb dispatches a `"mutation"` event on target. (d) `tests/hs-run-filtered.js` replaces the no-op MO with `HsMutationObserver` (global registry, decodes SX-list `attributeFilter`); prototype hooks on `El.setAttribute/appendChild/removeChild/_setInnerHTML` fire matching observers synchronously, with `__hsMutationActive` re-entry guard so handlers that mutate the DOM don't infinite-loop. Per-test reset clears registry + flag. (e) `generate-sx-tests.py` drops 7 mutation entries from `SKIP_TEST_NAMES` and adds two body patterns: `evaluate(() => document.querySelector(SEL).setAttribute(N,V))``(dom-set-attr ...)`, and `evaluate(() => document.querySelector(SEL).appendChild(document.createElement(T)))``(dom-append … (dom-create-element …))`. Suite hs-upstream-on: 36/70 → 43/70. Smoke 0-195 unchanged at 170/195.
### 2026-04-25 — cluster 33 cookie API (partial +3)
- No `.sx` edits needed — `set cookies.foo to 'bar'` already compiles to `(dom-set-prop cookies "foo" "bar")` which becomes `(host-set! cookies "foo" "bar")` once the `dom` module is loaded, and `cookies.foo` becomes `(host-get cookies "foo")`. So a JS-only Proxy + Python generator change does the trick. Two parts: (a) `tests/hs-run-filtered.js` adds a per-test `__hsCookieStore` Map, a `globalThis.cookies` Proxy with `length`/`clear`/named-key get traps and a set trap that writes the store, and a `Object.defineProperty(document, 'cookie', …)` getter/setter that reads and writes the same store (so the upstream `length is 0` test's pre-clear loop over `document.cookie` works). Per-test reset clears the store. (b) `tests/playwright/generate-sx-tests.py` declares `(define cookies (host-global "cookies"))` in the test header and emits hand-rolled deftests for the three tractable tests (`basic set`, `update`, `length is 0`). Suite hs-upstream-expressions/cookies: 0/5 → 3/5. Smoke 0-195 unchanged at 170/195. Remaining `basic clear` and `iterate` tests need runtime.sx edits (hs-method-call fallback + hs-for-each host-array recognition) — out of scope for a JS-only iteration.
### 2026-04-25 — cluster 32 MutationObserver mock + on mutation dispatch (blocked)
- Two issues conspire: (1) `loops/hs` worktree has no pre-built sx-tree binary so MCP tools aren't loaded, and the block-sx-edit hook prevents raw `Edit`/`Read`/`Write` on `.sx` files. Built `hosts/ocaml/_build/default/bin/mcp_tree.exe` via `dune build` this iteration but tools don't surface mid-session. (2) Cluster scope is genuinely big: parser must learn `on mutation of <filter>` (currently drops body after `of` — verified via compile dump: `on mutation of attributes put "Mutated" into me``(hs-on me "mutation" (fn (event) nil))`), compiler needs `:of-filter` plumbing similar to intersection's `:having`, runtime needs `hs-on-mutation-attach!`, JS runner mock needs a real MutationObserver (currently no-op `class{observe(){}disconnect(){}}` at hs-run-filtered.js:348) plus `setAttribute`/`appendChild` instrumentation, and 7 entries removed from `SKIP_TEST_NAMES`. Recommended next step: dedicated worktree where sx-tree loads at session start, multi-commit shape (parser → compiler+attach → mock+runner → generator skip-list).
### 2026-04-25 — cluster 31 runtime null-safety error reporting (blocked)
- All 18 tests are `SKIP (untranslated)` — generator has no `error("HS")` helper at all. Inspected representative compile outputs: `add .foo to #doesntExist``(for-each ... (hs-query-all "#doesntExist"))` (silently no-ops on empty list, no error); `hide #doesntExist``(hs-hide! (hs-query-all "#doesntExist") "display")` (likewise); `put 'foo' into #doesntExist``(hs-set-inner-html! (hs-query-first "#doesntExist") "foo")` (passes nil through); `x()``(x)` (raises `Undefined symbol: x`, wrong format); `x.y.z()``(hs-method-call (host-get x "y") "z")`. Implementing this requires generator helper + 17 compiler emit-path patches + function-call/method-call/possessive-base null guards + new `hs-named-target`/`hs-named-target-list` runtime — too many surfaces for a single-iteration commit. Bucket D explicitly says "plan-first" — recommended path is a dedicated design doc and multi-commit worktree like E36-E40, not a loop iteration.
### 2026-04-24 — cluster 29 hyperscript:before:init / :after:init / :parse-error (blocked) ### 2026-04-24 — cluster 29 hyperscript:before:init / :after:init / :parse-error (blocked)
- **2b486976** — `HS-plan: mark cluster 29 blocked`. sx-tree MCP file ops returning `Yojson__Safe.Util.Type_error("Expected string, got null")` on every file-based call (sx_read_subtree, sx_find_all, sx_replace_by_pattern, sx_summarise, sx_pretty_print, sx_write_file). Only in-memory ops work (sx_eval, sx_build, sx_env). Without sx-tree I can't edit integration.sx to add before:init/after:init dispatch on hs-activate!. Investigated the 6 tests: 2 bootstrap (before/after init) need dispatchEvent wrapping activate; 4 parser tests require stricter parser error-rejection — `add - to` currently parses silently to `(set! nil (hs-add-to! (- 0 nil) nil))`, `on click blargh end on mouseenter also_bad` parses silently to `(do (hs-on me "click" (fn (event) blargh)) (hs-on me "mouseenter" (fn (event) also_bad)))`. Fundamental parser refactor is out of single-cluster budget regardless of sx-tree availability. - **2b486976** — `HS-plan: mark cluster 29 blocked`. sx-tree MCP file ops returning `Yojson__Safe.Util.Type_error("Expected string, got null")` on every file-based call (sx_read_subtree, sx_find_all, sx_replace_by_pattern, sx_summarise, sx_pretty_print, sx_write_file). Only in-memory ops work (sx_eval, sx_build, sx_env). Without sx-tree I can't edit integration.sx to add before:init/after:init dispatch on hs-activate!. Investigated the 6 tests: 2 bootstrap (before/after init) need dispatchEvent wrapping activate; 4 parser tests require stricter parser error-rejection — `add - to` currently parses silently to `(set! nil (hs-add-to! (- 0 nil) nil))`, `on click blargh end on mouseenter also_bad` parses silently to `(do (hs-on me "click" (fn (event) blargh)) (hs-on me "mouseenter" (fn (event) also_bad)))`. Fundamental parser refactor is out of single-cluster budget regardless of sx-tree availability.

View File

@@ -65,7 +65,7 @@ Each item: implement → tests → update progress. Mark `[x]` when tests green.
- [x] Punctuation: `( ) { } [ ] , ; : . ...` - [x] Punctuation: `( ) { } [ ] , ; : . ...`
- [x] Operators: `+ - * / % ** = == === != !== < > <= >= && || ! ?? ?: & | ^ ~ << >> >>> += -= ...` - [x] Operators: `+ - * / % ** = == === != !== < > <= >= && || ! ?? ?: & | ^ ~ << >> >>> += -= ...`
- [x] Comments (`//`, `/* */`) - [x] Comments (`//`, `/* */`)
- [ ] Automatic Semicolon Insertion (defer — initially require semicolons) - [x] Automatic Semicolon Insertion (defer — initially require semicolons)
### Phase 2 — Expression parser (Pratt-style) ### Phase 2 — Expression parser (Pratt-style)
- [x] Literals → AST nodes - [x] Literals → AST nodes
@@ -124,7 +124,7 @@ Each item: implement → tests → update progress. Mark `[x]` when tests green.
- [x] Closures — work via SX `fn` env capture - [x] Closures — work via SX `fn` env capture
- [x] Rest params (`...rest``&rest`) - [x] Rest params (`...rest``&rest`)
- [x] Default parameters (desugar to `if (param === undefined) param = default`) - [x] Default parameters (desugar to `if (param === undefined) param = default`)
- [ ] `var` hoisting (deferred — treated as `let` for now) - [x] `var` hoisting (shallow — collects direct `var` decls, emits `(define name :js-undefined)` before funcdecls)
- [ ] `let`/`const` TDZ (deferred) - [ ] `let`/`const` TDZ (deferred)
### Phase 8 — Objects, prototypes, `this` ### Phase 8 — Objects, prototypes, `this`
@@ -158,6 +158,20 @@ Each item: implement → tests → update progress. Mark `[x]` when tests green.
Append-only record of completed iterations. Loop writes one line per iteration: date, what was done, test count delta. Append-only record of completed iterations. Loop writes one line per iteration: date, what was done, test count delta.
- 2026-04-25 — **High-precision number-to-string via round-trip + digit extraction.** `js-big-int-str-loop` extracts decimal digits from integer-valued float. `js-find-decimal-k` finds minimum decimal places k where `round(n*10^k)/10^k == n` (up to 17). `js-format-decimal-digits` inserts decimal point. `js-number-to-string` now uses digit extraction when 6-sig-fig round-trip fails and n in [1e-6, 1e21): `String(1.0000001)="1.0000001"`, `String(1/3)="0.3333333333333333"`. String test262 subset: 58→62/100. 529/530 unit, 148/148 slice.
- 2026-04-25 — **String wrapper objects + number-to-string sci notation.** `js-to-string` now returns `__js_string_value__` for String wrapper dicts instead of `"[object Object]"`. `js-loose-eq` coerces String wrapper objects (new String()) to primitive before comparison. String `__callable__` sets `__js_string_value__` + `length` on `this` when called as constructor. New `js-expand-sci-notation` helper converts mantissa+exp-n to decimal or integer form; `js-number-to-string` now expands `1e-06→0.000001`, `1e+06→1000000`, fixes `1e21→1e+21`. String test262 subset: 45→58/100. 529/530 unit, 148/148 slice.
- 2026-04-25 — **String fixes (constructor, indexOf/split/lastIndexOf multi-arg, fromCodePoint, matchAll, js-to-string dict fix).** Added `String.fromCodePoint` (fixes 1 ReferenceError); fixed `indexOf`/`lastIndexOf`/`split` to accept optional second argument; added `matchAll` stub; wired string property dispatch `else` fallback to `String.prototype` (fixes `'a'.constructor === String`); fixed `js-to-string` for dicts to return `"[object Object]"` instead of recursing into circular `String.prototype.constructor` structure. Scoreboard: String 42→43, timeouts 32→13. Total 162→202/300 (54%→67.3%). 529/530 unit, 148/148 slice.
- 2026-04-25 — **Number/String wrapper constructor-detection fix + Array.prototype.toString + js-to-number for wrappers + `>>>` operator.** `Number.__callable__` and `String.__callable__` now check `this.__proto__ === Number/String.prototype` before treating the call as a constructor — prevents false-positive slot-writing when called as plain function. `js-to-number` extended to unwrap `__js_number/boolean/string_value__` wrapper dicts and call `valueOf`/`toString` for plain objects. `Array.prototype.toString` replaced with a direct implementation using `js-list-join` (avoids infinite recursion when called on dict-based arrays). `>>>` (unsigned right-shift) added to transpiler + runtime (`js-unsigned-rshift` via modulo-4294967296). String test262 subset: 62→66/100. 529/530 unit, 147/148 slice.
- 2026-04-25 — **Math methods (trig/log/hyperbolic/bit ops).** Added 22 missing Math methods to `runtime.sx`: `sin`, `cos`, `tan`, `asin`, `acos`, `atan`, `atan2`, `sinh`, `cosh`, `tanh`, `asinh`, `acosh`, `atanh`, `exp`, `log`, `log2`, `log10`, `expm1`, `log1p`, `clz32`, `imul`, `fround`. All use existing SX primitives. `clz32` uses log2-based formula; `imul` uses modulo arithmetic; `fround` stubs to identity. Addresses 36x "TypeError: not a function" in built-ins/Math (43% → ~79% expected). 529/530 unit (unchanged), 148/148 slice. Commit `5f38e49b`.
- 2026-04-25 — **`var` hoisting.** Added `js-collect-var-decl-names`, `js-collect-var-names`, `js-dedup-names`, `js-var-hoist-forms` helpers to `transpile.sx`. Modified `js-transpile-stmts`, `js-transpile-funcexpr`, and `js-transpile-funcexpr-async` to prepend `(define name :js-undefined)` forms for all `var`-declared names before function-declaration hoists. Shallow collection (direct statements only). 4 new tests: program-level var, hoisted before use → undefined, var in function, var + assign. 529/530 unit (+4), 148/148 slice unchanged. Commit `11315d91`.
- 2026-04-25 — **ASI (Automatic Semicolon Insertion).** Lexer: added `:nl` (newline-before) boolean to every token dict; `skip-ws!` sets it true when consuming `\n`/`\r`; `scan!` resets it to `false` at the start of each token scan. Parser: new `jp-token-nl?` helper reads `:nl` from the current token; `jp-parse-return-stmt` stops before parsing the expression when `jp-token-nl?` is true (restricted production: `return\nvalue``return undefined`). 4 new tests (flag presence, flag value, restricted return). 525/526 unit (+4), 148/148 slice unchanged. Commit `ae86579a`.
- 2026-04-23 — scaffold landed: lib/js/{lexer,parser,transpile,runtime}.sx stubs + test.sh. 7/7 smoke tests pass (js-tokenize/js-parse/js-transpile stubs + js-to-boolean coercion cases). - 2026-04-23 — scaffold landed: lib/js/{lexer,parser,transpile,runtime}.sx stubs + test.sh. 7/7 smoke tests pass (js-tokenize/js-parse/js-transpile stubs + js-to-boolean coercion cases).
- 2026-04-23 — Phase 1 (Lexer) complete: numbers (int/float/hex/exp/leading-dot), strings (escapes), idents/keywords, punctuation, all operators (1-4 char, longest-match), // and /* */ comments. 38/38 tests pass. Gotchas found: `peek` and `emit!` are primitives (shadowed to `js-peek`, `js-emit!`); `cond` clauses take ONE body only, multi-expr needs `(do ...)` wrapper. - 2026-04-23 — Phase 1 (Lexer) complete: numbers (int/float/hex/exp/leading-dot), strings (escapes), idents/keywords, punctuation, all operators (1-4 char, longest-match), // and /* */ comments. 38/38 tests pass. Gotchas found: `peek` and `emit!` are primitives (shadowed to `js-peek`, `js-emit!`); `cond` clauses take ONE body only, multi-expr needs `(do ...)` wrapper.
- 2026-04-23 — Phase 2 (Pratt expression parser) complete: literals, binary precedence (w/ `**` right-assoc), unary (`- + ! ~ typeof void`), member access (`.`/`[]`), call chains, array/object literals (ident+string+number keys), ternary, arrow fns (zero/one/many params; curried), assignment (right-assoc incl. compound `+=` etc.). AST node shapes all match the `js-*` names already wired. 47 new tests, 85/85 total. Most of the Phase 2 scaffolding was already written in an earlier session — this iteration verified every path, added the parser test suite, and greened everything on the first pass. No new gotchas beyond Phase 1. - 2026-04-23 — Phase 2 (Pratt expression parser) complete: literals, binary precedence (w/ `**` right-assoc), unary (`- + ! ~ typeof void`), member access (`.`/`[]`), call chains, array/object literals (ident+string+number keys), ternary, arrow fns (zero/one/many params; curried), assignment (right-assoc incl. compound `+=` etc.). AST node shapes all match the `js-*` names already wired. 47 new tests, 85/85 total. Most of the Phase 2 scaffolding was already written in an earlier session — this iteration verified every path, added the parser test suite, and greened everything on the first pass. No new gotchas beyond Phase 1.

File diff suppressed because it is too large Load Diff

View File

@@ -19,7 +19,6 @@
(define (define
reserved reserved
(list (list
(quote beingTold)
(quote me) (quote me)
(quote it) (quote it)
(quote event) (quote event)
@@ -66,10 +65,7 @@
(list (quote me)) (list (quote me))
(list (list
(quote let) (quote let)
(list (list (list (quote it) nil) (list (quote event) nil))
(list (quote beingTold) (quote me))
(list (quote it) nil)
(list (quote event) nil))
guarded)))))))))) guarded))))))))))
;; ── Activate a single element ─────────────────────────────────── ;; ── Activate a single element ───────────────────────────────────
@@ -77,51 +73,23 @@
;; Marks the element to avoid double-activation. ;; Marks the element to avoid double-activation.
(define (define
hs-register-scripts! hs-activate!
(fn (fn
() (el)
(for-each (let
(fn ((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
(script) (when
(when (and src (not (= src prev)))
(not (dom-get-data script "hs-script-loaded")) (hs-log-event! "hyperscript:init")
(let (dom-set-data el "hs-script" src)
((src (host-get script "innerHTML"))) (dom-set-data el "hs-active" true)
(when (dom-set-attr el "data-hyperscript-powered" "true")
(and src (not (= src ""))) (let ((handler (hs-handler src))) (handler el))))))
(guard
(_e (true nil))
(eval-expr-cek (hs-to-sx-from-source src)))
(dom-set-data script "hs-script-loaded" true)))))
(hs-query-all "script[type=text/hyperscript]"))))
;; ── Boot: scan entire document ────────────────────────────────── ;; ── Boot: scan entire document ──────────────────────────────────
;; Called once at page load. Finds all elements with _ attribute, ;; Called once at page load. Finds all elements with _ attribute,
;; compiles their hyperscript, and activates them. ;; compiles their hyperscript, and activates them.
(define
hs-activate!
(fn
(el)
(do
(hs-register-scripts!)
(let
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
(when
(and src (not (= src prev)))
(when
(dom-dispatch el "hyperscript:before:init" nil)
(hs-log-event! "hyperscript:init")
(dom-set-data el "hs-script" src)
(dom-set-data el "hs-active" true)
(dom-set-attr el "data-hyperscript-powered" "true")
(let ((handler (hs-handler src))) (handler el))
(dom-dispatch el "hyperscript:after:init" nil)))))))
;; ── Boot subtree: for dynamic content ───────────────────────────
;; Called after HTMX swaps or dynamic DOM insertion.
;; Only activates elements within the given root.
(define (define
hs-deactivate! hs-deactivate!
(fn (fn
@@ -133,6 +101,10 @@
(dom-set-data el "hs-active" false) (dom-set-data el "hs-active" false)
(dom-set-data el "hs-script" nil)))) (dom-set-data el "hs-script" nil))))
;; ── Boot subtree: for dynamic content ───────────────────────────
;; Called after HTMX swaps or dynamic DOM insertion.
;; Only activates elements within the given root.
(define (define
hs-boot! hs-boot!
(fn (fn

View File

@@ -9,11 +9,7 @@
(fn (fn
(tokens src) (tokens src)
(let (let
((tokens (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens)) ((p 0) (tok-len (len tokens)))
(p 0)
(tok-len
(len
(filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))))
(define tp (fn () (if (< p tok-len) (nth tokens p) nil))) (define tp (fn () (if (< p tok-len) (nth tokens p) nil)))
(define (define
tp-type tp-type
@@ -25,16 +21,6 @@
adv! adv!
(fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t))) (fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t)))
(define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof")))) (define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof"))))
(define cur-start (fn () (if (< p tok-len) (get (tp) "pos") 0)))
(define cur-line (fn () (if (< p tok-len) (get (tp) "line") 1)))
(define
prev-end
(fn () (if (> p 0) (get (nth tokens (- p 1)) "end") 0)))
(define
hs-ast-wrap
(fn
(raw kind start end-pos line fields)
(if hs-span-mode {:children raw :end end-pos :kind kind :line line :src src :start start :hs-ast true :fields fields} raw)))
(define (define
match-kw match-kw
(fn (fn
@@ -83,40 +69,19 @@
parse-prop-chain parse-prop-chain
(fn (fn
(base) (base)
(let (if
((base-start (if (and (dict? base) (get base :hs-ast)) (get base :start) (cur-start))) (and (= (tp-type) "class") (not (at-end?)))
(base-line (let
(if ((prop (tp-val)))
(and (dict? base) (get base :hs-ast)) (do
(get base :line) (adv!)
(cur-line)))) (parse-prop-chain (list (make-symbol ".") base prop))))
(if (if
(and (= (tp-type) "class") (not (at-end?))) (= (tp-type) "paren-open")
(let (let
((prop (tp-val))) ((args (parse-call-args)))
(do (parse-prop-chain (list (quote method-call) base args)))
(adv!) base))))
(parse-prop-chain
(hs-ast-wrap
(list (make-symbol ".") base prop)
"member"
base-start
(prev-end)
base-line
{:root base}))))
(if
(= (tp-type) "paren-open")
(let
((args (parse-call-args)))
(parse-prop-chain
(hs-ast-wrap
(list (quote method-call) base args)
"call"
base-start
(prev-end)
base-line
{:root base})))
base)))))
(define (define
parse-trav parse-trav
(fn (fn
@@ -127,23 +92,19 @@
((and (= kind (quote closest)) (= typ "ident") (= val "parent")) ((and (= kind (quote closest)) (= typ "ident") (= val "parent"))
(do (adv!) (parse-trav (quote closest-parent)))) (do (adv!) (parse-trav (quote closest-parent))))
((= typ "selector") ((= typ "selector")
(do (adv!) (list kind val (list (quote beingTold))))) (do (adv!) (list kind val (list (quote me)))))
((= typ "class") ((= typ "class")
(do (do (adv!) (list kind (str "." val) (list (quote me)))))
(adv!)
(list kind (str "." val) (list (quote beingTold)))))
((= typ "id") ((= typ "id")
(do (do (adv!) (list kind (str "#" val) (list (quote me)))))
(adv!)
(list kind (str "#" val) (list (quote beingTold)))))
((= typ "attr") ((= typ "attr")
(do (do
(adv!) (adv!)
(list (list
(quote attr) (quote attr)
val val
(list kind (str "[" val "]") (list (quote beingTold)))))) (list kind (str "[" val "]") (list (quote me))))))
(true (list kind "*" (list (quote beingTold)))))))) (true (list kind "*" (list (quote me))))))))
(define (define
parse-pos-kw parse-pos-kw
(fn (fn
@@ -163,24 +124,8 @@
(let (let
((typ (tp-type)) (val (tp-val))) ((typ (tp-type)) (val (tp-val)))
(cond (cond
((= typ "number") ((= typ "number") (do (adv!) (parse-dur val)))
(let ((= typ "string") (do (adv!) val))
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(parse-dur val)
"number"
s
(prev-end)
l
{}))))
((= typ "string")
(let
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap val "string" s (prev-end) l {}))))
((= typ "template") (do (adv!) (list (quote template) val))) ((= typ "template") (do (adv!) (list (quote template) val)))
((and (= typ "keyword") (= val "true")) (do (adv!) true)) ((and (= typ "keyword") (= val "true")) (do (adv!) true))
((and (= typ "keyword") (= val "false")) (do (adv!) false)) ((and (= typ "keyword") (= val "false")) (do (adv!) false))
@@ -245,51 +190,26 @@
((and (= typ "keyword") (= val "last")) ((and (= typ "keyword") (= val "last"))
(do (adv!) (parse-pos-kw (quote last)))) (do (adv!) (parse-pos-kw (quote last))))
((= typ "id") ((= typ "id")
(let (do (adv!) (list (quote query) (str "#" val))))
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(list (quote query) (str "#" val))
"selector"
s
(prev-end)
l
{}))))
((= typ "selector") ((= typ "selector")
(let (do
((s (cur-start)) (l (cur-line))) (adv!)
(do (if
(adv!) (and (= (tp-type) "keyword") (= (tp-val) "in"))
(hs-ast-wrap (do
(if (adv!)
(and (= (tp-type) "keyword") (= (tp-val) "in")) (list
(do (quote query-scoped)
(adv!) val
(list (parse-cmp (parse-arith (parse-poss (parse-atom))))))
(quote query-scoped) (list (quote query) val))))
val
(parse-cmp
(parse-arith (parse-poss (parse-atom))))))
(list (quote query) val))
"selector"
s
(prev-end)
l
{}))))
((= typ "attr") ((= typ "attr")
(do (do (adv!) (list (quote attr) val (list (quote me)))))
(adv!)
(list (quote attr) val (list (quote beingTold)))))
((= typ "style") ((= typ "style")
(do (do (adv!) (list (quote style) val (list (quote me)))))
(adv!)
(list (quote style) val (list (quote beingTold)))))
((= typ "local") (do (adv!) (list (quote local) val))) ((= typ "local") (do (adv!) (list (quote local) val)))
((= typ "hat") ((= typ "hat")
(do (do (adv!) (list (quote dom-ref) val (list (quote me)))))
(adv!)
(list (quote dom-ref) val (list (quote beingTold)))))
((and (= typ "keyword") (= val "dom")) ((and (= typ "keyword") (= val "dom"))
(do (do
(adv!) (adv!)
@@ -297,31 +217,10 @@
((name (tp-val))) ((name (tp-val)))
(do (do
(adv!) (adv!)
(list (quote dom-ref) name (list (quote beingTold))))))) (list (quote dom-ref) name (list (quote me)))))))
((= typ "class") ((= typ "class")
(let (do (adv!) (list (quote query) (str "." val))))
((s (cur-start)) (l (cur-line))) ((= typ "ident") (do (adv!) (list (quote ref) val)))
(do
(adv!)
(hs-ast-wrap
(list (quote query) (str "." val))
"selector"
s
(prev-end)
l
{}))))
((= typ "ident")
(let
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(list (quote ref) val)
"ref"
s
(prev-end)
l
{}))))
((= typ "paren-open") ((= typ "paren-open")
(do (do
(adv!) (adv!)
@@ -429,8 +328,6 @@
(let (let
((name val) (args (parse-call-args))) ((name val) (args (parse-call-args)))
(cons (quote call) (cons (list (quote ref) name) args))))) (cons (quote call) (cons (list (quote ref) name) args)))))
((= typ "keyword")
(do (adv!) (list (quote ref) val)))
(true nil))))) (true nil)))))
(define (define
parse-poss parse-poss
@@ -440,14 +337,6 @@
((and (= (tp-type) "op") (= (tp-val) "'s")) ((and (= (tp-type) "op") (= (tp-val) "'s"))
(do (adv!) (parse-poss-tail obj))) (do (adv!) (parse-poss-tail obj)))
((= (tp-type) "class") (parse-prop-chain obj)) ((= (tp-type) "class") (parse-prop-chain obj))
((= (tp-type) "dot")
(do
(adv!)
(let ((typ2 (tp-type)) (val2 (tp-val)))
(if
(or (= typ2 "ident") (= typ2 "keyword"))
(do (adv!) (parse-poss (list (make-symbol ".") obj val2)))
obj))))
((= (tp-type) "paren-open") ((= (tp-type) "paren-open")
(let (let
((args (parse-call-args))) ((args (parse-call-args)))
@@ -574,9 +463,7 @@
(list (list
(quote not) (quote not)
(list (quote eq-ignore-case) left right))) (list (quote eq-ignore-case) left right)))
(list (list (quote not) (list (quote =) left right)))))))
(quote not)
(list (quote hs-id=) left right)))))))
((match-kw "empty") (list (quote empty?) left)) ((match-kw "empty") (list (quote empty?) left))
((match-kw "less") ((match-kw "less")
(do (do
@@ -608,8 +495,7 @@
(quote and) (quote and)
(list (quote >=) left lo) (list (quote >=) left lo)
(list (quote <=) left hi))))) (list (quote <=) left hi)))))
((match-kw "in") ((match-kw "in") (list (quote in?) left (parse-expr)))
(list (quote in-bool?) left (parse-expr)))
((match-kw "really") ((match-kw "really")
(do (do
(match-kw "equal") (match-kw "equal")
@@ -685,8 +571,7 @@
(let (let
((right (parse-expr))) ((right (parse-expr)))
(list (quote not) (list (quote =) left right)))))) (list (quote not) (list (quote =) left right))))))
((match-kw "in") ((match-kw "in") (list (quote in?) left (parse-expr)))
(list (quote in-bool?) left (parse-expr)))
((match-kw "empty") (list (quote empty?) left)) ((match-kw "empty") (list (quote empty?) left))
((match-kw "between") ((match-kw "between")
(let (let
@@ -1006,7 +891,7 @@
(collect-classes!)))) (collect-classes!))))
(collect-classes!) (collect-classes!)
(let (let
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold))))) ((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
@@ -1035,7 +920,7 @@
(get (adv!) "value") (get (adv!) "value")
(parse-expr)))) (parse-expr))))
(let (let
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
(list (quote set-style) prop value tgt)))) (list (quote set-style) prop value tgt))))
((= (tp-type) "brace-open") ((= (tp-type) "brace-open")
(do (do
@@ -1054,16 +939,14 @@
((prop (get (adv!) "value"))) ((prop (get (adv!) "value")))
(when (= (tp-type) "colon") (adv!)) (when (= (tp-type) "colon") (adv!))
(let (let
((val (if (and (= (tp-type) "ident") (= (tp-val) "$")) (do (adv!) (when (= (tp-type) "brace-open") (adv!)) (if (= (tp-type) "brace-close") (do (adv!) (if (= (tp-type) "brace-open") (do (adv!) (let ((inner (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) inner)) "")) (let ((expr (parse-expr))) (when (= (tp-type) "brace-close") (adv!)) expr))) (get (adv!) "value")))) ((val (tp-val)))
(adv!)
(set! pairs (cons (list prop val) pairs)) (set! pairs (cons (list prop val) pairs))
(when
(and (= (tp-type) "op") (= (tp-val) ";"))
(adv!))
(collect-pairs!)))))) (collect-pairs!))))))
(collect-pairs!) (collect-pairs!)
(when (= (tp-type) "brace-close") (adv!)) (when (= (tp-type) "brace-close") (adv!))
(let (let
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
(list (quote set-styles) (reverse pairs) tgt))))) (list (quote set-styles) (reverse pairs) tgt)))))
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr")) ((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
(do (do
@@ -1075,7 +958,7 @@
((attr-val (parse-expr))) ((attr-val (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!)) (when (= (tp-type) "bracket-close") (adv!))
(let (let
((tgt (parse-tgt-kw "to" (list (quote beingTold))))) ((tgt (parse-tgt-kw "to" (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
@@ -1093,7 +976,7 @@
(let (let
((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (parse-expr)) ""))) ((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (parse-expr)) "")))
(let (let
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold))))) ((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
@@ -1134,23 +1017,18 @@
(collect-classes!)))) (collect-classes!))))
(collect-classes!) (collect-classes!)
(let (let
((tgt (if (match-kw "from") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
(let (if
((when-clause (if (match-kw "when") (parse-expr) nil))) (empty? extra-classes)
(if (list (quote remove-class) cls tgt)
(empty? extra-classes) (cons
(if (quote multi-remove-class)
when-clause (cons tgt (cons cls extra-classes)))))))
(list (quote remove-class-when) cls tgt when-clause)
(list (quote remove-class) cls tgt))
(cons
(quote multi-remove-class)
(cons tgt (cons cls extra-classes))))))))
((= (tp-type) "attr") ((= (tp-type) "attr")
(let (let
((attr-name (get (adv!) "value"))) ((attr-name (get (adv!) "value")))
(let (let
((tgt (if (match-kw "from") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
(list (quote remove-attr) attr-name tgt)))) (list (quote remove-attr) attr-name tgt))))
((and (= (tp-type) "bracket-open") (= (tp-val) "[")) ((and (= (tp-type) "bracket-open") (= (tp-val) "["))
(do (do
@@ -1212,7 +1090,7 @@
(let (let
((cls2 (do (let ((v (tp-val))) (adv!) v)))) ((cls2 (do (let ((v (tp-val))) (adv!) v))))
(let (let
((tgt (parse-tgt-kw "on" (list (quote beingTold))))) ((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-between) cls1 cls2 tgt))) (list (quote toggle-between) cls1 cls2 tgt)))
nil))) nil)))
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr")) ((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
@@ -1237,7 +1115,7 @@
((v2 (parse-expr))) ((v2 (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!)) (when (= (tp-type) "bracket-close") (adv!))
(let (let
((tgt (parse-tgt-kw "on" (list (quote beingTold))))) ((tgt (parse-tgt-kw "on" (list (quote me)))))
(if (if
(= n1 n2) (= n1 n2)
(list (list
@@ -1271,7 +1149,7 @@
(let (let
((extra-classes (collect-classes (list)))) ((extra-classes (collect-classes (list))))
(let (let
((tgt (parse-tgt-kw "on" (list (quote beingTold))))) ((tgt (parse-tgt-kw "on" (list (quote me)))))
(cond (cond
((> (len extra-classes) 0) ((> (len extra-classes) 0)
(list (list
@@ -1300,7 +1178,7 @@
(let (let
((prop (get (adv!) "value"))) ((prop (get (adv!) "value")))
(let (let
((tgt (if (match-kw "of") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "of") (parse-expr) (list (quote me)))))
(if (if
(match-kw "between") (match-kw "between")
(let (let
@@ -1371,7 +1249,7 @@
(let (let
((attr-name (get (adv!) "value"))) ((attr-name (get (adv!) "value")))
(let (let
((tgt (if (match-kw "on") (parse-expr) (list (quote beingTold))))) ((tgt (if (match-kw "on") (parse-expr) (list (quote me)))))
(if (if
(match-kw "between") (match-kw "between")
(let (let
@@ -1396,7 +1274,7 @@
((attr-val (parse-expr))) ((attr-val (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!)) (when (= (tp-type) "bracket-close") (adv!))
(let (let
((tgt (parse-tgt-kw "on" (list (quote beingTold))))) ((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-attr-val) attr-name attr-val tgt)))))) (list (quote toggle-attr-val) attr-name attr-val tgt))))))
((and (= (tp-type) "keyword") (= (tp-val) "my")) ((and (= (tp-type) "keyword") (= (tp-val) "my"))
(do (do
@@ -1475,9 +1353,7 @@
((match-kw "to") ((match-kw "to")
(let (let
((value (parse-expr))) ((value (parse-expr)))
(if (and (list? tgt) (= (first tgt) (quote query))) (list (quote set!) tgt value)))
(list (quote set-el!) tgt value)
(list (quote set!) tgt value))))
((match-kw "on") ((match-kw "on")
(let (let
((target (parse-expr))) ((target (parse-expr)))
@@ -1626,7 +1502,7 @@
(let (let
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil))) ((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
(let (let
((tgt (parse-tgt-kw "to" (list (quote beingTold))))) ((tgt (parse-tgt-kw "to" (list (quote me)))))
(if (if
dtl dtl
(list (quote send) name dtl tgt) (list (quote send) name dtl tgt)
@@ -1640,7 +1516,7 @@
(let (let
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil))) ((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
(let (let
((tgt (parse-tgt-kw "on" (list (quote beingTold))))) ((tgt (parse-tgt-kw "on" (list (quote me)))))
(if (if
dtl dtl
(list (quote trigger) name dtl tgt) (list (quote trigger) name dtl tgt)
@@ -1679,7 +1555,7 @@
(fn (fn
() ()
(let (let
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr))))) ((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
(let (let
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display"))) ((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
(let (let
@@ -1690,7 +1566,7 @@
(fn (fn
() ()
(let (let
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr))))) ((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
(let (let
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display"))) ((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
(let (let
@@ -1716,7 +1592,7 @@
((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))) ((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 (if (and (= (tp-type) "ident") (= (tp-val) "initial")) (do (adv!) "initial") (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))))) ((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
@@ -1806,7 +1682,7 @@
((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil))) ((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil)))
(list (quote fetch-gql) gql-source url)))) (list (quote fetch-gql) gql-source url))))
(let (let
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (and (= (tp-type) "ident") (not (string-contains? (tp-val) "'"))) (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom)))) ((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (= (tp-type) "ident") (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom))))
(let (let
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom))))) ((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
(let (let
@@ -1822,9 +1698,7 @@
((fmt-after (if (and (not fmt-before) (match-kw "as")) (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil))) ((fmt-after (if (and (not fmt-before) (match-kw "as")) (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil)))
(let (let
((fmt (or fmt-before fmt-after "text"))) ((fmt (or fmt-before fmt-after "text")))
(let (list (quote fetch) url fmt)))))))))
((do-not-throw (cond ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false)) false))) ((and (= (tp-type) "ident") (= (tp-val) "don't")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false))) (true false))))
(list (quote fetch) url fmt do-not-throw))))))))))
(define (define
parse-call-args parse-call-args
(fn (fn
@@ -2145,21 +2019,7 @@
((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%"))))) ((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%")))))
(let (let
((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a))))) ((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a)))))
(let (parse-arith (list op left right)))))
((lhs-start (if (and (dict? left) (get left :hs-ast)) (get left :start) 0))
(lhs-line
(if
(and (dict? left) (get left :hs-ast))
(get left :line)
1)))
(parse-arith
(hs-ast-wrap
(list op left right)
"arith"
lhs-start
(prev-end)
lhs-line
{:rhs right :lhs left}))))))
left)))) left))))
(define (define
parse-the-expr parse-the-expr
@@ -2174,21 +2034,21 @@
(if (if
(match-kw "of") (match-kw "of")
(list (quote style) val (parse-expr)) (list (quote style) val (parse-expr))
(list (quote style) val (list (quote beingTold)))))) (list (quote style) val (list (quote me))))))
((= typ "attr") ((= typ "attr")
(do (do
(adv!) (adv!)
(if (if
(match-kw "of") (match-kw "of")
(list (quote attr) val (parse-expr)) (list (quote attr) val (parse-expr))
(list (quote attr) val (list (quote beingTold)))))) (list (quote attr) val (list (quote me))))))
((= typ "class") ((= typ "class")
(do (do
(adv!) (adv!)
(if (if
(match-kw "of") (match-kw "of")
(list (quote has-class?) (parse-expr) val) (list (quote has-class?) (parse-expr) val)
(list (quote has-class?) (list (quote beingTold)) val)))) (list (quote has-class?) (list (quote me)) val))))
((= typ "selector") ((= typ "selector")
(do (do
(adv!) (adv!)
@@ -2336,15 +2196,13 @@
() ()
(let (let
((tgt (parse-expr))) ((tgt (parse-expr)))
(list (list (quote measure) (if (nil? tgt) (list (quote me)) tgt)))))
(quote measure)
(if (nil? tgt) (list (quote beingTold)) tgt)))))
(define (define
parse-scroll-cmd parse-scroll-cmd
(fn (fn
() ()
(let (let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr)))) ((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
(let (let
((pos (cond ((match-kw "top") "top") ((match-kw "bottom") "bottom") ((match-kw "left") "left") ((match-kw "right") "right") (true "top")))) ((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))))) (list (quote scroll!) tgt pos)))))
@@ -2353,14 +2211,14 @@
(fn (fn
() ()
(let (let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr)))) ((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)))) (list (quote select!) tgt))))
(define (define
parse-reset-cmd parse-reset-cmd
(fn (fn
() ()
(let (let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr)))) ((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)))) (list (quote reset!) tgt))))
(define (define
parse-default-cmd parse-default-cmd
@@ -2385,7 +2243,7 @@
(fn (fn
() ()
(let (let
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr))))) ((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
(list (quote focus!) tgt)))) (list (quote focus!) tgt))))
(define (define
parse-feat-body parse-feat-body
@@ -2499,7 +2357,7 @@
(fn (fn
() ()
(let (let
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr))))) ((target (cond ((at-end?) (list (quote ref) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote ref) "me")) (true (parse-expr)))))
(list (quote empty-target) target)))) (list (quote empty-target) target))))
(define (define
parse-swap-cmd parse-swap-cmd
@@ -2524,42 +2382,15 @@
(fn (fn
() ()
(let (let
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr))))) ((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
(list (quote open-element) target)))) (list (quote open-element) target))))
(define (define
parse-close-cmd parse-close-cmd
(fn (fn
() ()
(let (let
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr))))) ((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
(list (quote close-element) target)))) (list (quote close-element) target))))
(define
parse-js-block
(fn
()
(let
((params (if (= (tp-type) "paren-open") (do (adv!) (define collect-params! (fn (acc) (cond ((or (at-end?) (= (tp-type) "paren-close")) (do (when (= (tp-type) "paren-close") (adv!)) acc)) ((= (tp-type) "comma") (do (adv!) (collect-params! acc))) (true (let ((pname (tp-val))) (do (adv!) (collect-params! (append acc pname)))))))) (collect-params! (list))) (list))))
(let
((js-start (cur-start)))
(define
skip-to-end!
(fn
()
(if
(or
(at-end?)
(and (= (tp-type) "keyword") (= (tp-val) "end")))
nil
(do (adv!) (skip-to-end!)))))
(skip-to-end!)
(let
((js-end (cur-start)))
(let
((js-src (substring src js-start js-end)))
(when
(and (= (tp-type) "keyword") (= (tp-val) "end"))
(adv!))
(list (quote js-block) params js-src)))))))
(define (define
parse-cmd parse-cmd
(fn (fn
@@ -2588,21 +2419,7 @@
((and (= typ "keyword") (= val "put")) ((and (= typ "keyword") (= val "put"))
(do (adv!) (parse-put-cmd))) (do (adv!) (parse-put-cmd)))
((and (= typ "keyword") (= val "if")) ((and (= typ "keyword") (= val "if"))
(let (do (adv!) (parse-if-cmd)))
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(let
((r (parse-if-cmd)))
(let
((tb (if (and (list? r) (> (len r) 2)) (nth r 2) nil)))
(hs-ast-wrap
r
"if"
s
(prev-end)
l
(if tb {:true-branch (if (and (list? tb) (= (first tb) (quote do))) (nth tb 1) tb)} {})))))))
((and (= typ "keyword") (= val "wait")) ((and (= typ "keyword") (= val "wait"))
(do (adv!) (parse-wait-cmd))) (do (adv!) (parse-wait-cmd)))
((and (= typ "keyword") (= val "send")) ((and (= typ "keyword") (= val "send"))
@@ -2610,17 +2427,7 @@
((and (= typ "keyword") (= val "trigger")) ((and (= typ "keyword") (= val "trigger"))
(do (adv!) (parse-trigger-cmd))) (do (adv!) (parse-trigger-cmd)))
((and (= typ "keyword") (= val "log")) ((and (= typ "keyword") (= val "log"))
(let (do (adv!) (parse-log-cmd)))
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(parse-log-cmd)
"cmd"
s
(prev-end)
l
{}))))
((and (= typ "keyword") (= val "increment")) ((and (= typ "keyword") (= val "increment"))
(do (adv!) (parse-inc-cmd))) (do (adv!) (parse-inc-cmd)))
((and (= typ "keyword") (= val "decrement")) ((and (= typ "keyword") (= val "decrement"))
@@ -2660,17 +2467,7 @@
((and (= typ "keyword") (= val "tell")) ((and (= typ "keyword") (= val "tell"))
(do (adv!) (parse-tell-cmd))) (do (adv!) (parse-tell-cmd)))
((and (= typ "keyword") (= val "for")) ((and (= typ "keyword") (= val "for"))
(let (do (adv!) (parse-for-cmd)))
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(parse-for-cmd)
"cmd"
s
(prev-end)
l
{}))))
((and (= typ "keyword") (= val "make")) ((and (= typ "keyword") (= val "make"))
(do (adv!) (parse-make-cmd))) (do (adv!) (parse-make-cmd)))
((and (= typ "keyword") (= val "install")) ((and (= typ "keyword") (= val "install"))
@@ -2709,18 +2506,6 @@
(do (adv!) (list (quote continue)))) (do (adv!) (list (quote continue))))
((and (= typ "keyword") (or (= val "exit") (= val "halt"))) ((and (= typ "keyword") (or (= val "exit") (= val "halt")))
(do (adv!) (list (quote exit)))) (do (adv!) (list (quote exit))))
((and (= typ "keyword") (= val "js"))
(do (adv!) (parse-js-block)))
((and (= typ "keyword") (= val "start"))
(do
(adv!)
(expect-kw! "view")
(expect-kw! "transition")
(let ((using (if (match-kw "using") (parse-expr) nil)))
(match-kw "then")
(let ((body (parse-cmd-list)))
(match-kw "end")
(list (quote view-transition!) using body)))))
(true (parse-expr)))))) (true (parse-expr))))))
(define (define
parse-cmd-list parse-cmd-list
@@ -2776,148 +2561,103 @@
(= v "close") (= v "close")
(= v "pick") (= v "pick")
(= v "ask") (= v "ask")
(= v "answer") (= v "answer"))))
(= v "js")
(= v "start"))))
(define (define
cl-collect cl-collect
(fn (fn
(acc) (acc)
(do (let
(when ((cmd (parse-cmd)))
(and (= (tp-type) "keyword") (= (tp-val) "then")) (if
(adv!)) (nil? cmd)
(let acc
((cmd (parse-cmd))) (let
(if ((acc2 (append acc (list cmd))))
(nil? cmd) (cond
acc ((match-kw "unless")
(let (let
((acc2 (append acc (list cmd)))) ((cnd (parse-expr)))
(cond (cl-collect
((match-kw "unless") (append
(let acc
((cnd (parse-expr))) (list
(cl-collect (list (quote if) (list (quote no) cnd) cmd))))))
(append ((match-kw "then")
acc (cl-collect (append acc2 (list (quote __then__)))))
(list ((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
(list (cl-collect acc2))
(quote if) (true acc2)))))))
(list (quote no) cnd)
cmd))))))
((match-kw "then")
(cl-collect (append acc2 (list (quote __then__)))))
((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
(cl-collect acc2))
(true acc2))))))))
(let (let
((cmds (cl-collect (list)))) ((cmds (cl-collect (list))))
(define (cond
link-next-cmds ((= (len cmds) 0) nil)
(fn ((= (len cmds) 1) (first cmds))
(cmds-list) (true
(define (cons
loop (quote do)
(fn (filter (fn (c) (not (= c (quote __then__)))) cmds)))))))
(i)
(when
(< i (- (len cmds-list) 1))
(let
((cur-node (nth cmds-list i))
(nxt-node (nth cmds-list (+ i 1))))
(when
(and (dict? cur-node) (get cur-node :hs-ast))
(dict-set! (get cur-node :fields) "next" nxt-node)))
(loop (+ i 1)))))
(loop 0)
cmds-list))
(let
((linked (if hs-span-mode (link-next-cmds cmds) cmds)))
(cond
((= (len linked) 0) nil)
((= (len linked) 1) (first linked))
(true
(cons
(quote do)
(filter (fn (c) (not (= c (quote __then__)))) linked))))))))
(define (define
parse-on-feat parse-on-feat
(fn (fn
() ()
(let (let
((every? (match-kw "every")) (first? (match-kw "first"))) ((every? (match-kw "every")))
(let (let
((event-name (parse-compound-event-name))) ((event-name (parse-compound-event-name)))
(let (let
((count-filter (let ((mn nil) (mx nil)) (when first? (do (set! mn 1) (set! mx 1))) (when (= (tp-type) "number") (let ((n (parse-number (tp-val)))) (do (adv!) (set! mn n) (cond ((match-kw "to") (cond ((= (tp-type) "number") (let ((mv (parse-number (tp-val)))) (do (adv!) (set! mx mv)))) (true (set! mx n)))) ((match-kw "and") (cond ((match-kw "on") (set! mx -1)) (true (set! mx n)))) (true (set! mx n)))))) (if mn (dict "min" mn "max" mx) nil)))) ((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
(let (let
((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil))))) ((source (if (match-kw "from") (parse-expr) nil)))
(let (let
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil))) ((h-margin nil) (h-threshold nil))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
(let (let
((elsewhere? (cond ((match-kw "elsewhere") true) ((and (= (tp-type) "keyword") (= (tp-val) "from") (let ((nxt (if (< (+ p 1) tok-len) (nth tokens (+ p 1)) nil))) (and nxt (= (get nxt "type") "keyword") (= (get nxt "value") "elsewhere")))) (do (adv!) (adv!) true)) (true false))) ((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
(source (if (match-kw "from") (parse-expr) nil)))
(let (let
((h-margin nil) (h-threshold nil)) ((body (parse-cmd-list)))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
(when (and (= (tp-type) "keyword") (= (tp-val) "queue")) (do (adv!) (adv!)))
(let (let
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil))) ((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 (let
((body (parse-cmd-list))) ((parts (list (quote on) event-name)))
(let (let
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil)) ((parts (if every? (append parts (list :every true)) parts)))
(finally-clause
(if
(match-kw "finally")
(parse-cmd-list)
nil)))
(match-kw "end")
(let (let
((parts (list (quote on) event-name))) ((parts (if flt (append parts (list :filter flt)) parts)))
(let (let
((parts (if every? (append parts (list :every true)) parts))) ((parts (if source (append parts (list :from source)) parts)))
(let (let
((parts (if flt (append parts (list :filter flt)) parts))) ((parts (if having (append parts (list :having having)) parts)))
(let (let
((parts (if elsewhere? (append parts (list :elsewhere true)) parts))) ((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
(let (let
((parts (if source (append parts (list :from source)) parts))) ((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
(let (let
((parts (if count-filter (append parts (list :count-filter count-filter)) parts))) ((parts (append parts (list body))))
(let parts))))))))))))))))))
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
(let
((parts (if having (append parts (list :having having)) 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 (define
parse-init-feat parse-init-feat
(fn (fn
@@ -2993,9 +2733,6 @@
((= val "behavior") (do (adv!) (parse-behavior-feat))) ((= val "behavior") (do (adv!) (parse-behavior-feat)))
((= val "live") (do (adv!) (parse-live-feat))) ((= val "live") (do (adv!) (parse-live-feat)))
((= val "when") (do (adv!) (parse-when-feat))) ((= val "when") (do (adv!) (parse-when-feat)))
((= val "worker")
(error
"worker plugin is not installed — see https://hyperscript.org/features/worker"))
(true (parse-cmd-list)))))) (true (parse-cmd-list))))))
(define (define
coll-feats coll-feats
@@ -3014,13 +2751,4 @@
(first features) (first features)
(cons (quote do) features)))))) (cons (quote do) features))))))
(define hs-span-mode false)
(define hs-compile (fn (src) (hs-parse (hs-tokenize src) src))) (define hs-compile (fn (src) (hs-parse (hs-tokenize src) src)))
(define hs-parse-ast
(fn (src)
(do
(set! hs-span-mode true)
(let ((result (hs-parse (hs-tokenize src) src)))
(do (set! hs-span-mode false) result)))))

View File

@@ -43,47 +43,29 @@
;; Run an initializer function immediately. ;; Run an initializer function immediately.
;; (hs-init thunk) — called at element boot time ;; (hs-init thunk) — called at element boot time
(define meta (host-new "Object")) (define
hs-on
(fn
(target event-name handler)
(let
((wrapped (fn (event) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (dom-dispatch target "exception" {:error e})) (true (raise e))) (handler event)))))
(let
((unlisten (dom-listen target event-name wrapped))
(prev (or (dom-get-data target "hs-unlisteners") (list))))
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
unlisten))))
;; ── Async / timing ────────────────────────────────────────────── ;; ── Async / timing ──────────────────────────────────────────────
;; Wait for a duration in milliseconds. ;; Wait for a duration in milliseconds.
;; In hyperscript, wait is async-transparent — execution pauses. ;; In hyperscript, wait is async-transparent — execution pauses.
;; Here we use perform/IO suspension for true pause semantics. ;; Here we use perform/IO suspension for true pause semantics.
(define
_hs-on-caller
(let
((_ctx (host-new "Object"))
(_m (host-new "Object"))
(_f (host-new "Object")))
(do
(host-set! _f "type" "onFeature")
(host-set! _m "feature" _f)
(host-set! _ctx "meta" _m)
_ctx)))
;; Wait for a DOM event on a target.
;; (hs-wait-for target event-name) — suspends until event fires
(define
hs-on
(fn
(target event-name handler)
(let
((wrapped (fn (event) (do (host-set! meta "caller" _hs-on-caller) (host-set! meta "owner" target) (let ((__hs-no-stop false)) (guard (e ((and (not (= event-name "exception")) (not (= event-name "error"))) (do (when (and (list? e) (= (first e) "hs-halt-default")) (set! __hs-no-stop true)) (when (not __hs-no-stop) (dom-dispatch target "exception" {:error e})))) (true (raise e))) (handler event)) (when (not __hs-no-stop) (host-call event "stopPropagation")))))))
(let
((unlisten (dom-listen target event-name wrapped))
(prev (or (dom-get-data target "hs-unlisteners") (list))))
(dom-set-data target "hs-unlisteners" (append prev (list unlisten)))
unlisten))))
;; Wait for CSS transitions/animations to settle on an element.
(define (define
hs-on-every hs-on-every
(fn (target event-name handler) (dom-listen target event-name handler))) (fn (target event-name handler) (dom-listen target event-name handler)))
;; ── Class manipulation ────────────────────────────────────────── ;; Wait for a DOM event on a target.
;; (hs-wait-for target event-name) — suspends until event fires
;; Toggle a single class on an element.
(define (define
hs-on-intersection-attach! hs-on-intersection-attach!
(fn (fn
@@ -99,40 +81,15 @@
(host-call observer "observe" target) (host-call observer "observe" target)
observer))))) observer)))))
;; Toggle between two classes — exactly one is active at a time. ;; Wait for CSS transitions/animations to settle on an element.
(define
hs-on-mutation-attach!
(fn
(target mode attr-list)
(let
((cfg-attributes (or (= mode "any") (= mode "attributes") (= mode "attrs")))
(cfg-childList (or (= mode "any") (= mode "childList")))
(cfg-characterData (or (= mode "any") (= mode "characterData"))))
(let
((opts (dict "attributes" cfg-attributes "childList" cfg-childList "characterData" cfg-characterData "subtree" true)))
(when
(and (= mode "attrs") attr-list)
(dict-set! opts "attributeFilter" attr-list))
(let
((cb (fn (records observer) (dom-dispatch target "mutation" (dict "records" records)))))
(let
((observer (host-new "MutationObserver" cb)))
(host-call observer "observe" target opts)
observer))))))
;; Take a class from siblings — add to target, remove from others.
;; (hs-take! target cls) — like radio button class behavior
(define hs-init (fn (thunk) (thunk))) (define hs-init (fn (thunk) (thunk)))
;; ── DOM insertion ─────────────────────────────────────────────── ;; ── Class manipulation ──────────────────────────────────────────
;; Put content at a position relative to a target. ;; Toggle a single class on an element.
;; pos: "into" | "before" | "after"
(define hs-wait (fn (ms) (perform (list (quote io-sleep) ms)))) (define hs-wait (fn (ms) (perform (list (quote io-sleep) ms))))
;; ── Navigation / traversal ────────────────────────────────────── ;; Toggle between two classes — exactly one is active at a time.
;; Navigate to a URL.
(begin (begin
(define (define
hs-wait-for hs-wait-for
@@ -145,15 +102,21 @@
(target event-name timeout-ms) (target event-name timeout-ms)
(perform (list (quote io-wait-event) target event-name timeout-ms))))) (perform (list (quote io-wait-event) target event-name timeout-ms)))))
;; Find next sibling matching a selector (or any sibling). ;; Take a class from siblings — add to target, remove from others.
;; (hs-take! target cls) — like radio button class behavior
(define hs-settle (fn (target) (perform (list (quote io-settle) target)))) (define hs-settle (fn (target) (perform (list (quote io-settle) target))))
;; Find previous sibling matching a selector. ;; ── DOM insertion ───────────────────────────────────────────────
;; Put content at a position relative to a target.
;; pos: "into" | "before" | "after"
(define (define
hs-toggle-class! hs-toggle-class!
(fn (target cls) (host-call (host-get target "classList") "toggle" cls))) (fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
;; First element matching selector within a scope. ;; ── Navigation / traversal ──────────────────────────────────────
;; Navigate to a URL.
(define (define
hs-toggle-between! hs-toggle-between!
(fn (fn
@@ -163,7 +126,7 @@
(do (dom-remove-class target cls1) (dom-add-class target cls2)) (do (dom-remove-class target cls1) (dom-add-class target cls2))
(do (dom-remove-class target cls2) (dom-add-class target cls1))))) (do (dom-remove-class target cls2) (dom-add-class target cls1)))))
;; Last element matching selector. ;; Find next sibling matching a selector (or any sibling).
(define (define
hs-toggle-style! hs-toggle-style!
(fn (fn
@@ -187,7 +150,7 @@
(dom-set-style target prop "hidden") (dom-set-style target prop "hidden")
(dom-set-style target prop ""))))))) (dom-set-style target prop "")))))))
;; First/last within a specific scope. ;; Find previous sibling matching a selector.
(define (define
hs-toggle-style-between! hs-toggle-style-between!
(fn (fn
@@ -199,6 +162,7 @@
(dom-set-style target prop val2) (dom-set-style target prop val2)
(dom-set-style target prop val1))))) (dom-set-style target prop val1)))))
;; First element matching selector within a scope.
(define (define
hs-toggle-style-cycle! hs-toggle-style-cycle!
(fn (fn
@@ -219,9 +183,7 @@
(true (find-next (rest remaining)))))) (true (find-next (rest remaining))))))
(dom-set-style target prop (find-next vals))))) (dom-set-style target prop (find-next vals)))))
;; ── Iteration ─────────────────────────────────────────────────── ;; Last element matching selector.
;; Repeat a thunk N times.
(define (define
hs-take! hs-take!
(fn (fn
@@ -261,7 +223,7 @@
(dom-set-attr target name attr-val) (dom-set-attr target name attr-val)
(dom-set-attr target name "")))))))) (dom-set-attr target name ""))))))))
;; Repeat forever (until break — relies on exception/continuation). ;; First/last within a specific scope.
(begin (begin
(define (define
hs-element? hs-element?
@@ -311,26 +273,7 @@
hs-set-inner-html! hs-set-inner-html!
(fn (fn
(target value) (target value)
(let (do (dom-set-inner-html target value) (hs-boot-subtree! target))))
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
(do (dom-set-inner-html target str-val) (hs-boot-subtree! target)))))
(define
hs-set-element!
(fn
(target value)
(let ((parent (dom-parent target)))
(when parent
(let ((tmp (dom-create-element "div"))
(str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
(do
(dom-set-inner-html tmp str-val)
(let ((children (host-get tmp "children")))
(if (> (len children) 0)
(let ((new-el (first children)))
(do
(host-call parent "replaceChild" new-el target)
(hs-boot-subtree! new-el)))
(hs-set-inner-html! target str-val)))))))))
(define (define
hs-put! hs-put!
(fn (fn
@@ -392,10 +335,6 @@
(dom-insert-adjacent-html target "beforeend" value) (dom-insert-adjacent-html target "beforeend" value)
(hs-boot-subtree! target))))))))) (hs-boot-subtree! target)))))))))
;; ── Fetch ───────────────────────────────────────────────────────
;; Fetch a URL, parse response according to format.
;; (hs-fetch url format) — format is "json" | "text" | "html"
(define (define
hs-add-to! hs-add-to!
(fn (fn
@@ -408,10 +347,9 @@
(append target (list value)))) (append target (list value))))
(true (do (host-call target "push" value) target))))) (true (do (host-call target "push" value) target)))))
;; ── Type coercion ─────────────────────────────────────────────── ;; ── Iteration ───────────────────────────────────────────────────
;; Coerce a value to a type by name. ;; Repeat a thunk N times.
;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define (define
hs-remove-from! hs-remove-from!
(fn (fn
@@ -421,10 +359,7 @@
(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))))
;; ── Object creation ───────────────────────────────────────────── ;; Repeat forever (until break — relies on exception/continuation).
;; Make a new object of a given type.
;; (hs-make type-name) — creates empty object/collection
(define (define
hs-splice-at! hs-splice-at!
(fn (fn
@@ -448,11 +383,10 @@
(host-call target "splice" i 1)))) (host-call target "splice" i 1))))
target)))) target))))
;; ── Behavior installation ─────────────────────────────────────── ;; ── Fetch ───────────────────────────────────────────────────────
;; Install a behavior on an element. ;; Fetch a URL, parse response according to format.
;; A behavior is a function that takes (me ...params) and sets up features. ;; (hs-fetch url format) — format is "json" | "text" | "html"
;; (hs-install behavior-fn me ...args)
(define (define
hs-index hs-index
(fn (fn
@@ -464,10 +398,10 @@
((string? obj) (nth obj key)) ((string? obj) (nth obj key))
(true (host-get obj key))))) (true (host-get obj key)))))
;; ── Measurement ───────────────────────────────────────────────── ;; ── Type coercion ───────────────────────────────────────────────
;; Measure an element's bounding rect, store as local variables. ;; Coerce a value to a type by name.
;; Returns a dict with x, y, width, height, top, left, right, bottom. ;; (hs-coerce value type-name) — type-name is "Int", "Float", "String", etc.
(define (define
hs-put-at! hs-put-at!
(fn (fn
@@ -489,10 +423,10 @@
((= pos "start") (host-call target "unshift" value))) ((= pos "start") (host-call target "unshift" value)))
target))))))) target)))))))
;; Return the current text selection as a string. In the browser this is ;; ── Object creation ─────────────────────────────────────────────
;; `window.getSelection().toString()`. In the mock test runner, a test
;; setup stashes the desired selection text at `window.__test_selection` ;; Make a new object of a given type.
;; and the fallback path returns that so tests can assert on the result. ;; (hs-make type-name) — creates empty object/collection
(define (define
hs-dict-without hs-dict-without
(fn (fn
@@ -513,19 +447,27 @@
(host-call (host-global "Reflect") "deleteProperty" out key) (host-call (host-global "Reflect") "deleteProperty" out key)
out))))) out)))))
;; ── Behavior installation ───────────────────────────────────────
;; ── Transition ────────────────────────────────────────────────── ;; Install a behavior on an element.
;; A behavior is a function that takes (me ...params) and sets up features.
;; Transition a CSS property to a value, optionally with duration. ;; (hs-install behavior-fn me ...args)
;; (hs-transition target prop value duration)
(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))))
;; ── 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-navigate! (fn (url) (perform (list (quote io-navigate) url)))) (define hs-navigate! (fn (url) (perform (list (quote io-navigate) url))))
;; Return the current text selection as a string. In the browser this is
;; `window.getSelection().toString()`. In the mock test runner, a test
;; setup stashes the desired selection text at `window.__test_selection`
;; and the fallback path returns that so tests can assert on the result.
(define (define
hs-ask hs-ask
(fn (fn
@@ -534,6 +476,11 @@
((w (host-global "window"))) ((w (host-global "window")))
(if w (host-call w "prompt" msg) nil)))) (if w (host-call w "prompt" msg) nil))))
;; ── Transition ──────────────────────────────────────────────────
;; Transition a CSS property to a value, optionally with duration.
;; (hs-transition target prop value duration)
(define (define
hs-answer hs-answer
(fn (fn
@@ -580,7 +527,7 @@
(do (do
(host-call ev "preventDefault") (host-call ev "preventDefault")
(host-call ev "stopPropagation"))))) (host-call ev "stopPropagation")))))
(when (not (= mode "the-event")) (raise (list (if (= mode "default") "hs-halt-default" "hs-return") nil)))))) (when (not (= mode "the-event")) (raise (list "hs-return" nil))))))
(define hs-select! (fn (target) (host-call target "select" (list)))) (define hs-select! (fn (target) (host-call target "select" (list))))
@@ -664,10 +611,6 @@
(true (find-next (dom-next-sibling el)))))) (true (find-next (dom-next-sibling el))))))
(find-next sibling))))) (find-next sibling)))))
(define (define
hs-previous hs-previous
(fn (fn
@@ -690,8 +633,7 @@
(define (define
hs-query-all hs-query-all
(fn (sel) (host-call (dom-body) "querySelectorAll" sel))) (fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; Property access — dot notation and .length
(define (define
hs-query-all-in hs-query-all-in
(fn (fn
@@ -700,23 +642,26 @@
(nil? target) (nil? target)
(hs-query-all sel) (hs-query-all sel)
(host-call target "querySelectorAll" sel)))) (host-call target "querySelectorAll" sel))))
;; DOM query stub — sandbox returns empty list
(define (define
hs-list-set hs-list-set
(fn (fn
(lst idx val) (lst idx val)
(append (take lst idx) (cons val (drop lst (+ idx 1)))))) (append (take lst idx) (cons val (drop lst (+ idx 1))))))
;; Method dispatch — obj.method(args)
(define (define
hs-to-number hs-to-number
(fn (v) (if (number? v) v (or (parse-number (str v)) 0)))) (fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
;; ── Sandbox/test runtime additions ──────────────────────────────
;; ── 0.9.90 features ───────────────────────────────────────────── ;; Property access — dot notation and .length
;; beep! — debug logging, returns value unchanged
(define (define
hs-query-first hs-query-first
(fn (sel) (host-call (host-global "document") "querySelector" sel))) (fn (sel) (host-call (host-global "document") "querySelector" sel)))
;; Property-based is — check obj.key truthiness ;; DOM query stub — sandbox returns empty list
(define (define
hs-query-last hs-query-last
(fn (fn
@@ -724,9 +669,11 @@
(let (let
((all (dom-query-all (dom-body) sel))) ((all (dom-query-all (dom-body) sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil)))) (if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; Array slicing (inclusive both ends) ;; Method dispatch — obj.method(args)
(define hs-first (fn (scope sel) (dom-query-all scope sel))) (define hs-first (fn (scope sel) (dom-query-all scope sel)))
;; Collection: sorted by
;; ── 0.9.90 features ─────────────────────────────────────────────
;; beep! — debug logging, returns value unchanged
(define (define
hs-last hs-last
(fn (fn
@@ -734,7 +681,7 @@
(let (let
((all (dom-query-all scope sel))) ((all (dom-query-all scope sel)))
(if (> (len all) 0) (nth all (- (len all) 1)) nil)))) (if (> (len all) 0) (nth all (- (len all) 1)) nil))))
;; Collection: sorted by descending ;; Property-based is — check obj.key truthiness
(define (define
hs-repeat-times hs-repeat-times
(fn (fn
@@ -752,7 +699,7 @@
((= signal "hs-continue") (do-repeat (+ i 1))) ((= signal "hs-continue") (do-repeat (+ i 1)))
(true (do-repeat (+ i 1)))))))) (true (do-repeat (+ i 1))))))))
(do-repeat 0))) (do-repeat 0)))
;; Collection: split by ;; Array slicing (inclusive both ends)
(define (define
hs-repeat-forever hs-repeat-forever
(fn (fn
@@ -768,7 +715,7 @@
((= signal "hs-continue") (do-forever)) ((= signal "hs-continue") (do-forever))
(true (do-forever)))))) (true (do-forever))))))
(do-forever))) (do-forever)))
;; Collection: joined by ;; Collection: sorted by
(define (define
hs-repeat-while hs-repeat-while
(fn (fn
@@ -781,7 +728,7 @@
((= signal "hs-break") nil) ((= signal "hs-break") nil)
((= signal "hs-continue") (hs-repeat-while cond-fn thunk)) ((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
(true (hs-repeat-while cond-fn thunk))))))) (true (hs-repeat-while cond-fn thunk)))))))
;; Collection: sorted by descending
(define (define
hs-repeat-until hs-repeat-until
(fn (fn
@@ -793,13 +740,13 @@
((= signal "hs-continue") ((= signal "hs-continue")
(if (cond-fn) nil (hs-repeat-until cond-fn thunk))) (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk))))))) (true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
;; Collection: split by
(define (define
hs-for-each hs-for-each
(fn (fn
(fn-body collection) (fn-body collection)
(let (let
((items (cond ((list? collection) collection) ((nil? collection) (list)) ((host-iter? collection) (host-to-list collection)) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) (true (list))))) ((items (cond ((list? collection) collection) ((dict? collection) (if (dict-has? collection "_order") (get collection "_order") (filter (fn (k) (not (= k "_order"))) (keys collection)))) ((nil? collection) (list)) (true (list)))))
(define (define
do-loop do-loop
(fn (fn
@@ -813,7 +760,7 @@
((= signal "hs-continue") (do-loop (rest remaining))) ((= signal "hs-continue") (do-loop (rest remaining)))
(true (do-loop (rest remaining)))))))) (true (do-loop (rest remaining))))))))
(do-loop items)))) (do-loop items))))
;; Collection: joined by
(begin (begin
(define (define
hs-append hs-append
@@ -829,8 +776,7 @@
(append target (list value)))) (append target (list value))))
((hs-element? target) ((hs-element? target)
(do (do
(dom-insert-adjacent-html target "beforeend" (dom-insert-adjacent-html target "beforeend" (str value))
(if (hs-element? value) (host-get value "outerHTML") (str value)))
target)) target))
(true (str target value))))) (true (str target value)))))
(define (define
@@ -840,8 +786,7 @@
(cond (cond
((nil? target) nil) ((nil? target) nil)
((hs-element? target) ((hs-element? target)
(dom-insert-adjacent-html target "beforeend" (dom-insert-adjacent-html target "beforeend" (str value)))
(if (hs-element? value) (host-get value "outerHTML") (str value))))
(true nil))))) (true nil)))))
(define (define
@@ -907,44 +852,14 @@
out))))))))))) out)))))))))))
(define (define
hs-fetch-impl hs-fetch
(fn (fn
(url format no-throw) (url format)
(let (let
((fmt (cond ((fmt (cond ((nil? format) "text") ((or (= format "json") (= format "JSON") (= format "Object")) "json") ((or (= format "html") (= format "HTML")) "html") ((or (= format "response") (= format "Response")) "response") ((or (= format "text") (= format "Text")) "text") (true format))))
((nil? format) "text")
((or (= format "json") (= format "JSON") (= format "Object")) "json")
((or (= format "html") (= format "HTML")) "html")
((or (= format "response") (= format "Response")) "response")
((or (= format "text") (= format "Text")) "text")
((or (= format "number") (= format "Number")) "number")
(true "text"))))
(let
((_hs-before-caller (host-get meta "owner")))
(when _hs-before-caller
(dom-dispatch _hs-before-caller "hyperscript:beforeFetch" {:url url})))
(let (let
((raw (perform (list "io-fetch" url fmt)))) ((raw (perform (list "io-fetch" url fmt))))
(begin (cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
(when (= (host-get raw "_network-error") true)
(raise (or (host-get raw "message") "Network error")))
(when (and (not no-throw) (not (= fmt "response")) (= (host-get raw "ok") false))
(raise (str "HTTP Error: " (host-get raw "status"))))
(cond
((= fmt "response") raw)
((= fmt "json")
(hs-host-to-sx (perform (list "io-parse-json" raw))))
((= fmt "number")
(hs-to-number (perform (list "io-parse-text" raw))))
(true (perform (list "io-parse-text" raw)))))))))
(define
hs-fetch
(fn (url format) (hs-fetch-impl url format false)))
(define
hs-fetch-no-throw
(fn (url format) (hs-fetch-impl url format true)))
(define (define
hs-json-escape hs-json-escape
@@ -1035,10 +950,9 @@
(true (str value)))) (true (str value))))
((= type-name "JSON") ((= type-name "JSON")
(cond (cond
((string? value) (guard (_e (true value)) (hs-host-to-sx (json-parse value)))) ((string? value) (guard (_e (true value)) (json-parse value)))
((not (nil? (host-get value "_json"))) ((dict? value) (hs-json-stringify value))
(hs-host-to-sx (perform (list "io-parse-json" value)))) ((list? value) (hs-json-stringify value))
((dict? value) value)
(true value))) (true value)))
((= type-name "Object") ((= type-name "Object")
(if (if
@@ -1197,17 +1111,7 @@
(if (if
(host-get node "multiple") (host-get node "multiple")
(hs-select-multi-values node) (hs-select-multi-values node)
(let (host-get node "value")))
((idx (host-get node "selectedIndex"))
(opts (host-get node "options"))
(raw-val (host-get node "value")))
(if
(and (not (nil? raw-val)) (not (= raw-val "")))
raw-val
(if
(and (not (nil? opts)) (>= idx 0))
(host-get (if (list? opts) (nth opts idx) (host-get opts idx)) "value")
"")))))
((or (= typ "checkbox") (= typ "radio")) ((or (= typ "checkbox") (= typ "radio"))
(if (host-get node "checked") (host-get node "value") nil)) (if (host-get node "checked") (host-get node "value") nil))
(true (host-get node "value")))))) (true (host-get node "value"))))))
@@ -1424,21 +1328,14 @@
hs-transition hs-transition
(fn (fn
(target prop value duration) (target prop value duration)
(let (when
((init-attr (str "data-hs-init-" prop))) duration
(when (dom-set-style
(not (dom-get-attr target init-attr)) target
(dom-set-attr target init-attr (dom-get-style target prop))) "transition"
(let (str prop " " (/ duration 1000) "s")))
((actual-value (if (= value "initial") (dom-get-attr target init-attr) value))) (dom-set-style target prop value)
(when (when duration (hs-settle target))))
duration
(dom-set-style
target
"transition"
(str prop " " (/ duration 1000) "s")))
(dom-set-style target prop actual-value)
(when duration (hs-settle target))))))
(define (define
hs-transition-from hs-transition-from
@@ -1501,15 +1398,6 @@
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))))
(define
hs-id=
(fn
(a b)
(if
(and (= (host-typeof a) "element") (= (host-typeof b) "element"))
(hs-ref-eq a b)
(= a b))))
(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)))))
@@ -1627,25 +1515,6 @@
(hs-contains? (rest collection) item)))))) (hs-contains? (rest collection) item))))))
(true false)))) (true false))))
(define
hs-in?
(fn
(collection item)
(cond
((nil? collection) (list))
((list? collection)
(cond
((nil? item) (list))
((list? item)
(filter (fn (x) (hs-contains? collection x)) item))
((hs-contains? collection item) (list item))
(true (list))))
(true (list)))))
(define
hs-in-bool?
(fn (collection item) (not (hs-falsy? (hs-in? collection item)))))
(define (define
hs-is hs-is
(fn (fn
@@ -2189,13 +2058,20 @@
(fn (fn
(pairs) (pairs)
(let (let
((d {})) ((d {}) (order (list)))
(do (do
(for-each (for-each
(fn (fn
(pair) (pair)
(dict-set! d (first pair) (nth pair 1))) (let
((k (first pair)))
(do
(when
(not (dict-has? d k))
(set! order (append order (list k))))
(dict-set! d k (nth pair 1)))))
pairs) pairs)
(when (not (empty? order)) (dict-set! d "_order" order))
d)))) d))))
(define (define
@@ -2219,13 +2095,7 @@
-1 -1
(if (= (first lst) item) i (idx-loop (rest lst) (+ i 1)))))) (if (= (first lst) item) i (idx-loop (rest lst) (+ i 1))))))
(idx-loop obj 0))) (idx-loop obj 0)))
(true (true nil))))
(let
((fn-val (host-get obj method)))
(cond
((and fn-val (callable? fn-val)) (apply fn-val args))
(fn-val (apply host-call (cons obj (cons method args))))
(true nil)))))))
(define hs-beep (fn (v) v)) (define hs-beep (fn (v) v))
@@ -2596,8 +2466,6 @@
((nth entry 2) val))) ((nth entry 2) val)))
_hs-dom-watchers))) _hs-dom-watchers)))
;; ── SourceInfo API ────────────────────────────────────────────────
(define (define
hs-dom-is-ancestor? hs-dom-is-ancestor?
(fn (fn
@@ -2606,215 +2474,3 @@
((nil? b) false) ((nil? b) false)
((= a b) true) ((= a b) true)
(true (hs-dom-is-ancestor? a (dom-parent b)))))) (true (hs-dom-is-ancestor? a (dom-parent b))))))
(define
hs-win-call
(fn
(fn-name args)
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
(define
hs-source-for
(fn
(node)
(substring (get node :src) (get node :start) (get node :end))))
(define
hs-line-for
(fn
(node)
(let
((lines (split (get node :src) "\n"))
(line-idx (- (get node :line) 1)))
(if (< line-idx (len lines)) (nth lines line-idx) ""))))
(define hs-node-get (fn (node key) (get (get node :fields) key)))
(define hs-src (fn (src-str) (hs-source-for (hs-parse-ast src-str))))
(define
hs-src-at
(fn
(src-str path)
(define
walk
(fn
(node keys)
(if
(or (nil? keys) (= (len keys) 0))
node
(walk (hs-node-get node (first keys)) (rest keys)))))
(hs-source-for (walk (hs-parse-ast src-str) path))))
(define
hs-line-at
(fn
(src-str path)
(define
walk
(fn
(node keys)
(if
(or (nil? keys) (= (len keys) 0))
node
(walk (hs-node-get node (first keys)) (rest keys)))))
(hs-line-for (walk (hs-parse-ast src-str) path))))
(define
hs-js-exec
(fn
(param-names js-src bound-args)
(let
((js-fn (host-new-function param-names js-src)))
(let
((result (host-call-fn js-fn bound-args)))
(if
(= (host-typeof result) "promise")
(let
((state (host-promise-state result)))
(if
(and state (= (host-get state "ok") false))
(raise (host-get state "value"))
(if state (host-get state "value") result)))
result)))))
(define
hs-raw->api-token
(fn
(raw)
(let
((type (dict-get raw :type)) (value (dict-get raw :value)))
(cond
(= type "ident")
{:value value :type "IDENTIFIER" :op false}
(= type "keyword")
{:value value :type "IDENTIFIER" :op false}
(= type "number")
{:value value :type "NUMBER" :op false}
(= type "string")
{:value value :type "STRING" :op false}
(= type "class")
{:value (str "." value) :type "CLASS_REF" :op false}
(= type "id")
{:value (str "#" value) :type "ID_REF" :op false}
(= type "attr")
{:value value :type "ATTRIBUTE_REF" :op false}
(= type "style")
{:value value :type "STYLE_REF" :op false}
(= type "selector")
{:value value :type "QUERY_REF" :op false}
(= type "eof")
{:value "<<<EOF>>>" :type "EOF" :op false}
(= type "paren-open")
{:value value :type "L_PAREN" :op true}
(= type "paren-close")
{:value value :type "R_PAREN" :op true}
(= type "bracket-open")
{:value value :type "L_BRACKET" :op true}
(= type "bracket-close")
{:value value :type "R_BRACKET" :op true}
(= type "brace-open")
{:value value :type "L_BRACE" :op true}
(= type "brace-close")
{:value value :type "R_BRACE" :op true}
(= type "comma")
{:value value :type "COMMA" :op true}
(= type "dot")
{:value value :type "PERIOD" :op true}
(= type "colon")
{:value value :type "COLON" :op true}
(= type "op")
(cond
(= value "+") {:value value :type "PLUS" :op true}
(= value "-") {:value value :type "MINUS" :op true}
(= value "*") {:value value :type "MULTIPLY" :op true}
(= value "/") {:value value :type "SLASH" :op true}
(= value "!") {:value value :type "EXCLAMATION" :op true}
(= value "?") {:value value :type "QUESTION" :op true}
(= value "#") {:value value :type "POUND" :op true}
(= value "&") {:value value :type "AMPERSAND" :op true}
(= value "=") {:value value :type "EQUALS" :op true}
(= value "<") {:value value :type "L_ANG" :op true}
(= value ">") {:value value :type "R_ANG" :op true}
(= value "<=") {:value value :type "LTE_ANG" :op true}
(= value ">=") {:value value :type "GTE_ANG" :op true}
(= value "==") {:value value :type "EQ" :op true}
(= value "===") {:value value :type "EQQ" :op true}
(= value "..") {:value value :type "PERIOD_PERIOD" :op true}
:else {:value value :type value :op true})
:else {:value (or value "") :type (str type) :op false}))))
(define hs-eof-sentinel {:value "<<<EOF>>>" :type "EOF" :op false})
(define
hs-tokens-of
(fn
(src &rest args)
(let
((template (some (fn (a) (equal? a :template)) args)))
(let
((raw (if template (hs-tokenize-template src) (hs-tokenize src))))
{:pos 0 :list (filter (fn (t) (not (= (dict-get t :type) "EOF"))) (map hs-raw->api-token raw)) :source src}))))
(define
hs-stream-token
(fn
(s i)
(let
((lst (dict-get s :list))
(n (len (dict-get s :list))))
(define
find
(fn
(pos count)
(if
(>= pos n)
hs-eof-sentinel
(let
((tok (nth lst pos)))
(if
(= (dict-get tok :type) "whitespace")
(find (+ pos 1) count)
(if
(= count 0)
tok
(find (+ pos 1) (- count 1))))))))
(find (dict-get s :pos) i))))
(define
hs-stream-consume
(fn
(s)
(let
((lst (dict-get s :list))
(n (len (dict-get s :list))))
(define
find-pos
(fn
(pos)
(if
(>= pos n)
pos
(if
(= (dict-get (nth lst pos) :type) "whitespace")
(find-pos (+ pos 1))
pos))))
(let
((p (find-pos (dict-get s :pos))))
(let
((tok (if (>= p n) hs-eof-sentinel (nth lst p))))
(do
(when
(not (= (dict-get tok :type) "EOF"))
(dict-set! s :pos (+ p 1)))
tok))))))
(define
hs-stream-has-more
(fn (s) (not (= (dict-get (hs-stream-token s 0) :type) "EOF"))))
(define hs-token-type (fn (tok) (dict-get tok :type)))
(define hs-token-value (fn (tok) (dict-get tok :value)))
(define hs-token-op? (fn (tok) (dict-get tok :op)))

View File

@@ -28,27 +28,6 @@
(define hs-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r")))) (define hs-ws? (fn (c) (or (= c " ") (= c "\t") (= c "\n") (= c "\r"))))
(define
hs-hex-digit?
(fn
(c)
(or
(and (>= c "0") (<= c "9"))
(and (>= c "a") (<= c "f"))
(and (>= c "A") (<= c "F")))))
(define
hs-hex-val
(fn
(c)
(let
((code (char-code c)))
(cond
((and (>= code 48) (<= code 57)) (- code 48))
((and (>= code 65) (<= code 70)) (- code 55))
((and (>= code 97) (<= code 102)) (- code 87))
(true 0)))))
;; ── Keyword set ─────────────────────────────────────────────────── ;; ── Keyword set ───────────────────────────────────────────────────
(define (define
@@ -131,7 +110,6 @@
"append" "append"
"settle" "settle"
"transition" "transition"
"view"
"over" "over"
"closest" "closest"
"next" "next"
@@ -257,15 +235,10 @@
read-number read-number
(fn (fn
(start) (start)
(define (when
read-int (and (< pos src-len) (hs-digit? (hs-cur)))
(fn (hs-advance! 1)
() (read-number start))
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-int))))
(read-int)
(when (when
(and (and
(< pos src-len) (< pos src-len)
@@ -273,7 +246,15 @@
(< (+ pos 1) src-len) (< (+ pos 1) src-len)
(hs-digit? (hs-peek 1))) (hs-digit? (hs-peek 1)))
(hs-advance! 1) (hs-advance! 1)
(read-int)) (define
read-frac
(fn
()
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-frac))))
(read-frac))
(do (do
(when (when
(and (and
@@ -291,7 +272,15 @@
(< pos src-len) (< pos src-len)
(or (= (hs-cur) "+") (= (hs-cur) "-"))) (or (= (hs-cur) "+") (= (hs-cur) "-")))
(hs-advance! 1)) (hs-advance! 1))
(read-int)) (define
read-exp-digits
(fn
()
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-exp-digits))))
(read-exp-digits))
(let (let
((num-end pos)) ((num-end pos))
(when (when
@@ -319,7 +308,7 @@
() ()
(cond (cond
(>= pos src-len) (>= pos src-len)
(error "Unterminated string") nil
(= (hs-cur) "\\") (= (hs-cur) "\\")
(do (do
(hs-advance! 1) (hs-advance! 1)
@@ -329,37 +318,15 @@
((ch (hs-cur))) ((ch (hs-cur)))
(cond (cond
(= ch "n") (= ch "n")
(do (append! chars "\n") (hs-advance! 1)) (append! chars "\n")
(= ch "t") (= ch "t")
(do (append! chars "\t") (hs-advance! 1)) (append! chars "\t")
(= ch "r")
(do (append! chars "\r") (hs-advance! 1))
(= ch "b")
(do (append! chars (char-from-code 8)) (hs-advance! 1))
(= ch "f")
(do (append! chars (char-from-code 12)) (hs-advance! 1))
(= ch "v")
(do (append! chars (char-from-code 11)) (hs-advance! 1))
(= ch "\\") (= ch "\\")
(do (append! chars "\\") (hs-advance! 1)) (append! chars "\\")
(= ch quote-char) (= ch quote-char)
(do (append! chars quote-char) (hs-advance! 1)) (append! chars quote-char)
(= ch "x") :else (do (append! chars "\\") (append! chars ch)))
(do (hs-advance! 1)))
(hs-advance! 1)
(if
(and
(< (+ pos 1) src-len)
(hs-hex-digit? (hs-cur))
(hs-hex-digit? (hs-peek 1)))
(let
((d1 (hs-hex-val (hs-cur)))
(d2 (hs-hex-val (hs-peek 1))))
(append! chars (char-from-code (+ (* d1 16) d2)))
(hs-advance! 2))
(error "Invalid hexadecimal escape: \\x")))
:else
(do (append! chars "\\") (append! chars ch) (hs-advance! 1)))))
(loop)) (loop))
(= (hs-cur) quote-char) (= (hs-cur) quote-char)
(hs-advance! 1) (hs-advance! 1)
@@ -461,23 +428,12 @@
hs-emit! hs-emit!
(fn (fn
(type value start) (type value start)
(let (append! tokens (hs-make-token type value start))))
((tok (hs-make-token type value start))
(end-pos (max pos (+ start (if (nil? value) 0 (len (str value)))))))
(do
(dict-set! tok "end" end-pos)
(dict-set! tok "line" (len (split (slice src 0 start) "\n")))
(append! tokens tok)))))
(define (define
scan! scan!
(fn (fn
() ()
(let (skip-ws!)
((ws-start pos))
(skip-ws!)
(when
(and (> (len tokens) 0) (> pos ws-start))
(hs-emit! "whitespace" (slice src ws-start pos) ws-start)))
(when (when
(< pos src-len) (< pos src-len)
(let (let
@@ -501,15 +457,6 @@
(do (hs-emit! "selector" (read-selector) start) (scan!)) (do (hs-emit! "selector" (read-selector) start) (scan!))
(and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) ".")) (and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) "."))
(do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!)) (do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!))
(and
(= ch ".")
(< (+ pos 1) src-len)
(or (hs-letter? (hs-peek 1)) (= (hs-peek 1) "-") (= (hs-peek 1) "_"))
(> (len tokens) 0)
(let
((lt (dict-get (nth tokens (- (len tokens) 1)) :type)))
(or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close"))))
(do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!))
(and (and
(= ch ".") (= ch ".")
(< (+ pos 1) src-len) (< (+ pos 1) src-len)
@@ -521,15 +468,6 @@
(hs-advance! 1) (hs-advance! 1)
(hs-emit! "class" (read-class-name pos) start) (hs-emit! "class" (read-class-name pos) start)
(scan!)) (scan!))
(and
(= ch "#")
(< (+ pos 1) src-len)
(hs-ident-start? (hs-peek 1))
(> (len tokens) 0)
(let
((lt (dict-get (nth tokens (- (len tokens) 1)) :type)))
(or (= lt "paren-close") (= lt "brace-close") (= lt "bracket-close"))))
(do (hs-emit! "op" "#" start) (hs-advance! 1) (scan!))
(and (and
(= ch "#") (= ch "#")
(< (+ pos 1) src-len) (< (+ pos 1) src-len)
@@ -598,26 +536,10 @@
(do (do
(let (let
((word (read-ident start))) ((word (read-ident start)))
(let (hs-emit!
((full-word (if (hs-keyword? word) "keyword" "ident")
(if word
(and start))
(< pos src-len)
(= (hs-cur) "'")
(< (+ pos 1) src-len)
(hs-letter? (hs-peek 1))
(not
(and
(= (hs-peek 1) "s")
(or
(>= (+ pos 2) src-len)
(not (hs-ident-char? (hs-peek 2)))))))
(do (hs-advance! 1) (str word "'" (read-ident pos)))
word)))
(hs-emit!
(if (hs-keyword? full-word) "keyword" "ident")
full-word
start)))
(scan!)) (scan!))
(and (and
(or (= ch "=") (= ch "!") (= ch "<") (= ch ">")) (or (= ch "=") (= ch "!") (= ch "<") (= ch ">"))
@@ -698,82 +620,7 @@
(do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!)) (do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!))
(= ch "|") (= ch "|")
(do (hs-emit! "op" "|" start) (hs-advance! 1) (scan!)) (do (hs-emit! "op" "|" start) (hs-advance! 1) (scan!))
(= ch "&")
(do (hs-emit! "op" "&" start) (hs-advance! 1) (scan!))
(= ch "#")
(do (hs-emit! "op" "#" start) (hs-advance! 1) (scan!))
(= ch "?")
(do (hs-emit! "op" "?" start) (hs-advance! 1) (scan!))
(= ch ";")
(do (hs-emit! "op" ";" start) (hs-advance! 1) (scan!))
:else (do (hs-advance! 1) (scan!))))))) :else (do (hs-advance! 1) (scan!)))))))
(scan!) (scan!)
(hs-emit! "eof" nil pos) (hs-emit! "eof" nil pos)
tokens)))
;; ── Template-mode tokenizer (E37 API) ────────────────────────────────
;; Used by hs-tokens-of when :template flag is set.
;; Emits outer " chars as single STRING tokens; ${ ... } as $ { <inner-tokens> };
;; inner content is tokenized with the regular hs-tokenize.
(define
hs-tokenize-template
(fn
(src)
(let
((tokens (list)) (pos 0) (src-len (len src)))
(define t-cur (fn () (if (< pos src-len) (nth src pos) nil)))
(define t-peek (fn (n) (if (< (+ pos n) src-len) (nth src (+ pos n)) nil)))
(define t-advance! (fn (n) (set! pos (+ pos n))))
(define t-emit! (fn (type value) (append! tokens (hs-make-token type value pos))))
(define
scan-to-close!
(fn
(depth)
(when
(and (< pos src-len) (> depth 0))
(cond
(= (t-cur) "{")
(do (t-advance! 1) (scan-to-close! (+ depth 1)))
(= (t-cur) "}")
(when (> (- depth 1) 0) (t-advance! 1) (scan-to-close! (- depth 1)))
:else (do (t-advance! 1) (scan-to-close! depth))))))
(define
scan-template!
(fn
()
(when
(< pos src-len)
(let
((ch (t-cur)))
(cond
(= ch "\"")
(do (t-emit! "string" "\"") (t-advance! 1) (scan-template!))
(and (= ch "$") (= (t-peek 1) "{"))
(do
(t-emit! "op" "$")
(t-advance! 1)
(t-emit! "brace-open" "{")
(t-advance! 1)
(let
((inner-start pos))
(scan-to-close! 1)
(let
((inner-src (slice src inner-start pos))
(inner-toks (hs-tokenize inner-src)))
(for-each
(fn (tok)
(when (not (= (get tok "type") "eof"))
(append! tokens tok)))
inner-toks))
(t-emit! "brace-close" "}")
(when (< pos src-len) (t-advance! 1)))
(scan-template!))
(= ch "$")
(do (t-emit! "op" "$") (t-advance! 1) (scan-template!))
(hs-ws? ch)
(do (t-advance! 1) (scan-template!))
:else (do (t-advance! 1) (scan-template!)))))))
(scan-template!)
(t-emit! "eof" nil)
tokens))) tokens)))

View File

@@ -46045,7 +46045,7 @@ d2=133,bi=102,bh="Re__Hash_set",cA="Stdlib__Type",cB=114,fF="Stdlib__Buffer",dX=
} }
return trampoline(eval_expr(Sx_types[75].call(null, mac), local)); return trampoline(eval_expr(Sx_types[75].call(null, mac), local));
} }
var step_limit = [0, 0], step_count = [0, 0], _wc_check = 0; var step_limit = [0, 0], step_count = [0, 0];
function cek_step_loop(state$0){ function cek_step_loop(state$0){
var state = state$0; var state = state$0;
for(;;){ for(;;){
@@ -46055,11 +46055,6 @@ d2=133,bi=102,bh="Re__Hash_set",cA="Stdlib__Type",cB=114,fF="Stdlib__Buffer",dX=
throw caml_maybe_attach_backtrace throw caml_maybe_attach_backtrace
([0, Sx_types[9], "TIMEOUT: step limit exceeded"], 1); ([0, Sx_types[9], "TIMEOUT: step limit exceeded"], 1);
} }
if(++_wc_check >= 10000){ _wc_check = 0;
if(globalThis.__hs_deadline && Date.now() > globalThis.__hs_deadline)
throw caml_maybe_attach_backtrace
([0, Sx_types[9], "TIMEOUT: wall clock exceeded"], 1);
}
var var
or = cek_terminal_p(state), or = cek_terminal_p(state),
or$0 = Sx_types[56].call(null, or) ? or : cek_suspended_p(state); or$0 = Sx_types[56].call(null, or) ? or : cek_suspended_p(state);

File diff suppressed because it is too large Load Diff

View File

@@ -81,7 +81,7 @@ class El {
hasAttribute(n) { return n in this.attributes; } hasAttribute(n) { return n in this.attributes; }
addEventListener(e,f) { if(!this._listeners[e])this._listeners[e]=[]; this._listeners[e].push(f); } addEventListener(e,f) { if(!this._listeners[e])this._listeners[e]=[]; this._listeners[e].push(f); }
removeEventListener(e,f) { if(this._listeners[e])this._listeners[e]=this._listeners[e].filter(x=>x!==f); } removeEventListener(e,f) { if(this._listeners[e])this._listeners[e]=this._listeners[e].filter(x=>x!==f); }
dispatchEvent(ev) { ev.target=ev.target||this; ev.currentTarget=this; const fns=[...(this._listeners[ev.type]||[])]; for(const f of fns){if(ev._si)break;try{f.call(this,ev);}catch(e){}} if(ev.bubbles&&!ev._sp){if(this.parentElement){this.parentElement.dispatchEvent(ev);}else if(globalThis._windowListeners){globalThis.dispatchEvent(ev);}} return !ev.defaultPrevented; } dispatchEvent(ev) { ev.target=ev.target||this; ev.currentTarget=this; const fns=[...(this._listeners[ev.type]||[])]; for(const f of fns){if(ev._si)break;try{f.call(this,ev);}catch(e){}} if(ev.bubbles&&!ev._sp&&this.parentElement){this.parentElement.dispatchEvent(ev);} return !ev.defaultPrevented; }
appendChild(c) { if(c.parentElement)c.parentElement.removeChild(c); c.parentElement=this; c.parentNode=this; this.children.push(c); this.childNodes.push(c); if(this.tagName==='SELECT'&&c.tagName==='OPTION'){this.options.push(c);if(c.selected&&this.selectedIndex<0)this.selectedIndex=this.options.length-1;} this._syncText(); return c; } appendChild(c) { if(c.parentElement)c.parentElement.removeChild(c); c.parentElement=this; c.parentNode=this; this.children.push(c); this.childNodes.push(c); if(this.tagName==='SELECT'&&c.tagName==='OPTION'){this.options.push(c);if(c.selected&&this.selectedIndex<0)this.selectedIndex=this.options.length-1;} this._syncText(); return c; }
removeChild(c) { this.children=this.children.filter(x=>x!==c); this.childNodes=this.childNodes.filter(x=>x!==c); c.parentElement=null; c.parentNode=null; this._syncText(); return c; } removeChild(c) { this.children=this.children.filter(x=>x!==c); this.childNodes=this.childNodes.filter(x=>x!==c); c.parentElement=null; c.parentNode=null; this._syncText(); return c; }
insertBefore(n,r) { if(n.parentElement)n.parentElement.removeChild(n); const i=this.children.indexOf(r); if(i>=0){this.children.splice(i,0,n);this.childNodes.splice(i,0,n);}else{this.children.push(n);this.childNodes.push(n);} n.parentElement=this;n.parentNode=this; this._syncText(); return n; } insertBefore(n,r) { if(n.parentElement)n.parentElement.removeChild(n); const i=this.children.indexOf(r); if(i>=0){this.children.splice(i,0,n);this.childNodes.splice(i,0,n);}else{this.children.push(n);this.childNodes.push(n);} n.parentElement=this;n.parentNode=this; this._syncText(); return n; }
@@ -297,15 +297,6 @@ function mt(e,s) {
const m = base.match(/^\[([^\]=]+)(?:="([^"]*)")?\]$/); const m = base.match(/^\[([^\]=]+)(?:="([^"]*)")?\]$/);
if(m) return m[2] !== undefined ? e.getAttribute(m[1]) === m[2] : e.hasAttribute(m[1]); if(m) return m[2] !== undefined ? e.getAttribute(m[1]) === m[2] : e.hasAttribute(m[1]);
} }
// Compound tag[attr=val] e.g. input[type=checkbox] or input[type="checkbox"]
if(base.includes('[')) {
const cm = base.match(/^([\w-]+)(\[.+\])$/);
if(cm) {
if(e.tagName.toLowerCase() !== cm[1]) return false;
const attrParts = cm[2].match(/^\[([^\]=]+)(?:=["']?([^"'\]]+)["']?)?\]$/);
if(attrParts) return attrParts[2] !== undefined ? e.getAttribute(attrParts[1]) === attrParts[2] : e.hasAttribute(attrParts[1]);
}
}
if(base.includes('.')) { const [tag, cls] = base.split('.'); return e.tagName.toLowerCase() === tag && e.classList.contains(cls); } if(base.includes('.')) { const [tag, cls] = base.split('.'); return e.tagName.toLowerCase() === tag && e.classList.contains(cls); }
if(base.includes('#')) { const [tag, id] = base.split('#'); return e.tagName.toLowerCase() === tag && e.id === id; } if(base.includes('#')) { const [tag, id] = base.split('#'); return e.tagName.toLowerCase() === tag && e.id === id; }
return e.tagName.toLowerCase() === base.toLowerCase(); return e.tagName.toLowerCase() === base.toLowerCase();
@@ -336,47 +327,6 @@ const document = {
createEvent(t){return new Ev(t);}, addEventListener(){}, removeEventListener(){}, createEvent(t){return new Ev(t);}, addEventListener(){}, removeEventListener(){},
}; };
globalThis.document=document; globalThis.window=globalThis; globalThis.HTMLElement=El; globalThis.Element=El; globalThis.document=document; globalThis.window=globalThis; globalThis.HTMLElement=El; globalThis.Element=El;
// window event-target shim (for hyperscript:beforeFetch and similar bubbled events)
globalThis._windowListeners={};
globalThis.addEventListener=function(e,f){if(!globalThis._windowListeners[e])globalThis._windowListeners[e]=[];globalThis._windowListeners[e].push(f);};
globalThis.removeEventListener=function(e,f){if(globalThis._windowListeners[e])globalThis._windowListeners[e]=globalThis._windowListeners[e].filter(x=>x!==f);};
globalThis.dispatchEvent=function(ev){const fns=[...(globalThis._windowListeners[ev.type]||[])];for(const f of fns){if(ev&&ev._si)break;try{f.call(globalThis,ev);}catch(e){}}return ev?!ev.defaultPrevented:true;};
// cluster-33: cookie store + document.cookie + cookies Proxy.
globalThis.__hsCookieStore = new Map();
Object.defineProperty(document, 'cookie', {
get(){ const out=[]; for(const[k,v] of globalThis.__hsCookieStore) out.push(k+'='+v); return out.join('; '); },
set(s){
const str=String(s||'');
const m=str.match(/^\s*([^=]+?)\s*=\s*([^;]*)/);
if(!m) return;
const name=m[1].trim();
const val=m[2];
if(/expires=Thu,?\s*01\s*Jan\s*1970/i.test(str) || val==='') globalThis.__hsCookieStore.delete(name);
else globalThis.__hsCookieStore.set(name, val);
},
configurable: true,
});
globalThis.cookies = new Proxy({}, {
get(_, k){
if(k==='length') return globalThis.__hsCookieStore.size;
if(k==='clear') return (name)=>globalThis.__hsCookieStore.delete(String(name));
if(k===Symbol.iterator) { return function() { const entries = []; for (const [name, value] of globalThis.__hsCookieStore) entries.push({_type:'dict', name, value}); return entries[Symbol.iterator](); }; }
if(typeof k==='symbol' || k==='_order') return undefined;
return globalThis.__hsCookieStore.has(k) ? globalThis.__hsCookieStore.get(k) : null;
},
set(_, k, v){ globalThis.__hsCookieStore.set(String(k), String(v)); return true; },
has(_, k){ return globalThis.__hsCookieStore.has(k); },
ownKeys(){ return Array.from(globalThis.__hsCookieStore.keys()); },
getOwnPropertyDescriptor(_, k){
if(globalThis.__hsCookieStore.has(k)) return {value: globalThis.__hsCookieStore.get(k), enumerable: true, configurable: true};
return undefined;
},
[Symbol.iterator]() {
const entries = [];
for (const [name, value] of globalThis.__hsCookieStore) entries.push({_type:'dict', name, value});
return entries[Symbol.iterator]();
},
});
// cluster-28: test-name-keyed confirm/prompt/alert mocks. The upstream // cluster-28: test-name-keyed confirm/prompt/alert mocks. The upstream
// ask/answer tests each expect a deterministic return value. Keyed on // ask/answer tests each expect a deterministic return value. Keyed on
// globalThis.__currentHsTestName which the test loop sets before each test. // globalThis.__currentHsTestName which the test loop sets before each test.
@@ -395,118 +345,7 @@ globalThis.prompt = function(_msg){
}; };
globalThis.Event=Ev; globalThis.CustomEvent=Ev; globalThis.NodeList=Array; globalThis.HTMLCollection=Array; globalThis.Event=Ev; globalThis.CustomEvent=Ev; globalThis.NodeList=Array; globalThis.HTMLCollection=Array;
globalThis.getComputedStyle=(e)=>e?e.style:{}; globalThis.requestAnimationFrame=(f)=>{f();return 0;}; globalThis.getComputedStyle=(e)=>e?e.style:{}; globalThis.requestAnimationFrame=(f)=>{f();return 0;};
globalThis.cancelAnimationFrame=()=>{}; globalThis.cancelAnimationFrame=()=>{}; globalThis.MutationObserver=class{observe(){}disconnect(){}};
// cluster-36b: globalFunction mock for "can call functions" test.
// The test calls globalFunction("foo") via hyperscript and checks window.calledWith.
globalThis.globalFunction = function(x) { globalThis.calledWith = x; };
// HsMutationObserver — cluster-32 mutation mock. Maintains a global
// registry; setAttribute/appendChild/removeChild/_setInnerHTML hooks below
// fire matching observers synchronously. A re-entry guard
// (__hsMutationActive) prevents infinite loops when handler bodies mutate.
globalThis.__hsMutationRegistry = [];
globalThis.__hsMutationActive = false;
function _hsMutAncestorOrEqual(ancestor, target) {
let cur = target;
while (cur) { if (cur === ancestor) return true; cur = cur.parentElement; }
return false;
}
function _hsMutMatches(reg, rec) {
const o = reg.opts;
if (!_hsMutAncestorOrEqual(reg.target, rec.target)) return false;
if (rec.type === 'attributes') {
if (!o.attributes) return false;
if (o.attributeFilter && o.attributeFilter.length > 0) {
if (!o.attributeFilter.includes(rec.attributeName)) return false;
}
return true;
}
if (rec.type === 'childList') return !!o.childList;
if (rec.type === 'characterData') return !!o.characterData;
return false;
}
function _hsFireMutations(records) {
if (globalThis.__hsMutationActive) return;
if (!records || records.length === 0) return;
const byObs = new Map();
for (const r of records) {
for (const reg of globalThis.__hsMutationRegistry) {
if (!_hsMutMatches(reg, r)) continue;
if (!byObs.has(reg.observer)) byObs.set(reg.observer, []);
byObs.get(reg.observer).push(r);
}
}
if (byObs.size === 0) return;
globalThis.__hsMutationActive = true;
try {
for (const [obs, recs] of byObs) {
try { obs._cb(recs, obs); } catch (e) {}
}
} finally {
globalThis.__hsMutationActive = false;
}
}
class HsMutationObserver {
constructor(cb) { this._cb = cb; this._regs = []; }
observe(el, opts) {
if (!el) return;
// opts is an SX dict: read fields directly. attributeFilter is an SX list
// ({_type:'list', items:[...]}) OR a JS array.
let af = opts && opts.attributeFilter;
if (af && af._type === 'list') af = af.items;
const o = {
attributes: !!(opts && opts.attributes),
childList: !!(opts && opts.childList),
characterData: !!(opts && opts.characterData),
subtree: !!(opts && opts.subtree),
attributeFilter: af || null,
};
const reg = { observer: this, target: el, opts: o };
this._regs.push(reg);
globalThis.__hsMutationRegistry.push(reg);
}
disconnect() {
for (const r of this._regs) {
const i = globalThis.__hsMutationRegistry.indexOf(r);
if (i >= 0) globalThis.__hsMutationRegistry.splice(i, 1);
}
this._regs = [];
}
takeRecords() { return []; }
}
globalThis.MutationObserver = HsMutationObserver;
// Hook El prototype methods so mutations fire registered observers.
// Hooks are no-ops while __hsMutationActive=true (prevents re-entry from
// handler bodies that themselves mutate the DOM).
(function _hookElForMutations() {
const _setAttr = El.prototype.setAttribute;
El.prototype.setAttribute = function(n, v) {
const r = _setAttr.call(this, n, v);
if (globalThis.__hsMutationRegistry.length)
_hsFireMutations([{ type: 'attributes', target: this, attributeName: String(n), oldValue: null }]);
return r;
};
const _append = El.prototype.appendChild;
El.prototype.appendChild = function(c) {
const r = _append.call(this, c);
if (globalThis.__hsMutationRegistry.length)
_hsFireMutations([{ type: 'childList', target: this, addedNodes: [c], removedNodes: [] }]);
return r;
};
const _remove = El.prototype.removeChild;
El.prototype.removeChild = function(c) {
const r = _remove.call(this, c);
if (globalThis.__hsMutationRegistry.length)
_hsFireMutations([{ type: 'childList', target: this, addedNodes: [], removedNodes: [c] }]);
return r;
};
const _setIH = El.prototype._setInnerHTML;
El.prototype._setInnerHTML = function(html) {
const r = _setIH.call(this, html);
if (globalThis.__hsMutationRegistry.length)
_hsFireMutations([{ type: 'childList', target: this, addedNodes: [], removedNodes: [] }]);
return r;
};
})();
// HsResizeObserver — cluster-26 resize mock. Keeps a per-element callback // HsResizeObserver — cluster-26 resize mock. Keeps a per-element callback
// registry so code that observes via `new ResizeObserver(cb)` still works, // registry so code that observes via `new ResizeObserver(cb)` still works,
// but HS's `on resize` uses the plain `resize` DOM event dispatched by the // but HS's `on resize` uses the plain `resize` DOM event dispatched by the
@@ -559,9 +398,6 @@ globalThis.console = { log: () => {}, error: () => {}, warn: () => {}, info: ()
const _log = _origLog; // keep reference for our own output const _log = _origLog; // keep reference for our own output
// ─── FFI ──────────────────────────────────────────────────────── // ─── FFI ────────────────────────────────────────────────────────
// JS-level reference equality for host objects (works around OCaml boxing).
// The SX `=` primitive doesn't do JS === for host objects in the WASM kernel.
K.registerNative('hs-ref-eq',a=>a[0]===a[1]);
K.registerNative('host-global',a=>{const n=a[0];return(n in globalThis)?globalThis[n]:null;}); K.registerNative('host-global',a=>{const n=a[0];return(n in globalThis)?globalThis[n]:null;});
K.registerNative('host-get',a=>{ K.registerNative('host-get',a=>{
if(a[0]==null)return null; if(a[0]==null)return null;
@@ -579,52 +415,11 @@ K.registerNative('host-get',a=>{
}); });
K.registerNative('host-set!',a=>{if(a[0]!=null){const v=a[2]; if(a[1]==='innerHTML'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0]._setInnerHTML(s);a[0][a[1]]=a[0].innerHTML;} else if(a[1]==='textContent'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0].textContent=s;a[0].innerHTML=s;for(const c of a[0].children){c.parentElement=null;c.parentNode=null;}a[0].children=[];a[0].childNodes=[];} else{a[0][a[1]]=v;}} return a[2];}); K.registerNative('host-set!',a=>{if(a[0]!=null){const v=a[2]; if(a[1]==='innerHTML'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0]._setInnerHTML(s);a[0][a[1]]=a[0].innerHTML;} else if(a[1]==='textContent'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0].textContent=s;a[0].innerHTML=s;for(const c of a[0].children){c.parentElement=null;c.parentNode=null;}a[0].children=[];a[0].childNodes=[];} else{a[0][a[1]]=v;}} return a[2];});
K.registerNative('host-call',a=>{if(_testDeadline&&Date.now()>_testDeadline)throw new Error('TIMEOUT: wall clock exceeded');const[o,m,...r]=a;if(o==null){const f=globalThis[m];return typeof f==='function'?f.apply(null,r):null;}if(o&&typeof o[m]==='function'){try{const v=o[m].apply(o,r);return v===undefined?null:v;}catch(e){return null;}}return null;}); K.registerNative('host-call',a=>{if(_testDeadline&&Date.now()>_testDeadline)throw new Error('TIMEOUT: wall clock exceeded');const[o,m,...r]=a;if(o==null){const f=globalThis[m];return typeof f==='function'?f.apply(null,r):null;}if(o&&typeof o[m]==='function'){try{const v=o[m].apply(o,r);return v===undefined?null:v;}catch(e){return null;}}return null;});
K.registerNative('host-call-fn',a=>{const[fn,argList]=a;if(typeof fn!=='function'&&!(fn&&fn.__sx_handle!==undefined))return null;const callArgs=(argList&&argList._type==='list'&&argList.items)?Array.from(argList.items):(Array.isArray(argList)?argList:[]);if(fn&&fn.__sx_handle!==undefined)return K.callFn(fn,callArgs);function sxToJs(v){if(v&&v._type==='list'&&v.items)return Array.from(v.items).map(sxToJs);return v;}try{const v=fn.apply(null,callArgs.map(sxToJs));return v===undefined?null:v;}catch(e){return null;}});
K.registerNative('host-new',a=>{const C=typeof a[0]==='string'?globalThis[a[0]]:a[0];return typeof C==='function'?new C(...a.slice(1)):null;}); K.registerNative('host-new',a=>{const C=typeof a[0]==='string'?globalThis[a[0]]:a[0];return typeof C==='function'?new C(...a.slice(1)):null;});
K.registerNative('host-callback',a=>{const fn=a[0];if(typeof fn==='function'&&fn.__sx_handle===undefined)return fn;if(fn&&fn.__sx_handle!==undefined)return function(){const r=K.callFn(fn,Array.from(arguments));if(globalThis._driveAsync)globalThis._driveAsync(r);return r;};return function(){};}); K.registerNative('host-callback',a=>{const fn=a[0];if(typeof fn==='function'&&fn.__sx_handle===undefined)return fn;if(fn&&fn.__sx_handle!==undefined)return function(){const r=K.callFn(fn,Array.from(arguments));if(globalThis._driveAsync)globalThis._driveAsync(r);return r;};return function(){};});
K.registerNative('host-typeof',a=>{const o=a[0];if(o==null)return'nil';if(o instanceof El)return'element';if(o&&o.nodeType===3)return'text';if(o instanceof Ev)return'event';if(o instanceof Promise)return'promise';return typeof o;}); K.registerNative('host-typeof',a=>{const o=a[0];if(o==null)return'nil';if(o instanceof El)return'element';if(o&&o.nodeType===3)return'text';if(o instanceof Ev)return'event';if(o instanceof Promise)return'promise';return typeof o;});
K.registerNative('host-iter?',([obj])=>obj!=null&&typeof obj[Symbol.iterator]==='function');
K.registerNative('host-to-list',([obj])=>{try{return[...obj];}catch(e){return[];}});
K.registerNative('host-await',a=>{}); K.registerNative('host-await',a=>{});
K.registerNative('load-library!',()=>false); K.registerNative('load-library!',()=>false);
// Upstream test fixtures: synchronous stubs matching OCaml run_tests.ml registrations
globalThis.promiseAString = () => 'foo';
globalThis.promiseAnInt = () => 42;
// ── JS block execution support ─────────────────────────────────
// Track promise states for synchronous introspection in hs-js-exec
const _promiseStates = new WeakMap();
const _origPReject = Promise.reject.bind(Promise);
const _origPResolve = Promise.resolve.bind(Promise);
Promise.reject = function(v) {
const p = _origPReject(v);
_promiseStates.set(p, {ok: false, value: v});
p.catch(() => {}); // suppress unhandled rejection warning
return p;
};
Promise.resolve = function(v) {
if (v && typeof v === 'object' && typeof v.then === 'function') return _origPResolve(v);
const p = _origPResolve(v);
_promiseStates.set(p, {ok: true, value: v});
return p;
};
K.registerNative('host-new-function', a => {
const paramList = a[0];
const src = a[1];
const params = paramList && paramList._type === 'list' && paramList.items
? Array.from(paramList.items)
: Array.isArray(paramList) ? paramList : [];
try { return new Function(...params, src); } catch(e) { return null; }
});
K.registerNative('host-promise-state', a => {
const p = a[0];
if (!p || typeof p.then !== 'function') return null;
const s = _promiseStates.get(p);
if (!s) return null;
return {ok: s.ok, value: s.value};
});
let _testDeadline = 0; let _testDeadline = 0;
// Mock fetch routes // Mock fetch routes
@@ -635,41 +430,23 @@ const _fetchRoutes = {
'/number': { status: 200, body: '1.2' }, '/number': { status: 200, body: '1.2' },
'/users/Joe': { status: 200, body: 'Joe', json: '{"name":"Joe"}' }, '/users/Joe': { status: 200, body: 'Joe', json: '{"name":"Joe"}' },
}; };
// Per-test fetch overrides keyed by test name; takes priority over _fetchRoutes.
const _fetchScripts = {
"as response does not throw on 404":
{ "/test": { status: 404, body: "not found" } },
"do not throw passes through 404 response":
{ "/test": { status: 404, body: "the body" } },
"don't throw passes through 404 response":
{ "/test": { status: 404, body: "the body" } },
"throws on non-2xx response by default":
{ "/test": { status: 404, body: "not found" } },
"Response can be converted to JSON via as JSON":
{ "/test": { status: 200, body: '{"name":"Joe"}', json: '{"name":"Joe"}',
contentType: "application/json" } },
"can catch an error that occurs when using fetch":
{ "/test": { networkError: true } },
"triggers an event just before fetching":
{ "/test": { status: 200, body: "yay", contentType: "text/html" } },
"can do a simple fetch w/ a custom conversion":
{ "/test": { status: 200, body: "1.2" } },
};
function _mockFetch(url) { function _mockFetch(url) {
const scriptRoutes = _fetchScripts[globalThis.__currentHsTestName]; const route = _fetchRoutes[url] || _fetchRoutes['/test'];
const route = (scriptRoutes && scriptRoutes[url]) || _fetchRoutes[url] || _fetchRoutes['/test']; return { ok: route.status < 400, status: route.status || 200, url: url || '/test',
return { ok: (route.status||200) < 400, status: route.status || 200, url: url || '/test',
_body: route.body || '', _json: route.json || route.body || '', _html: route.html || route.body || '' }; _body: route.body || '', _json: route.json || route.body || '', _html: route.html || route.body || '' };
} }
globalThis._driveAsync=function driveAsync(r,d){d=d||0;if(_testDeadline && Date.now()>_testDeadline)throw new Error('TIMEOUT: wall clock exceeded');if(d>500||!r||!r.suspended)return;const req=r.request;const items=req&&(req.items||req);const op=items&&items[0];const opName=typeof op==='string'?op:(op&&op.name)||String(op); globalThis._driveAsync=function driveAsync(r,d){d=d||0;if(d>500||!r||!r.suspended)return;if(_testDeadline && Date.now()>_testDeadline)throw new Error('TIMEOUT: wall clock exceeded');const req=r.request;const items=req&&(req.items||req);const op=items&&items[0];const opName=typeof op==='string'?op:(op&&op.name)||String(op);
function doResume(v){try{const x=r.resume(v);driveAsync(x,d+1);}catch(e){const msg=e&&(e.message||(Array.isArray(e)&&typeof e[2]==='string'&&e[2])||'');if(String(msg).includes('TIMEOUT'))throw e;}} function doResume(v){try{const x=r.resume(v);driveAsync(x,d+1);}catch(e){}}
if(opName==='io-sleep'||opName==='wait')doResume(null); if(opName==='io-sleep'||opName==='wait')doResume(null);
else if(opName==='io-fetch'){ else if(opName==='io-fetch'){
const url=typeof items[1]==='string'?items[1]:'/test'; const url=typeof items[1]==='string'?items[1]:'/test';
const scriptRoutes=_fetchScripts[globalThis.__currentHsTestName]; const fmt=typeof items[2]==='string'?items[2]:'text';
const route=(scriptRoutes&&scriptRoutes[url])||_fetchRoutes[url]||_fetchRoutes['/test']; const route=_fetchRoutes[url]||_fetchRoutes['/test'];
if(route&&route.networkError){doResume({_type:'dict','_network-error':true,message:'aborted'});} if(fmt==='json'){try{doResume(JSON.parse(route.json||route.body||'{}'));}catch(e){doResume(null);}}
else{const st=route.status||200;doResume({_type:'dict',ok:st<400,status:st,url,_body:route.body||'',_json:route.json||route.body||'',_html:route.html||route.body||'',_number:route.number||route.body||''});} else if(fmt==='html'){const frag=new El('fragment');frag.nodeType=11;frag.innerHTML=route.html||route.body||'';frag.textContent=frag.innerHTML.replace(/<[^>]*>/g,'');doResume(frag);}
else if(fmt==='response')doResume({ok:(route.status||200)<400,status:route.status||200,url});
else if(fmt.toLowerCase()==='number')doResume(parseFloat(route.number||route.body||'0'));
else doResume(route.body||'');
} }
else if(opName==='io-parse-text'){const resp=items&&items[1];doResume(resp&&resp._body?resp._body:typeof resp==='string'?resp:'');} else if(opName==='io-parse-text'){const resp=items&&items[1];doResume(resp&&resp._body?resp._body:typeof resp==='string'?resp:'');}
else if(opName==='io-parse-json'){const resp=items&&items[1];try{doResume(JSON.parse(typeof resp==='string'?resp:resp&&resp._json?resp._json:'{}'));}catch(e){doResume(null);}} else if(opName==='io-parse-json'){const resp=items&&items[1];try{doResume(JSON.parse(typeof resp==='string'?resp:resp&&resp._json?resp._json:'{}'));}catch(e){doResume(null);}}
@@ -763,31 +540,11 @@ for(let i=startTest;i<Math.min(endTest,testCount);i++){
// Reset body // Reset body
_body.children=[];_body.childNodes=[];_body.innerHTML='';_body.textContent=''; _body.children=[];_body.childNodes=[];_body.innerHTML='';_body.textContent='';
globalThis.__test_selection=''; globalThis.__test_selection='';
globalThis.__hsCookieStore.clear();
globalThis.__hsMutationRegistry.length = 0;
globalThis.__hsMutationActive = false;
globalThis._windowListeners={};
globalThis.__currentHsTestName = name; globalThis.__currentHsTestName = name;
// Hypertrace tests use async wait loops that legitimately exceed the step limit. // Enable step limit for timeout protection
// Disable CEK step counting for these — wall-clock deadline still applies. setStepLimit(STEP_LIMIT);
const _NO_STEP_LIMIT = new Set([ _testDeadline = Date.now() + 10000; // 10 second wall-clock timeout per test
"async hypertrace is reasonable",
"hypertrace from javascript is reasonable",
"hypertrace is reasonable",
]);
// Enable step limit for timeout protection — reset counter first so accumulation
// across tests doesn't cause signed-32-bit wraparound (~2B extra steps before limit fires).
// Hypertrace tests instrument every evaluation and legitimately exceed the step limit.
resetStepCount();
setStepLimit(_NO_STEP_LIMIT.has(name) ? 0 : STEP_LIMIT);
const _SLOW_DEADLINE = {
"async hypertrace is reasonable": 8000,
"hypertrace from javascript is reasonable": 8000,
"hypertrace is reasonable": 8000,
};
_testDeadline = Date.now() + (_SLOW_DEADLINE[name] || 10000);
globalThis.__hs_deadline = _testDeadline; // expose to WASM cek_step_loop
if(process.env.HS_VERBOSE)process.stderr.write(`T${i} `); if(process.env.HS_VERBOSE)process.stderr.write(`T${i} `);
let ok=false,err=null; let ok=false,err=null;
@@ -817,7 +574,7 @@ for(let i=startTest;i<Math.min(endTest,testCount);i++){
else if(err&&err.includes('Unhandled'))t='unhandled'; else if(err&&err.includes('Unhandled'))t='unhandled';
errTypes[t]=(errTypes[t]||0)+1; errTypes[t]=(errTypes[t]||0)+1;
} }
_testDeadline = 0; globalThis.__hs_deadline = 0; _testDeadline = 0;
if((i+1)%100===0)process.stdout.write(` ${i+1}/${testCount} (${passed} pass, ${failed} fail)\n`); if((i+1)%100===0)process.stdout.write(` ${i+1}/${testCount} (${passed} pass, ${failed} fail)\n`);
if(elapsed > 5000)process.stdout.write(` SLOW: test ${i} took ${elapsed}ms [${suite}] ${name}\n`); if(elapsed > 5000)process.stdout.write(` SLOW: test ${i} took ${elapsed}ms [${suite}] ${name}\n`);
if(!ok && err && err.includes('TIMEOUT'))process.stdout.write(` TIMEOUT: test ${i} [${suite}] ${name}\n`); if(!ok && err && err.includes('TIMEOUT'))process.stdout.write(` TIMEOUT: test ${i} [${suite}] ${name}\n`);

View File

@@ -106,11 +106,27 @@ SKIP_TEST_NAMES = {
# upstream 'on' category — missing runtime features # upstream 'on' category — missing runtime features
"listeners on other elements are removed when the registering element is removed", "listeners on other elements are removed when the registering element is removed",
"listeners on self are not removed when the element is removed", "listeners on self are not removed when the element is removed",
"can pick detail fields out by name",
"can pick event properties out by name",
"can be in a top level script tag", "can be in a top level script tag",
"multiple event handlers at a time are allowed to execute with the every keyword", "multiple event handlers at a time are allowed to execute with the every keyword",
"can filter events based on count",
"can filter events based on count range",
"can filter events based on unbounded count range",
"can mix ranges",
"can listen for general mutations",
"can listen for attribute mutations",
"can listen for specific attribute mutations",
"can listen for childList mutations",
"can listen for multiple mutations",
"can listen for multiple mutations 2",
"can listen for attribute mutations on other elements",
"each behavior installation has its own event queue", "each behavior installation has its own event queue",
"can catch exceptions thrown in js functions", "can catch exceptions thrown in js functions",
"can catch exceptions thrown in hyperscript functions", "can catch exceptions thrown in hyperscript functions",
"uncaught exceptions trigger 'exception' event",
"rethrown exceptions trigger 'exception' event",
"rethrown exceptions trigger 'exception' event",
"basic finally blocks work", "basic finally blocks work",
"finally blocks work when exception thrown in catch", "finally blocks work when exception thrown in catch",
"async basic finally blocks work", "async basic finally blocks work",
@@ -120,148 +136,26 @@ SKIP_TEST_NAMES = {
"can ignore when target doesn't exist", "can ignore when target doesn't exist",
"can ignore when target doesn\\'t exist", "can ignore when target doesn\\'t exist",
"can handle an or after a from clause", "can handle an or after a from clause",
# upstream 'fetch' category — real DocumentFragment semantics (`its childElementCount` "on first click fires only once",
# after `as html`) not exercisable with our DOM mock. "supports \"elsewhere\" modifier",
"supports \"from elsewhere\" modifier",
# upstream 'def' category — namespaced def + dynamic `me` inside callee
"functions can be namespaced",
"is called synchronously",
"can call asynchronously",
# upstream 'fetch' category — depend on per-test sinon stubs for 404 / thrown errors,
# or on real DocumentFragment semantics (`its childElementCount` after `as html`).
# Our generic test-runner mock returns a fixed 200 response, so these cases
# (non-2xx handling, error path, before-fetch event, real DOM fragment) can't be
# exercised here.
"can do a simple fetch w/ html", "can do a simple fetch w/ html",
} "triggers an event just before fetching",
"can catch an error that occurs when using fetch",
# Manually-written SX test bodies for tests whose upstream body cannot be "throws on non-2xx response by default",
# auto-translated. Key = test name; value = SX lines to emit inside deftest. "do not throw passes through 404 response",
MANUAL_TEST_BODIES = { "don't throw passes through 404 response",
"converts multiple selects with programmatically changed selections": [ "as response does not throw on 404",
' (let ((_node (dom-create-element "form")))', "Response can be converted to JSON via as JSON",
' (dom-set-inner-html _node "<select name=\"animal\" multiple> <option value=\"dog\" selected>Doggo</option> <option value=\"cat\">Kitteh</option> <option value=\"raccoon\" selected>Trash Panda</option> <option value=\"possum\">Sleepy Boi</option> </select>")',
' (let ((_sel (dom-query _node "select")))',
' (let ((_opts (host-get _sel "options")))',
' (host-set! (nth _opts 0) "selected" false)',
' (host-set! (nth _opts 1) "selected" true)',
' (let ((_result (eval-hs-locals "x as Values" (list (list (quote x) _node)))))',
' (assert= (nth (host-get _result "animal") 0) "cat")',
' (assert= (nth (host-get _result "animal") 1) "raccoon")',
' ))))',
],
"iterate cookies values work": [
' (hs-cleanup!)',
' (host-set! (host-global "cookies") "foo" "bar")',
' (let ((_names (list)) (_values (list)))',
' (hs-for-each',
' (fn (x)',
' (append! _names (host-get x "name"))',
' (append! _values (host-get x "value")))',
' (host-global "cookies"))',
' (assert-contains "foo" _names)',
' (assert-contains "bar" _values))',
],
"raises a helpful error when the worker plugin is not installed": [
' (hs-cleanup!)',
' (let ((caught nil))',
' (guard (_e (true (set! caught (str _e))))',
' (hs-compile "worker MyWorker def noop() end end"))',
' (assert (not (nil? caught)))',
' (assert (string-contains? caught "worker plugin"))',
' (assert (string-contains? caught "hyperscript.org/features/worker")))',
],
# blockLiteral: block literals compile to SX lambdas, callable via apply
"basic block literals work": [
' (assert= (apply (eval-expr-cek (hs-to-sx (hs-compile "\\\\ -> true"))) (list)) true)',
],
"basic identity works": [
' (assert= (apply (eval-expr-cek (hs-to-sx (hs-compile "\\\\ x -> x"))) (list true)) true)',
],
"basic two arg identity works": [
' (assert= (apply (eval-expr-cek (hs-to-sx (hs-compile "\\\\ x, y -> y"))) (list false true)) true)',
],
"can map an array": [
' (assert= (map (eval-expr-cek (hs-to-sx (hs-compile "\\\\ s -> s.length"))) (list "a" "ab" "abc")) (list 1 2 3))',
],
# bootstrap: restore correct bodies that auto-regen gets wrong
"can call functions": [
' (hs-cleanup!)',
' (host-set! (host-global "window") "calledWith" nil)',
' (let ((_el-div (dom-create-element "div")))',
' (dom-set-attr _el-div "_" "on click call globalFunction(\\"foo\\")")',
' (dom-append (dom-body) _el-div)',
' (hs-activate! _el-div)',
' (dom-dispatch _el-div "click" nil)',
' )',
],
"cleanup removes event listeners on the element": [
' (hs-cleanup!)',
' (let ((_el-div (dom-create-element "div")))',
' (dom-set-attr _el-div "_" "on click add .foo")',
' (dom-append (dom-body) _el-div)',
' (hs-activate! _el-div)',
' (dom-dispatch _el-div "click" nil)',
' (assert (dom-has-class? _el-div "foo"))',
' (hs-deactivate! _el-div)',
' (dom-remove-class _el-div "foo")',
' (dom-dispatch _el-div "click" nil)',
' (assert (not (dom-has-class? _el-div "foo"))))',
],
"reinitializes if script attribute changes": [
' (hs-cleanup!)',
' (let ((_el-div (dom-create-element "div")))',
' (dom-set-attr _el-div "_" "on click add .foo")',
' (dom-append (dom-body) _el-div)',
' (hs-activate! _el-div)',
' (dom-dispatch _el-div "click" nil)',
' (assert (dom-has-class? _el-div "foo"))',
' (dom-set-attr _el-div "_" "on click add .bar")',
' (hs-activate! _el-div)',
' (dom-dispatch _el-div "click" nil)',
' (assert (dom-has-class? _el-div "bar")))',
],
# on: event destructuring — on EVENT(prop) extracts from detail then event
"can pick detail fields out by name": [
' (hs-cleanup!)',
' (let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))',
' (dom-set-attr _el-d1 "id" "d1")',
' (dom-set-attr _el-d1 "_" "on click send custom(foo:\\"fromBar\\") to #d2")',
' (dom-set-attr _el-d2 "id" "d2")',
' (dom-set-attr _el-d2 "_" "on custom(foo) call me.classList.add(foo)")',
' (dom-append (dom-body) _el-d1)',
' (dom-append (dom-body) _el-d2)',
' (hs-activate! _el-d1)',
' (hs-activate! _el-d2)',
' (assert (not (dom-has-class? _el-d2 "fromBar")))',
' (dom-dispatch _el-d1 "click" nil)',
' (assert (dom-has-class? _el-d2 "fromBar")))',
],
"can pick event properties out by name": [
' (hs-cleanup!)',
' (let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))',
' (dom-set-attr _el-d1 "id" "d1")',
' (dom-set-attr _el-d1 "_" "on click send fromBar to #d2")',
' (dom-set-attr _el-d2 "id" "d2")',
' (dom-set-attr _el-d2 "_" "on fromBar(type) call me.classList.add(type)")',
' (dom-append (dom-body) _el-d1)',
' (dom-append (dom-body) _el-d2)',
' (hs-activate! _el-d1)',
' (hs-activate! _el-d2)',
' (assert (not (dom-has-class? _el-d2 "fromBar")))',
' (dom-dispatch _el-d1 "click" nil)',
' (assert (dom-has-class? _el-d2 "fromBar")))',
],
"rethrown exceptions trigger 'exception' event": [
' (hs-cleanup!)',
' (let ((_el-button (dom-create-element "button")))',
' (dom-set-attr _el-button "_"',
' "on click put \\"foo\\" into me then throw \\"bar\\" catch e throw e on exception(error) put error into me")',
' (dom-append (dom-body) _el-button)',
' (hs-activate! _el-button)',
' (dom-dispatch _el-button "click" nil)',
' (assert= (dom-text-content _el-button) "bar"))',
],
"uncaught exceptions trigger 'exception' event": [
' (hs-cleanup!)',
' (let ((_el-button (dom-create-element "button")))',
' (dom-set-attr _el-button "_"',
' "on click put \\"foo\\" into me then throw \\"bar\\" on exception(error) put error into me")',
' (dom-append (dom-body) _el-button)',
' (hs-activate! _el-button)',
' (dom-dispatch _el-button "click" nil)',
' (assert= (dom-text-content _el-button) "bar"))',
],
} }
@@ -334,18 +228,11 @@ def parse_html(html):
# button HTML in `properly processes hyperscript X` tests). HTMLParser handles # button HTML in `properly processes hyperscript X` tests). HTMLParser handles
# backslashes in attribute values as literal characters, so we leave them. # backslashes in attribute values as literal characters, so we leave them.
# HTML5 void elements — never have children, auto-pop from stack immediately.
VOID_TAGS = {'area','base','br','col','embed','hr','img','input','link',
'meta','param','source','track','wbr'}
elements = [] elements = []
stack = [] stack = []
class Parser(HTMLParser): class Parser(HTMLParser):
def handle_starttag(self, tag, attrs): def handle_starttag(self, tag, attrs):
# Pop any void elements left on the stack (they have no close tag).
while stack and stack[-1]['tag'] in VOID_TAGS:
stack.pop()
el = { el = {
'tag': tag, 'id': None, 'classes': [], 'hs': None, 'tag': tag, 'id': None, 'classes': [], 'hs': None,
'attrs': {}, 'inner': '', 'depth': len(stack), 'attrs': {}, 'inner': '', 'depth': len(stack),
@@ -375,9 +262,6 @@ def parse_html(html):
elements.append(el) elements.append(el)
def handle_endtag(self, tag): def handle_endtag(self, tag):
# Pop void elements first (they don't have close tags but may linger).
while stack and stack[-1]['tag'] in VOID_TAGS:
stack.pop()
if stack and stack[-1]['tag'] == tag: if stack and stack[-1]['tag'] == tag:
stack.pop() stack.pop()
@@ -1097,24 +981,6 @@ def parse_dev_body(body, elements, var_names):
else: else:
pre_setups.append(('__hs_config__', op_expr)) pre_setups.append(('__hs_config__', op_expr))
continue continue
# window.addEventListener(EVT, (param) => { param.target.PROP = 'VAL'; })
wa = re.search(
r"window\.addEventListener\(\s*(['\"])([^'\"]+)\1\s*,\s*"
r"\((\w+)\)\s*=>\s*\{\s*\3\.target\.(\w+)\s*=\s*['\"]([^'\"]+)['\"]\s*;?\s*\}",
m.group(1),
)
if wa:
ev_name = wa.group(2)
prop = wa.group(4)
val = wa.group(5)
attr = 'class' if prop == 'className' else prop
sx = (f'(host-call (host-global "window") "addEventListener" "{ev_name}" '
f'(fn (_event) (dom-set-attr (host-get _event "target") "{attr}" "{val}")))')
if seen_html:
ops.append(sx)
else:
pre_setups.append(('__hs_config__', sx))
continue
# fall through # fall through
# evaluate(() => _hyperscript.config.X = ...) single-line variant. # evaluate(() => _hyperscript.config.X = ...) single-line variant.
@@ -1300,32 +1166,6 @@ def parse_dev_body(body, elements, var_names):
ops.append(f'(if (dom-has-class? {target} "{cls}") (dom-remove-class {target} "{cls}") (dom-add-class {target} "{cls}"))') ops.append(f'(if (dom-has-class? {target} "{cls}") (dom-remove-class {target} "{cls}") (dom-add-class {target} "{cls}"))')
continue continue
# evaluate(() => document.querySelector(SEL).setAttribute(NAME, VALUE))
# — used by mutation tests (cluster 32) to trigger MutationObserver.
m = re.match(
r'''evaluate\(\s*\(\)\s*=>\s*document\.querySelector\(\s*([\'"])([^\'"]+)\1\s*\)'''
r'''\.setAttribute\(\s*([\'"])([\w-]+)\3\s*,\s*([\'"])([^\'"]*)\5\s*\)\s*\)\s*$''',
stmt_na, re.DOTALL,
)
if m and seen_html:
sel = re.sub(r'^#work-area\s+', '', m.group(2))
target = selector_to_sx(sel, elements, var_names)
ops.append(f'(dom-set-attr {target} "{m.group(4)}" "{m.group(6)}")')
continue
# evaluate(() => document.querySelector(SEL).appendChild(document.createElement(TAG)))
# — used by mutation childList tests (cluster 32).
m = re.match(
r'''evaluate\(\s*\(\)\s*=>\s*document\.querySelector\(\s*([\'"])([^\'"]+)\1\s*\)'''
r'''\.appendChild\(\s*document\.createElement\(\s*([\'"])([\w-]+)\3\s*\)\s*\)\s*\)\s*$''',
stmt_na, re.DOTALL,
)
if m and seen_html:
sel = re.sub(r'^#work-area\s+', '', m.group(2))
target = selector_to_sx(sel, elements, var_names)
ops.append(f'(dom-append {target} (dom-create-element "{m.group(4)}"))')
continue
# evaluate(() => { var range = document.createRange(); # evaluate(() => { var range = document.createRange();
# var textNode = document.getElementById(ID).firstChild; # var textNode = document.getElementById(ID).firstChild;
# range.setStart(textNode, N); range.setEnd(textNode, M); # range.setStart(textNode, N); range.setEnd(textNode, M);
@@ -1406,9 +1246,7 @@ def process_hs_val(hs_val):
hs_val = hs_val.replace('\\n', '\n').replace('\\t', ' ') hs_val = hs_val.replace('\\n', '\n').replace('\\t', ' ')
# Preserve escaped quotes (\" → placeholder), strip remaining backslashes, restore # Preserve escaped quotes (\" → placeholder), strip remaining backslashes, restore
hs_val = hs_val.replace('\\"', '\x00QUOT\x00') hs_val = hs_val.replace('\\"', '\x00QUOT\x00')
hs_val = hs_val.replace('\\$', '\x00DOLLAR\x00') # preserve \$ template escape
hs_val = hs_val.replace('\\', '') hs_val = hs_val.replace('\\', '')
hs_val = hs_val.replace('\x00DOLLAR\x00', '\\$') # restore \$
hs_val = hs_val.replace('\x00QUOT\x00', '\\"') hs_val = hs_val.replace('\x00QUOT\x00', '\\"')
# Strip line comments BEFORE newline collapse — once newlines become `then`, # Strip line comments BEFORE newline collapse — once newlines become `then`,
# an unterminated `//` / ` --` comment would consume the rest of the input. # an unterminated `//` / ` --` comment would consume the rest of the input.
@@ -1561,21 +1399,6 @@ def generate_test_pw(test, elements, var_names, idx):
if test['name'] in SKIP_TEST_NAMES: if test['name'] in SKIP_TEST_NAMES:
return emit_skip_test(test) return emit_skip_test(test)
# Special case: init+def ordering. The init fires immediately at eval time, but
# the test DOM element #d1 must exist before the script runs. Create #d1 first.
if test.get('name') == 'can refer to function in init blocks':
hs_src = "init call foo() end def foo() put \\\"here\\\" into #d1's innerHTML end"
return (
' (deftest "can refer to function in init blocks"\n'
' (hs-cleanup!)\n'
' (let ((_el-d1 (dom-create-element "div")))\n'
' (dom-set-attr _el-d1 "id" "d1")\n'
' (dom-append (dom-body) _el-d1)\n'
' (guard (_e (true nil)) (eval-expr-cek (hs-to-sx (hs-compile "' + hs_src + '"))))\n'
' (assert= (dom-text-content (dom-query-by-id "d1")) "here"))\n'
' )'
)
pre_setups, ops = parse_dev_body(test['body'], elements, var_names) pre_setups, ops = parse_dev_body(test['body'], elements, var_names)
# `<script type="text/hyperscript">` blocks appear in both the # `<script type="text/hyperscript">` blocks appear in both the
@@ -1820,13 +1643,6 @@ def js_expr_to_sx(expr):
if s is None: if s is None:
return None return None
arg_sx.append(s) arg_sx.append(s)
# Translate common array HO methods to SX primitives so SX lists work.
if method == 'reduce' and len(arg_sx) == 2:
return f'(reduce {arg_sx[0]} {arg_sx[1]} {obj})'
if method == 'map' and len(arg_sx) == 1:
return f'(map {arg_sx[0]} {obj})'
if method == 'filter' and len(arg_sx) == 1:
return f'(filter {arg_sx[0]} {obj})'
return f'(host-call {obj} "{method}" {" ".join(arg_sx)})'.strip() return f'(host-call {obj} "{method}" {" ".join(arg_sx)})'.strip()
# Property access: o.prop # Property access: o.prop
@@ -1999,272 +1815,6 @@ def extract_hs_expr(raw):
return expr return expr
def generate_tokenizer_test(test, safe_name):
"""Hardcoded SX translation for _hyperscript.internals.tokenizer tests (E37)."""
name = test['name']
def to_(src, tmpl=False):
"""Return (hs-tokens-of <sx-str> [:template]) for HS source string src."""
escaped = (src
.replace('\\', '\\\\')
.replace('"', '\\"')
.replace('\n', '\\n')
.replace('\r', '\\r')
.replace('\t', '\\t'))
q = '"' + escaped + '"'
suffix = ' :template' if tmpl else ''
return f'(hs-tokens-of {q}{suffix})'
def consume(s):
return f'(hs-stream-consume {s})'
def tok_i(s, i):
return f'(hs-stream-token {s} {i})'
def has_more(s):
return f'(hs-stream-has-more {s})'
def t_type(t):
return f'(hs-token-type {t})'
def t_val(t):
return f'(hs-token-value {t})'
def t_op(t):
return f'(hs-token-op? {t})'
def nth_list(s, i):
return f'(nth (get {s} "list") {i})'
def list_len(s):
return f'(len (get {s} "list"))'
def ae(actual, expected):
return f' (assert= {actual} {expected})'
def throws(expr):
return (
f' (let ((threw false))\n'
f' (guard (e (true (set! threw true))) {expr})\n'
f' (assert threw))'
)
lines = [f' (deftest "{safe_name}"']
if name == 'handles $ in template properly':
s = to_('"', tmpl=True)
lines.append(ae(t_val(tok_i(s, 0)), sx_str('"')))
elif name == 'handles all special escapes properly':
for src, exp in [
('"\\b"', '(char-from-code 8)'),
('"\\f"', '(char-from-code 12)'),
('"\\n"', '"\\n"'),
('"\\r"', '"\\r"'),
('"\\t"', '"\\t"'),
('"\\v"', '(char-from-code 11)'),
]:
lines.append(ae(t_val(consume(to_(src))), exp))
elif name == 'handles basic token types':
lines.append(ae(t_type(consume(to_('foo'))), '"IDENTIFIER"'))
lines.append(ae(t_type(consume(to_('1'))), '"NUMBER"'))
for src in ['1.1', '1e6', '1e-6', '1.1e6', '1.1e-6']:
sq = to_(src)
lines.append(f' (let ((s {sq}))')
lines.append(f' (let ((tok (hs-stream-consume s)))')
lines.append(f' (assert= (hs-token-type tok) "NUMBER")')
lines.append(f' (assert= (hs-stream-has-more s) false)))')
lines.append(ae(t_type(consume(to_('.a'))), '"CLASS_REF"'))
lines.append(ae(t_type(consume(to_('#a'))), '"ID_REF"'))
lines.append(ae(t_type(consume(to_('"asdf"'))), '"STRING"'))
elif name == 'handles class identifiers properly':
for src, idx, exp_type, exp_val in [
('.a', None, 'CLASS_REF', '.a'),
(' .a', None, 'CLASS_REF', '.a'),
('a.a', None, 'IDENTIFIER', 'a'),
('(a).a', 4, 'IDENTIFIER', 'a'),
('{a}.a', 4, 'IDENTIFIER', 'a'),
('[a].a', 4, 'IDENTIFIER', 'a'),
('(a(.a', 3, 'CLASS_REF', '.a'),
('{a{.a', 3, 'CLASS_REF', '.a'),
('[a[.a', 3, 'CLASS_REF', '.a'),
]:
if idx is None:
tok_expr = consume(to_(src))
else:
tok_expr = nth_list(to_(src), idx)
lines.append(ae(t_type(tok_expr), f'"{exp_type}"'))
lines.append(ae(t_val(tok_expr), sx_str(exp_val)))
elif name == 'handles comments properly':
for src, expected in [
('--', 0),
('asdf--', 1),
('-- asdf', 0),
('--\nasdf', 1),
('--\nasdf--', 1),
('---asdf', 0),
('----\n---asdf', 0),
('----asdf----', 0),
('---\nasdf---', 1),
('// asdf', 0),
('///asdf', 0),
('asdf//', 1),
('asdf\n//', 2),
]:
lines.append(ae(list_len(to_(src)), str(expected)))
elif name == 'handles hex escapes properly':
lines.append(ae(t_val(consume(to_('"\\x1f"'))), '(char-from-code 31)'))
lines.append(ae(t_val(consume(to_('"\\x41"'))), '"A"'))
lines.append(ae(t_val(consume(to_('"\\x41\\x61"'))), '"Aa"'))
for bad in ['"\\x"', '"\\xGG"', '"\\x4"']:
lines.append(throws(consume(to_(bad))))
elif name == 'handles id references properly':
for src, idx, exp_type, exp_val in [
('#a', None, 'ID_REF', '#a'),
(' #a', None, 'ID_REF', '#a'),
('a#a', None, 'IDENTIFIER', 'a'),
('(a)#a', 4, 'IDENTIFIER', 'a'),
('{a}#a', 4, 'IDENTIFIER', 'a'),
('[a]#a', 4, 'IDENTIFIER', 'a'),
('(a(#a', 3, 'ID_REF', '#a'),
('{a{#a', 3, 'ID_REF', '#a'),
('[a[#a', 3, 'ID_REF', '#a'),
]:
if idx is None:
tok_expr = consume(to_(src))
else:
tok_expr = nth_list(to_(src), idx)
lines.append(ae(t_type(tok_expr), f'"{exp_type}"'))
lines.append(ae(t_val(tok_expr), sx_str(exp_val)))
elif name == 'handles identifiers properly':
lines.append(ae(t_type(consume(to_('foo'))), '"IDENTIFIER"'))
lines.append(ae(t_val(consume(to_('foo'))), '"foo"'))
lines.append(ae(t_type(consume(to_(' foo '))), '"IDENTIFIER"'))
lines.append(ae(t_val(consume(to_(' foo '))), '"foo"'))
for src, v1, v2 in [
(' foo bar', 'foo', 'bar'),
(' foo\n-- a comment\n bar', 'foo', 'bar'),
]:
sq = to_(src)
lines.append(f' (let ((s {sq}))')
lines.append(f' (let ((tok1 (hs-stream-consume s)))')
lines.append(f' (assert= (hs-token-type tok1) "IDENTIFIER")')
lines.append(f' (assert= (hs-token-value tok1) {sx_str(v1)})')
lines.append(f' (let ((tok2 (hs-stream-consume s)))')
lines.append(f' (assert= (hs-token-type tok2) "IDENTIFIER")')
lines.append(f' (assert= (hs-token-value tok2) {sx_str(v2)}))))')
elif name == 'handles identifiers with numbers properly':
for src in ['f1oo', 'fo1o', 'foo1']:
lines.append(ae(t_type(consume(to_(src))), '"IDENTIFIER"'))
lines.append(ae(t_val(consume(to_(src))), sx_str(src)))
elif name == 'handles look ahead property':
s = to_('a 1 + 1')
for i, v in [(0, 'a'), (1, '1'), (2, '+'), (3, '1'), (4, '<<<EOF>>>')]:
lines.append(ae(t_val(tok_i(s, i)), sx_str(v)))
elif name == 'handles numbers properly':
for src, v in [
('1', '1'),
('1.1', '1.1'),
('1234567890.1234567890', '1234567890.1234567890'),
('1e6', '1e6'),
('1e-6', '1e-6'),
('1.1e6', '1.1e6'),
('1.1e-6', '1.1e-6'),
]:
lines.append(ae(t_type(consume(to_(src))), '"NUMBER"'))
lines.append(ae(t_val(consume(to_(src))), sx_str(v)))
s = to_('1.1.1')
toks = f'(get {s} "list")'
lines.append(ae(f'(hs-token-type (nth {toks} 0))', '"NUMBER"'))
lines.append(ae(f'(hs-token-type (nth {toks} 1))', '"PERIOD"'))
lines.append(ae(f'(hs-token-type (nth {toks} 2))', '"NUMBER"'))
lines.append(ae(f'(len {toks})', '3'))
elif name == 'handles operators properly':
optable = [
('+', 'PLUS'), ('-', 'MINUS'), ('*', 'MULTIPLY'),
('.', 'PERIOD'), ('\\', 'BACKSLASH'), (':', 'COLON'),
('%', 'PERCENT'), ('|', 'PIPE'), ('!', 'EXCLAMATION'),
('?', 'QUESTION'), ('#', 'POUND'), ('&', 'AMPERSAND'),
(';', 'SEMI'), (',', 'COMMA'), ('(', 'L_PAREN'),
(')', 'R_PAREN'), ('<', 'L_ANG'), ('>', 'R_ANG'),
('{', 'L_BRACE'), ('}', 'R_BRACE'), ('[', 'L_BRACKET'),
(']', 'R_BRACKET'), ('=', 'EQUALS'),
('<=', 'LTE_ANG'), ('>=', 'GTE_ANG'),
('==', 'EQ'), ('===', 'EQQ'),
]
for op_char, _op_name in optable:
tok_expr = consume(to_(op_char))
lines.append(ae(t_op(tok_expr), 'true'))
lines.append(ae(t_val(tok_expr), sx_str(op_char)))
elif name == 'handles strings properly':
for src, v in [
('"foo"', 'foo'),
('"fo\'o"', "fo'o"),
('"fo\\"o"', 'fo"o'),
("'foo'", 'foo'),
("'fo\"o'", 'fo"o'),
("'fo\\'o'", "fo'o"),
]:
lines.append(ae(t_type(consume(to_(src))), '"STRING"'))
lines.append(ae(t_val(consume(to_(src))), sx_str(v)))
lines.append(throws(consume(to_("'"))))
lines.append(throws(consume(to_('"'))))
elif name == 'handles strings properly 2':
tok_expr = consume(to_("'foo'"))
lines.append(ae(t_type(tok_expr), '"STRING"'))
lines.append(ae(t_val(tok_expr), '"foo"'))
elif name == 'handles template bootstrap properly':
s1 = to_('"', tmpl=True)
lines.append(ae(t_val(tok_i(s1, 0)), sx_str('"')))
s2 = to_('"$', tmpl=True)
lines.append(ae(t_val(tok_i(s2, 0)), sx_str('"')))
lines.append(ae(t_val(tok_i(s2, 1)), '"$"'))
s3 = to_('"${', tmpl=True)
lines.append(ae(t_val(tok_i(s3, 0)), sx_str('"')))
lines.append(ae(t_val(tok_i(s3, 1)), '"$"'))
lines.append(ae(t_val(tok_i(s3, 2)), '"{"'))
s4 = to_('"${"asdf"', tmpl=True)
lines.append(ae(t_val(tok_i(s4, 0)), sx_str('"')))
lines.append(ae(t_val(tok_i(s4, 1)), '"$"'))
lines.append(ae(t_val(tok_i(s4, 2)), '"{"'))
lines.append(ae(t_val(tok_i(s4, 3)), '"asdf"'))
s5 = to_('"${"asdf"}"', tmpl=True)
lines.append(ae(t_val(tok_i(s5, 0)), sx_str('"')))
lines.append(ae(t_val(tok_i(s5, 1)), '"$"'))
lines.append(ae(t_val(tok_i(s5, 2)), '"{"'))
lines.append(ae(t_val(tok_i(s5, 3)), '"asdf"'))
lines.append(ae(t_val(tok_i(s5, 4)), '"}"'))
lines.append(ae(t_val(tok_i(s5, 5)), sx_str('"')))
elif name == 'handles whitespace properly':
for src, expected in [
(' ', 0), (' asdf', 1), (' asdf ', 2), ('asdf ', 2),
('\n', 0), ('\nasdf', 1), ('\nasdf\n', 2), ('asdf\n', 2),
('\r', 0), ('\rasdf', 1), ('\rasdf\r', 2), ('asdf\r', 2),
('\t', 0), ('\tasdf', 1), ('\tasdf\t', 2), ('asdf\t', 2),
]:
lines.append(ae(list_len(to_(src)), str(expected)))
else:
return None # not a tokenizer test we handle
lines.append(' )')
return '\n'.join(lines)
def generate_eval_only_test(test, idx): def generate_eval_only_test(test, idx):
"""Generate SX deftest for no-HTML tests using eval-hs. """Generate SX deftest for no-HTML tests using eval-hs.
Handles patterns: Handles patterns:
@@ -2282,146 +1832,6 @@ def generate_eval_only_test(test, idx):
lines = [] lines = []
safe_name = sx_name(test['name']) safe_name = sx_name(test['name'])
# Special case: cluster-33 cookie tests. Each test calls a sequence of
# `_hyperscript("HS")` inside `page.evaluate(()=>{...})`. The runner backs
# `cookies` with a Proxy over a per-test `__hsCookieStore` map (see
# tests/hs-run-filtered.js). Tests handled: basic set, length-when-empty,
# update. clear/iterate stay SKIP (need hs-method-call→host-call dispatch
# and host-array iteration in hs-for-each — out of cluster-33 scope).
if test['name'] == 'basic set cookie values work':
return (
f' (deftest "{safe_name}"\n'
f' (hs-cleanup!)\n'
f' (assert (nil? (eval-hs "cookies.foo")))\n'
f' (eval-hs "set cookies.foo to \'bar\'")\n'
f' (assert= (eval-hs "cookies.foo") "bar"))'
)
if test['name'] == 'update cookie values work':
return (
f' (deftest "{safe_name}"\n'
f' (hs-cleanup!)\n'
f' (eval-hs "set cookies.foo to \'bar\'")\n'
f' (assert= (eval-hs "cookies.foo") "bar")\n'
f' (eval-hs "set cookies.foo to \'doh\'")\n'
f' (assert= (eval-hs "cookies.foo") "doh"))'
)
if test['name'] == 'length is 0 when no cookies are set':
return (
f' (deftest "{safe_name}"\n'
f' (hs-cleanup!)\n'
f' (assert= (eval-hs "cookies.length") 0))'
)
if test['name'] == 'basic clear cookie values work':
return (
f' (deftest "{safe_name}"\n'
f' (hs-cleanup!)\n'
f' (eval-hs "set cookies.foo to \'bar\'")\n'
f' (assert= (eval-hs "cookies.foo") "bar")\n'
f' (eval-hs "call cookies.clear(\'foo\')")\n'
f' (assert (nil? (eval-hs "cookies.foo"))))'
)
# Special case: cluster-29 init events. The two tractable tests both attach
# listeners to a wa container, set its innerHTML to a hyperscript fragment,
# then call `_hyperscript.processNode(wa)`. Hand-roll deftests using
# hs-boot-subtree! which now dispatches hyperscript:before:init / :after:init.
if test.get('name') == 'fires hyperscript:before:init and hyperscript:after:init':
return (
f' (deftest "{safe_name}"\n'
f' (hs-cleanup!)\n'
f' (let ((wa (dom-create-element "div"))\n'
f' (events (list)))\n'
f' (dom-listen wa "hyperscript:before:init"\n'
f' (fn (e) (set! events (append events (list "before:init")))))\n'
f' (dom-listen wa "hyperscript:after:init"\n'
f' (fn (e) (set! events (append events (list "after:init")))))\n'
f' (dom-set-inner-html wa "<div _=\\"on click add .foo\\"></div>")\n'
f' (hs-boot-subtree! wa)\n'
f' (assert= events (list "before:init" "after:init")))\n'
f' )'
)
if test.get('name') == 'hyperscript:before:init can cancel initialization':
return (
f' (deftest "{safe_name}"\n'
f' (hs-cleanup!)\n'
f' (let ((wa (dom-create-element "div")))\n'
f' (dom-listen wa "hyperscript:before:init"\n'
f' (fn (e) (host-call e "preventDefault")))\n'
f' (dom-set-inner-html wa "<div _=\\"on click add .foo\\"></div>")\n'
f' (hs-boot-subtree! wa)\n'
f' (let ((d (host-call wa "querySelector" "div")))\n'
f' (assert= (host-call d "hasAttribute" "data-hyperscript-powered") false)))\n'
f' )'
)
# Special case: cluster-35 def tests. Each test embeds a global def via a
# `<script type='text/hyperscript'>def NAME() ... end</script>` tag and
# then a `<div _='on click call NAME() ...'>` that invokes it. Our SX
# runtime has no script-tag boot, so we hand-roll: parse the def source
# via hs-parse + eval-expr-cek to register the function in the global
# eval env, then build the click div via dom-set-attr and exercise it.
if test.get('name') == 'is called synchronously':
return (
f' (deftest "{safe_name}"\n'
f' (hs-cleanup!)\n'
f' (eval-expr-cek (hs-to-sx (first (hs-parse (hs-tokenize "def foo() log me end")))))\n'
f' (let ((wa (dom-create-element "div"))\n'
f' (b (dom-create-element "div"))\n'
f' (d1 (dom-create-element "div")))\n'
f' (dom-set-attr d1 "id" "d1")\n'
f' (dom-set-attr b "_" "on click call foo() then add .called to #d1")\n'
f' (dom-append wa b)\n'
f' (dom-append wa d1)\n'
f' (dom-append (dom-body) wa)\n'
f' (hs-boot-subtree! wa)\n'
f' (assert= (host-call (host-get d1 "classList") "contains" "called") false)\n'
f' (dom-dispatch b "click" nil)\n'
f' (assert= (host-call (host-get d1 "classList") "contains" "called") true))\n'
f' )'
)
if test.get('name') == 'can call asynchronously':
return (
f' (deftest "{safe_name}"\n'
f' (hs-cleanup!)\n'
f' (eval-expr-cek (hs-to-sx (first (hs-parse (hs-tokenize "def foo() wait 1ms log me end")))))\n'
f' (let ((wa (dom-create-element "div"))\n'
f' (b (dom-create-element "div"))\n'
f' (d1 (dom-create-element "div")))\n'
f' (dom-set-attr d1 "id" "d1")\n'
f' (dom-set-attr b "_" "on click call foo() then add .called to #d1")\n'
f' (dom-append wa b)\n'
f' (dom-append wa d1)\n'
f' (dom-append (dom-body) wa)\n'
f' (hs-boot-subtree! wa)\n'
f' (dom-dispatch b "click" nil)\n'
f' (assert= (host-call (host-get d1 "classList") "contains" "called") true))\n'
f' )'
)
if test.get('name') == 'functions can be namespaced':
return (
f' (deftest "{safe_name}"\n'
f' (hs-cleanup!)\n'
f' ;; Manually create utils dict with foo as a callable. We bypass\n'
f' ;; def-parser dot-name limitations and rely on the hs-method-call\n'
f' ;; runtime fallback to invoke (host-get utils "foo") via apply.\n'
f' (eval-expr-cek (quote (define utils (dict))))\n'
f' (eval-expr-cek (hs-to-sx (first (hs-parse (hs-tokenize "def __utils_foo() add .called to #d1 end")))))\n'
f' (eval-expr-cek (quote (host-set! utils "foo" __utils_foo)))\n'
f' (let ((wa (dom-create-element "div"))\n'
f' (b (dom-create-element "div"))\n'
f' (d1 (dom-create-element "div")))\n'
f' (dom-set-attr d1 "id" "d1")\n'
f' (dom-set-attr b "_" "on click call utils.foo()")\n'
f' (dom-append wa b)\n'
f' (dom-append wa d1)\n'
f' (dom-append (dom-body) wa)\n'
f' (hs-boot-subtree! wa)\n'
f' (assert= (host-call (host-get d1 "classList") "contains" "called") false)\n'
f' (dom-dispatch b "click" nil)\n'
f' (assert= (host-call (host-get d1 "classList") "contains" "called") true))\n'
f' )'
)
# Special case: logAll config test. Body sets `_hyperscript.config.logAll = true`, # Special case: logAll config test. Body sets `_hyperscript.config.logAll = true`,
# then mutates an element's innerHTML and calls `_hyperscript.processNode`. # then mutates an element's innerHTML and calls `_hyperscript.processNode`.
# Our runtime exposes this via hs-set-log-all! + hs-log-captured; we reuse # Our runtime exposes this via hs-set-log-all! + hs-log-captured; we reuse
@@ -2442,50 +1852,6 @@ def generate_eval_only_test(test, idx):
f' )' f' )'
) )
# Special case: cluster-38 sourceInfo tests.
if test['name'] == 'debug':
return (
f' (deftest "{safe_name}"\n'
f' (assert= (hs-src "<button.foo/>") "<button.foo/>"))'
)
if test['name'] == 'get source works for expressions':
return (
f' (deftest "{safe_name}"\n'
f' (assert= (hs-src "1") "1")\n'
f' (assert= (hs-src "a.b") "a.b")\n'
f' (assert= (hs-src-at "a.b" (list :root)) "a")\n'
f' (assert= (hs-src "a.b()") "a.b()")\n'
f' (assert= (hs-src-at "a.b()" (list :root)) "a.b")\n'
f' (assert= (hs-src-at "a.b()" (list :root :root)) "a")\n'
f' (assert= (hs-src "<button.foo/>") "<button.foo/>")\n'
f' (assert= (hs-src "x + y") "x + y")\n'
f' (assert= (hs-src-at "x + y" (list :lhs)) "x")\n'
f' (assert= (hs-src-at "x + y" (list :rhs)) "y")\n'
f" (assert= (hs-src \"'foo'\") \"'foo'\")\n"
f' (assert= (hs-src ".foo") ".foo")\n'
f' (assert= (hs-src "#bar") "#bar"))'
)
if test['name'] == 'get source works for statements':
return (
f' (deftest "{safe_name}"\n'
f" (assert= (hs-src \"if true log 'it was true'\") \"if true log 'it was true'\")\n"
f' (assert= (hs-src "for x in [1, 2, 3] log x then log x end") "for x in [1, 2, 3] log x then log x end"))'
)
if test['name'] == 'get line works for statements':
src = "if true\\n log 'it was true'\\n log 'it was true'"
return (
f' (deftest "{safe_name}"\n'
f' (assert= (hs-line-at "{src}" (list)) "if true")\n'
f" (assert= (hs-line-at \"{src}\" (list :true-branch)) \" log 'it was true'\")\n"
f" (assert= (hs-line-at \"{src}\" (list :true-branch :next)) \" log 'it was true'\"))"
)
if '_hyperscript.internals.tokenizer' in body:
return generate_tokenizer_test(test, safe_name)
lines.append(f' (deftest "{safe_name}"') lines.append(f' (deftest "{safe_name}"')
assertions = [] assertions = []
@@ -2497,20 +1863,13 @@ def generate_eval_only_test(test, idx):
def emit_eval(hs_expr, expected_sx, extra_locals=None): def emit_eval(hs_expr, expected_sx, extra_locals=None):
"""Emit an assertion using eval-hs / eval-hs-locals / eval-hs-with-me """Emit an assertion using eval-hs / eval-hs-locals / eval-hs-with-me
as appropriate, given the window setups and any per-call locals. as appropriate, given the window setups and any per-call locals.
Uses assert-equal (deep equal?) when expected contains dicts; assert= otherwise.
""" """
pairs = list(window_setups) + list(extra_locals or []) pairs = list(window_setups) + list(extra_locals or [])
# assert= uses = (reference equality for dicts); assert-equal uses equal? (deep)
use_deep = '{' in expected_sx
if pairs: if pairs:
locals_sx = '(list ' + ' '.join( locals_sx = '(list ' + ' '.join(
f'(list (quote {n}) {v})' for n, v in pairs f'(list (quote {n}) {v})' for n, v in pairs
) + ')' ) + ')'
if use_deep:
return f' (assert-equal {expected_sx} (eval-hs-locals "{hs_expr}" {locals_sx}))'
return f' (assert= (eval-hs-locals "{hs_expr}" {locals_sx}) {expected_sx})' return f' (assert= (eval-hs-locals "{hs_expr}" {locals_sx}) {expected_sx})'
if use_deep:
return f' (assert-equal {expected_sx} (eval-hs "{hs_expr}"))'
return f' (assert= (eval-hs "{hs_expr}") {expected_sx})' return f' (assert= (eval-hs "{hs_expr}") {expected_sx})'
# Shared sub-pattern for run() call with optional String.raw and extra args: # Shared sub-pattern for run() call with optional String.raw and extra args:
@@ -2911,20 +2270,6 @@ def generate_eval_only_test(test, idx):
expected_sx = js_val_to_sx(be_match.group(1)) expected_sx = js_val_to_sx(be_match.group(1))
assertions.append(f' (assert= (eval-hs "{hs_expr}") {expected_sx})') assertions.append(f' (assert= (eval-hs "{hs_expr}") {expected_sx})')
# Pattern 2d: evalStatically() + toMatch(/cannot be evaluated statically/)
# Handles: try { _hyperscript.parse("expr").evalStatically(); } catch(e) { return e.message; }
# followed by: expect(msg).toMatch(/cannot be evaluated statically/)
# Uses guard directly because try-call in hs-run-filtered.js is a registration stub
# and assert-throws cannot catch exceptions during test execution.
if not assertions:
if 'evalStatically' in body and 'cannot be evaluated statically' in body:
for m in re.finditer(
r'_hyperscript\.parse\((["\x27])(.+?)\1\)\.evalStatically\(\)',
body
):
hs_expr = extract_hs_expr(m.group(2))
assertions.append(f' (guard (_e (true nil)) (hs-eval-statically "{hs_expr}") (error "hs-eval-statically did not throw for: {hs_expr}"))')
# Pattern 2e: run() with side-effects on window, checked via # Pattern 2e: run() with side-effects on window, checked via
# const X = await evaluate(() => <js-expr>); expect(X).toBe(val) # const X = await evaluate(() => <js-expr>); expect(X).toBe(val)
# The const holds the evaluated JS expr, not the run() return value, # The const holds the evaluated JS expr, not the run() return value,
@@ -2986,16 +2331,7 @@ def generate_eval_only_test(test, idx):
body, re.DOTALL body, re.DOTALL
): ):
hs_expr = extract_hs_expr(m.group(2)) hs_expr = extract_hs_expr(m.group(2))
assertions.append(f' (assert-throws (fn () (eval-hs "{hs_expr}")))') assertions.append(f' (assert-throws (eval-hs "{hs_expr}"))')
# Pattern 4: error("expr").toBeNull() — parsing/eval must not throw
if not assertions:
for m in re.finditer(
r'error\((["\x27])(.+?)\1\).*?toBeNull\(\)',
body, re.DOTALL
):
hs_expr = extract_hs_expr(m.group(2))
assertions.append(f' (hs-compile "{hs_expr}")')
if not assertions: if not assertions:
return None # Can't convert this body pattern return None # Can't convert this body pattern
@@ -3036,11 +2372,6 @@ def generate_compile_only_test(test):
def generate_test(test, idx): def generate_test(test, idx):
"""Generate SX deftest for an upstream test. Dispatches to Chai, PW, or eval-only.""" """Generate SX deftest for an upstream test. Dispatches to Chai, PW, or eval-only."""
if test['name'] in MANUAL_TEST_BODIES:
name = sx_name(test['name'])
lines = [f' (deftest "{name}"'] + MANUAL_TEST_BODIES[test['name']] + [' )']
return '\n'.join(lines)
elements = parse_html(test['html']) elements = parse_html(test['html'])
if not elements and not test.get('html', '').strip(): if not elements and not test.get('html', '').strip():
@@ -3281,7 +2612,6 @@ output.append(';; Bind `window` and `document` as plain SX symbols so HS code th
output.append(';; references them (e.g. `window.tmp`) can resolve through the host.') output.append(';; references them (e.g. `window.tmp`) can resolve through the host.')
output.append('(define window (host-global "window"))') output.append('(define window (host-global "window"))')
output.append('(define document (host-global "document"))') output.append('(define document (host-global "document"))')
output.append('(define cookies (host-global "cookies"))')
output.append('') output.append('')
output.append('(define hs-test-el') output.append('(define hs-test-el')
output.append(' (fn (tag hs-src)') output.append(' (fn (tag hs-src)')
@@ -3293,11 +2623,7 @@ output.append(' el)))')
output.append('') output.append('')
output.append('(define hs-cleanup!') output.append('(define hs-cleanup!')
output.append(' (fn ()') output.append(' (fn ()')
output.append(' (begin') output.append(' (dom-set-inner-html (dom-body) "")))')
output.append(' (dom-set-inner-html (dom-body) "")')
output.append(' ;; Reset global runtime state that prior tests may have set.')
output.append(' (hs-set-default-hide-strategy! nil)')
output.append(' (hs-set-log-all! false))))')
output.append('') output.append('')
output.append(';; Evaluate a hyperscript expression and return either the expression') output.append(';; Evaluate a hyperscript expression and return either the expression')
output.append(';; value or `it` (whichever is non-nil). Multi-statement scripts that') output.append(';; value or `it` (whichever is non-nil). Multi-statement scripts that')
@@ -3366,17 +2692,6 @@ output.append(' (nth _e 1)')
output.append(' (raise _e))))') output.append(' (raise _e))))')
output.append(' (handler me-val))))))') output.append(' (handler me-val))))))')
output.append('') output.append('')
output.append(';; Evaluate a HS expression using evalStatically semantics:')
output.append(';; only literal values (numbers, strings, booleans, null, time units)')
output.append(';; succeed — any other expression raises "cannot be evaluated statically".')
output.append('(define hs-eval-statically')
output.append(' (fn (src)')
output.append(' (let ((ast (hs-compile src)))')
output.append(' (if (or (number? ast) (string? ast) (boolean? ast)')
output.append(' (and (list? ast) (= (first ast) (quote null-literal))))')
output.append(' (eval-hs src)')
output.append(' (raise "cannot be evaluated statically")))))')
output.append('')
# Group by category # Group by category
categories = OrderedDict() categories = OrderedDict()