Compare commits

...

14 Commits

Author SHA1 Message Date
41fac7ac29 Merge branch 'hs-e40-fetch' into loops/hs
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 16s
2026-04-26 17:54:34 +00:00
4c48a8dd57 Merge branch 'hs-e37-tokenizer' into loops/hs 2026-04-26 17:54:11 +00:00
a48110417b HS: DOM ref-eq + compound selector + DOM tree fixes
- hs-id= uses JS === for DOM elements (hs-ref-eq), = for scalars
- != operator now uses hs-id= for structural correctness
- compound tag[attr=val] selector matching in test runner
- dom-query-all replaces host-call querySelectorAll
- DOM tree structure corrected in 4 generated tests (elements were
  appended to wrong parents)
2026-04-26 17:49:51 +00:00
4c43918a99 HS-plan: E40 done +7; scoreboard 1310/1496 (+97)
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-26 11:34:51 +00:00
d7244d1dc8 HS: hyperscript:beforeFetch event + runner dict format (+1 test)
- hs-fetch gains target param; dispatches hyperscript:beforeFetch before fetch
- compiler emits (quote me) as target arg
- runner io-fetch returns unified dict {_type:'dict', ok, status, _body, ...}
  so runtime (get raw :key) calls work correctly (22/23 fetch tests pass)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-26 11:33:04 +00:00
1b1b67c72e HS: fetch don't throw contraction (+1 test) 2026-04-26 10:15:44 +00:00
3a755947ef HS: fetch do-not-throw modifier (+1 test) 2026-04-26 10:03:06 +00:00
880503e2b6 HS E37: tokenizer-as-API 17/17 (+fixes)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 16s
- runtime.sx: fix extra ) in hs-tokens-of (parse error); add hs-eof-sentinel,
  hs-raw->api-token, hs-normalize-raw-tokens, hs-tokens-of, stream helpers,
  hs-token-type/value/op?; add \$ escape to hs-template
- tokenizer.sx: fix read-number double-dot bug (1.1.1 → 3 tokens); fix t-emit!
  eof call (3→2 args); add bare $ case to scan-template!
- compiler.sx: add \$ escape to tpl-collect template interpolation
- generate-sx-tests.py: preserve \$ in process_hs_val; add generate_tokenizer_test
- regen spec/tests/test-hyperscript-behavioral.sx: 17 tokenizer tests generated
- plans/hs-conformance-to-100.md: row 37 marked done +17

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-26 09:54:59 +00:00
3003c8a069 HS E37 step 5: hs-tokenize-template + template routing in hs-tokens-of
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 12s
Add hs-tokenize-template: scans " as single STRING token, ${ ... }
as dollar+brace+inner-tokens (inner tokenized with hs-tokenize), and
} as brace-close. Update hs-tokens-of to call hs-tokenize-template
when :template keyword arg is passed. Unlocks tests 1 and 15.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 19:08:38 +00:00
8c62137d32 HS E37 step 2: extend read-string escapes + unterminated/hex errors
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Add \r \b \f \v and \xNN escape handling to read-string. Use
char-from-code for non-SX-literal chars. Throw "Unterminated string"
on EOF inside a string literal. Throw "Invalid hexadecimal escape: \x"
on bad \xNN. Add hs-hex-digit? and hs-hex-val helpers. Unlocks
tests 2, 6, 13, 14 once generator lands.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 19:03:03 +00:00
8ac669c739 HS E37 step 1: hs-api-tokens + stream/token helpers in runtime.sx
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Add hs-eof-sentinel, hs-op-type, hs-raw->api-token, hs-tokens-of,
hs-stream-token, hs-stream-consume, hs-stream-has-more, and the
three token accessors (hs-token-type, hs-token-value, hs-token-op?).
No test delta yet — API-only, generator comes in step 6.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-25 18:56:26 +00:00
8e4bdb7216 HS E40: generator removes 7 E40 tests from skip-list; window.addEventListener handler (+1) 2026-04-25 18:55:40 +00:00
ea1bdab82c HS E40: window event-target shim + bubble relay to window listeners 2026-04-25 18:50:52 +00:00
04164aa2d4 HS E40: runner _fetchScripts map + networkError plumbing 2026-04-25 18:49:19 +00:00
13 changed files with 3930 additions and 3113 deletions

File diff suppressed because it is too large Load Diff

View File

@@ -550,7 +550,9 @@
(list
(quote not)
(list (quote eq-ignore-case) left right)))
(list (quote not) (list (quote =) left right)))))))
(list
(quote not)
(list (quote hs-id=) left right)))))))
((match-kw "empty") (list (quote empty?) left))
((match-kw "less")
(do
@@ -1770,7 +1772,7 @@
((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))))
(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 (= (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))))
((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))))
(let
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
(let
@@ -1786,7 +1788,27 @@
((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
((fmt (or fmt-before fmt-after "text")))
(list (quote fetch) url fmt)))))))))
(let
((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
parse-call-args
(fn

View File

@@ -650,9 +650,7 @@
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
(find-prev sibling)))))
(define
hs-query-all
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
(define hs-query-all (fn (sel) (dom-query-all (dom-body) sel)))
@@ -662,10 +660,7 @@
hs-query-all-in
(fn
(sel target)
(if
(nil? target)
(hs-query-all sel)
(host-call target "querySelectorAll" sel))))
(if (nil? target) (hs-query-all sel) (dom-query-all target sel))))
(define
hs-list-set
@@ -874,12 +869,33 @@
(define
hs-fetch
(fn
(url format)
(url format do-not-throw target)
(let
((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))))
(let
((raw (perform (list "io-fetch" url fmt))))
(cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
((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") ((or (= format "number") (= format "Number")) "number") (true format))))
(do
(when (not (nil? target))
(dom-dispatch target "hyperscript:beforeFetch" nil))
(let
((raw (perform (list "io-fetch" url "response" (dict)))))
(do
(when (get raw :_network-error) (raise {:response raw :message "Network error" :_hs-error "FetchError"}))
(when
(and (not (get raw :ok)) (not (= fmt "response")) (not do-not-throw))
(raise {:response raw :status (get raw :status) :message "Fetch error" :_hs-error "FetchError"}))
(cond
((= fmt "response") raw)
((= fmt "json")
(let
((parsed (perform (list "io-parse-json" (get raw :_json)))))
(hs-host-to-sx parsed)))
((= fmt "html")
(perform (list "io-parse-html" (get raw :_html))))
((= fmt "number")
(or
(parse-number (get raw :_number))
(parse-number (get raw :_body))
0))
(true (get raw :_body)))))))))
(define
hs-json-escape
@@ -970,6 +986,8 @@
(true (str value))))
((= type-name "JSON")
(cond
((and (dict? value) (dict-has? value :_json))
(guard (_e (true value)) (json-parse (get value :_json))))
((string? value) (guard (_e (true value)) (json-parse value)))
((dict? value) (hs-json-stringify value))
((list? value) (hs-json-stringify value))
@@ -1418,6 +1436,15 @@
hs-strict-eq
(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
hs-eq-ignore-case
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
@@ -2511,14 +2538,14 @@
((= a b) true)
(true (hs-dom-is-ancestor? a (dom-parent b))))))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-win-call
(fn
(fn-name args)
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-source-for
(fn
@@ -2534,16 +2561,9 @@
(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-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 (fn (src-str) (hs-source-for (hs-parse-ast src-str))))
(define
hs-src-at
@@ -2553,7 +2573,8 @@
walk
(fn
(node keys)
(if (or (nil? keys) (= (len keys) 0))
(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))))
@@ -2566,7 +2587,8 @@
walk
(fn
(node keys)
(if (or (nil? keys) (= (len keys) 0))
(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))))

View File

@@ -1,6 +1,6 @@
;; _hyperscript tokenizer — produces token stream from hyperscript source
;;
;; Tokens: {:type T :value V :pos P :end E :line L}
;; Tokens: {:type T :value V :pos P}
;; Types: "keyword" "ident" "number" "string" "class" "id" "attr" "style"
;; "selector" "op" "dot" "paren-open" "paren-close" "bracket-open"
;; "bracket-close" "brace-open" "brace-close" "comma" "colon"
@@ -8,7 +8,7 @@
;; ── Token constructor ─────────────────────────────────────────────
(define hs-make-token (fn (type value pos end line) {:pos pos :end end :line line :value value :type type}))
(define hs-make-token (fn (type value pos) {:pos pos :value value :type type}))
;; ── Character predicates ──────────────────────────────────────────
@@ -28,6 +28,27 @@
(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 ───────────────────────────────────────────────────
(define
@@ -198,22 +219,14 @@
(fn
(src)
(let
((tokens (list)) (pos 0) (src-len (len src)) (current-line 1))
((tokens (list)) (pos 0) (src-len (len src)))
(define
hs-peek
(fn
(offset)
(if (< (+ pos offset) src-len) (nth src (+ pos offset)) nil)))
(define hs-cur (fn () (hs-peek 0)))
(define
hs-advance!
(fn
(n)
(when
(> n 0)
(when (= (hs-cur) "\n") (set! current-line (+ current-line 1)))
(set! pos (+ pos 1))
(hs-advance! (- n 1)))))
(define hs-advance! (fn (n) (set! pos (+ pos n))))
(define
skip-ws!
(fn
@@ -243,10 +256,15 @@
read-number
(fn
(start)
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-number start))
(define
read-int
(fn
()
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-int))))
(read-int)
(when
(and
(< pos src-len)
@@ -254,15 +272,7 @@
(< (+ pos 1) src-len)
(hs-digit? (hs-peek 1)))
(hs-advance! 1)
(define
read-frac
(fn
()
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-frac))))
(read-frac))
(read-int))
(do
(when
(and
@@ -280,15 +290,7 @@
(< pos src-len)
(or (= (hs-cur) "+") (= (hs-cur) "-")))
(hs-advance! 1))
(define
read-exp-digits
(fn
()
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-exp-digits))))
(read-exp-digits))
(read-int))
(let
((num-end pos))
(when
@@ -316,7 +318,7 @@
()
(cond
(>= pos src-len)
nil
(error "Unterminated string")
(= (hs-cur) "\\")
(do
(hs-advance! 1)
@@ -326,15 +328,37 @@
((ch (hs-cur)))
(cond
(= ch "n")
(append! chars "\n")
(do (append! chars "\n") (hs-advance! 1))
(= ch "t")
(append! chars "\t")
(do (append! chars "\t") (hs-advance! 1))
(= 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 "\\")
(append! chars "\\")
(do (append! chars "\\") (hs-advance! 1))
(= ch quote-char)
(append! chars quote-char)
:else (do (append! chars "\\") (append! chars ch)))
(hs-advance! 1)))
(do (append! chars quote-char) (hs-advance! 1))
(= ch "x")
(do
(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))
(= (hs-cur) quote-char)
(hs-advance! 1)
@@ -435,8 +459,8 @@
(define
hs-emit!
(fn
(type value start start-line)
(append! tokens (hs-make-token type value start pos start-line))))
(type value start)
(append! tokens (hs-make-token type value start))))
(define
scan!
(fn
@@ -445,7 +469,7 @@
(when
(< pos src-len)
(let
((ch (hs-cur)) (start pos) (start-line current-line))
((ch (hs-cur)) (start pos))
(cond
(and (= ch "-") (< (+ pos 1) src-len) (= (hs-peek 1) "-"))
(do (hs-advance! 2) (skip-comment!) (scan!))
@@ -462,9 +486,9 @@
(= (hs-peek 1) "[")
(= (hs-peek 1) "*")
(= (hs-peek 1) ":")))
(do (hs-emit! "selector" (read-selector) start start-line) (scan!))
(do (hs-emit! "selector" (read-selector) start) (scan!))
(and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) "."))
(do (hs-advance! 2) (hs-emit! "op" ".." start start-line) (scan!))
(do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!))
(and
(= ch ".")
(< (+ pos 1) src-len)
@@ -474,7 +498,7 @@
(= (hs-peek 1) "_")))
(do
(hs-advance! 1)
(hs-emit! "class" (read-class-name pos) start start-line)
(hs-emit! "class" (read-class-name pos) start)
(scan!))
(and
(= ch "#")
@@ -482,7 +506,7 @@
(hs-ident-start? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "id" (read-ident pos) start start-line)
(hs-emit! "id" (read-ident pos) start)
(scan!))
(and
(= ch "@")
@@ -490,7 +514,7 @@
(hs-ident-char? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "attr" (read-ident pos) start start-line)
(hs-emit! "attr" (read-ident pos) start)
(scan!))
(and
(= ch "^")
@@ -498,7 +522,7 @@
(hs-ident-char? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "hat" (read-ident pos) start start-line)
(hs-emit! "hat" (read-ident pos) start)
(scan!))
(and
(= ch "~")
@@ -506,7 +530,7 @@
(hs-letter? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "component" (str "~" (read-ident pos)) start start-line)
(hs-emit! "component" (str "~" (read-ident pos)) start)
(scan!))
(and
(= ch "*")
@@ -514,7 +538,7 @@
(hs-letter? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "style" (read-ident pos) start start-line)
(hs-emit! "style" (read-ident pos) start)
(scan!))
(and
(= ch ":")
@@ -522,7 +546,7 @@
(hs-ident-start? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "local" (read-ident pos) start start-line)
(hs-emit! "local" (read-ident pos) start)
(scan!))
(or
(= ch "\"")
@@ -535,20 +559,35 @@
(or
(>= (+ pos 2) src-len)
(not (hs-ident-char? (hs-peek 2))))))))
(do (hs-emit! "string" (read-string ch) start start-line) (scan!))
(do (hs-emit! "string" (read-string ch) start) (scan!))
(= ch "`")
(do (hs-emit! "template" (read-template) start start-line) (scan!))
(do (hs-emit! "template" (read-template) start) (scan!))
(hs-digit? ch)
(do (hs-emit! "number" (read-number start) start start-line) (scan!))
(do (hs-emit! "number" (read-number start) start) (scan!))
(hs-ident-start? ch)
(do
(let
((word (read-ident start)))
(hs-emit!
(if (hs-keyword? word) "keyword" "ident")
word
start
start-line))
(let
((full-word
(if
(and
(< 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!))
(and
(or (= ch "=") (= ch "!") (= ch "<") (= ch ">"))
@@ -560,8 +599,8 @@
(or (= ch "=") (= ch "!"))
(< (+ pos 2) src-len)
(= (hs-peek 2) "="))
(do (hs-advance! 3) (hs-emit! "op" (str ch "==") start start-line))
(do (hs-advance! 2) (hs-emit! "op" (str ch "=") start start-line)))
(do (hs-emit! "op" (str ch "==") start) (hs-advance! 3))
(do (hs-emit! "op" (str ch "=") start) (hs-advance! 2)))
(scan!))
(and
(= ch "'")
@@ -570,66 +609,141 @@
(or
(>= (+ pos 2) src-len)
(not (hs-ident-char? (hs-peek 2)))))
(do (hs-advance! 2) (hs-emit! "op" "'s" start start-line) (scan!))
(do (hs-emit! "op" "'s" start) (hs-advance! 2) (scan!))
(= ch "(")
(do
(hs-emit! "paren-open" "(" start)
(hs-advance! 1)
(hs-emit! "paren-open" "(" start start-line)
(scan!))
(= ch ")")
(do
(hs-emit! "paren-close" ")" start)
(hs-advance! 1)
(hs-emit! "paren-close" ")" start start-line)
(scan!))
(= ch "[")
(do
(hs-emit! "bracket-open" "[" start)
(hs-advance! 1)
(hs-emit! "bracket-open" "[" start start-line)
(scan!))
(= ch "]")
(do
(hs-emit! "bracket-close" "]" start)
(hs-advance! 1)
(hs-emit! "bracket-close" "]" start start-line)
(scan!))
(= ch "{")
(do
(hs-emit! "brace-open" "{" start)
(hs-advance! 1)
(hs-emit! "brace-open" "{" start start-line)
(scan!))
(= ch "}")
(do
(hs-emit! "brace-close" "}" start)
(hs-advance! 1)
(hs-emit! "brace-close" "}" start start-line)
(scan!))
(= ch ",")
(do (hs-advance! 1) (hs-emit! "comma" "," start start-line) (scan!))
(do (hs-emit! "comma" "," start) (hs-advance! 1) (scan!))
(= ch "+")
(do (hs-advance! 1) (hs-emit! "op" "+" start start-line) (scan!))
(do (hs-emit! "op" "+" start) (hs-advance! 1) (scan!))
(= ch "-")
(do (hs-advance! 1) (hs-emit! "op" "-" start start-line) (scan!))
(do (hs-emit! "op" "-" start) (hs-advance! 1) (scan!))
(= ch "/")
(do (hs-advance! 1) (hs-emit! "op" "/" start start-line) (scan!))
(do (hs-emit! "op" "/" start) (hs-advance! 1) (scan!))
(= ch "=")
(do (hs-advance! 1) (hs-emit! "op" "=" start start-line) (scan!))
(do (hs-emit! "op" "=" start) (hs-advance! 1) (scan!))
(= ch "<")
(do (hs-advance! 1) (hs-emit! "op" "<" start start-line) (scan!))
(do (hs-emit! "op" "<" start) (hs-advance! 1) (scan!))
(= ch ">")
(do (hs-advance! 1) (hs-emit! "op" ">" start start-line) (scan!))
(do (hs-emit! "op" ">" start) (hs-advance! 1) (scan!))
(= ch "!")
(do (hs-advance! 1) (hs-emit! "op" "!" start start-line) (scan!))
(do (hs-emit! "op" "!" start) (hs-advance! 1) (scan!))
(= ch "*")
(do (hs-advance! 1) (hs-emit! "op" "*" start start-line) (scan!))
(do (hs-emit! "op" "*" start) (hs-advance! 1) (scan!))
(= ch "%")
(do (hs-advance! 1) (hs-emit! "op" "%" start start-line) (scan!))
(do (hs-emit! "op" "%" start) (hs-advance! 1) (scan!))
(= ch ".")
(do (hs-advance! 1) (hs-emit! "dot" "." start start-line) (scan!))
(do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!))
(= ch "\\")
(do (hs-advance! 1) (hs-emit! "op" "\\" start start-line) (scan!))
(do (hs-emit! "op" "\\" start) (hs-advance! 1) (scan!))
(= ch ":")
(do (hs-advance! 1) (hs-emit! "colon" ":" start start-line) (scan!))
(do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!))
(= ch "|")
(do (hs-advance! 1) (hs-emit! "op" "|" start start-line) (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!)))))))
(scan!)
(hs-emit! "eof" nil pos current-line)
(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)))

View File

@@ -76,7 +76,7 @@ Remaining: ~192 tests (clusters 17/29(partial)/31 blocked; 33/34 partial)
| 37 | Tokenizer-as-API | design-done | `plans/designs/e37-tokenizer-api.md` |
| 38 | SourceInfo API | design-done | `plans/designs/e38-sourceinfo.md` |
| 39 | WebWorker plugin | design-done | `plans/designs/e39-webworker.md` |
| 40 | Fetch non-2xx / before-fetch / real response | design-done | `plans/designs/e40-real-fetch.md` |
| 40 | Fetch non-2xx / before-fetch / real response | done | +7 | d7244d1d |
### Bucket F — generator translation gaps
@@ -97,7 +97,7 @@ Defer until AD drain. Estimated ~25 recoverable tests.
| B | 7 | 0 | 0 | 0 | 0 | — | 7 |
| C | 4 | 1 | 0 | 0 | 0 | — | 5 |
| D | 2 | 2 | 0 | 0 | 1 | — | 5 |
| E | 0 | 0 | 0 | 0 | 0 | 5 | 5 |
| E | 1 | 0 | 0 | 0 | 0 | 4 | 5 |
| F | — | — | — | ~10 | — | — | ~10 |
## Maintenance

View File

@@ -133,13 +133,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.
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.
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.
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.
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.
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.
### Bucket F: generator translation gaps (after bucket A-D)

File diff suppressed because it is too large Load Diff

View File

@@ -550,7 +550,9 @@
(list
(quote not)
(list (quote eq-ignore-case) left right)))
(list (quote not) (list (quote =) left right)))))))
(list
(quote not)
(list (quote hs-id=) left right)))))))
((match-kw "empty") (list (quote empty?) left))
((match-kw "less")
(do
@@ -1770,7 +1772,7 @@
((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))))
(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 (= (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))))
((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))))
(let
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
(let
@@ -1786,7 +1788,27 @@
((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
((fmt (or fmt-before fmt-after "text")))
(list (quote fetch) url fmt)))))))))
(let
((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
parse-call-args
(fn

View File

@@ -650,9 +650,7 @@
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
(find-prev sibling)))))
(define
hs-query-all
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
(define hs-query-all (fn (sel) (dom-query-all (dom-body) sel)))
@@ -662,10 +660,7 @@
hs-query-all-in
(fn
(sel target)
(if
(nil? target)
(hs-query-all sel)
(host-call target "querySelectorAll" sel))))
(if (nil? target) (hs-query-all sel) (dom-query-all target sel))))
(define
hs-list-set
@@ -874,12 +869,33 @@
(define
hs-fetch
(fn
(url format)
(url format do-not-throw target)
(let
((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))))
(let
((raw (perform (list "io-fetch" url fmt))))
(cond ((= fmt "json") (hs-host-to-sx raw)) (true raw))))))
((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") ((or (= format "number") (= format "Number")) "number") (true format))))
(do
(when (not (nil? target))
(dom-dispatch target "hyperscript:beforeFetch" nil))
(let
((raw (perform (list "io-fetch" url "response" (dict)))))
(do
(when (get raw :_network-error) (raise {:response raw :message "Network error" :_hs-error "FetchError"}))
(when
(and (not (get raw :ok)) (not (= fmt "response")) (not do-not-throw))
(raise {:response raw :status (get raw :status) :message "Fetch error" :_hs-error "FetchError"}))
(cond
((= fmt "response") raw)
((= fmt "json")
(let
((parsed (perform (list "io-parse-json" (get raw :_json)))))
(hs-host-to-sx parsed)))
((= fmt "html")
(perform (list "io-parse-html" (get raw :_html))))
((= fmt "number")
(or
(parse-number (get raw :_number))
(parse-number (get raw :_body))
0))
(true (get raw :_body)))))))))
(define
hs-json-escape
@@ -970,6 +986,8 @@
(true (str value))))
((= type-name "JSON")
(cond
((and (dict? value) (dict-has? value :_json))
(guard (_e (true value)) (json-parse (get value :_json))))
((string? value) (guard (_e (true value)) (json-parse value)))
((dict? value) (hs-json-stringify value))
((list? value) (hs-json-stringify value))
@@ -1418,6 +1436,15 @@
hs-strict-eq
(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
hs-eq-ignore-case
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
@@ -2511,14 +2538,14 @@
((= a b) true)
(true (hs-dom-is-ancestor? a (dom-parent b))))))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-win-call
(fn
(fn-name args)
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
;; ── SourceInfo API ────────────────────────────────────────────────
(define
hs-source-for
(fn
@@ -2534,16 +2561,9 @@
(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-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 (fn (src-str) (hs-source-for (hs-parse-ast src-str))))
(define
hs-src-at
@@ -2553,7 +2573,8 @@
walk
(fn
(node keys)
(if (or (nil? keys) (= (len keys) 0))
(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))))
@@ -2566,7 +2587,8 @@
walk
(fn
(node keys)
(if (or (nil? keys) (= (len keys) 0))
(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))))

View File

@@ -1,6 +1,6 @@
;; _hyperscript tokenizer — produces token stream from hyperscript source
;;
;; Tokens: {:type T :value V :pos P :end E :line L}
;; Tokens: {:type T :value V :pos P}
;; Types: "keyword" "ident" "number" "string" "class" "id" "attr" "style"
;; "selector" "op" "dot" "paren-open" "paren-close" "bracket-open"
;; "bracket-close" "brace-open" "brace-close" "comma" "colon"
@@ -8,7 +8,7 @@
;; ── Token constructor ─────────────────────────────────────────────
(define hs-make-token (fn (type value pos end line) {:pos pos :end end :line line :value value :type type}))
(define hs-make-token (fn (type value pos) {:pos pos :value value :type type}))
;; ── Character predicates ──────────────────────────────────────────
@@ -28,6 +28,27 @@
(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 ───────────────────────────────────────────────────
(define
@@ -198,22 +219,14 @@
(fn
(src)
(let
((tokens (list)) (pos 0) (src-len (len src)) (current-line 1))
((tokens (list)) (pos 0) (src-len (len src)))
(define
hs-peek
(fn
(offset)
(if (< (+ pos offset) src-len) (nth src (+ pos offset)) nil)))
(define hs-cur (fn () (hs-peek 0)))
(define
hs-advance!
(fn
(n)
(when
(> n 0)
(when (= (hs-cur) "\n") (set! current-line (+ current-line 1)))
(set! pos (+ pos 1))
(hs-advance! (- n 1)))))
(define hs-advance! (fn (n) (set! pos (+ pos n))))
(define
skip-ws!
(fn
@@ -243,10 +256,15 @@
read-number
(fn
(start)
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-number start))
(define
read-int
(fn
()
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-int))))
(read-int)
(when
(and
(< pos src-len)
@@ -254,15 +272,7 @@
(< (+ pos 1) src-len)
(hs-digit? (hs-peek 1)))
(hs-advance! 1)
(define
read-frac
(fn
()
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-frac))))
(read-frac))
(read-int))
(do
(when
(and
@@ -280,15 +290,7 @@
(< pos src-len)
(or (= (hs-cur) "+") (= (hs-cur) "-")))
(hs-advance! 1))
(define
read-exp-digits
(fn
()
(when
(and (< pos src-len) (hs-digit? (hs-cur)))
(hs-advance! 1)
(read-exp-digits))))
(read-exp-digits))
(read-int))
(let
((num-end pos))
(when
@@ -316,7 +318,7 @@
()
(cond
(>= pos src-len)
nil
(error "Unterminated string")
(= (hs-cur) "\\")
(do
(hs-advance! 1)
@@ -326,15 +328,37 @@
((ch (hs-cur)))
(cond
(= ch "n")
(append! chars "\n")
(do (append! chars "\n") (hs-advance! 1))
(= ch "t")
(append! chars "\t")
(do (append! chars "\t") (hs-advance! 1))
(= 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 "\\")
(append! chars "\\")
(do (append! chars "\\") (hs-advance! 1))
(= ch quote-char)
(append! chars quote-char)
:else (do (append! chars "\\") (append! chars ch)))
(hs-advance! 1)))
(do (append! chars quote-char) (hs-advance! 1))
(= ch "x")
(do
(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))
(= (hs-cur) quote-char)
(hs-advance! 1)
@@ -435,8 +459,8 @@
(define
hs-emit!
(fn
(type value start start-line)
(append! tokens (hs-make-token type value start pos start-line))))
(type value start)
(append! tokens (hs-make-token type value start))))
(define
scan!
(fn
@@ -445,7 +469,7 @@
(when
(< pos src-len)
(let
((ch (hs-cur)) (start pos) (start-line current-line))
((ch (hs-cur)) (start pos))
(cond
(and (= ch "-") (< (+ pos 1) src-len) (= (hs-peek 1) "-"))
(do (hs-advance! 2) (skip-comment!) (scan!))
@@ -462,9 +486,9 @@
(= (hs-peek 1) "[")
(= (hs-peek 1) "*")
(= (hs-peek 1) ":")))
(do (hs-emit! "selector" (read-selector) start start-line) (scan!))
(do (hs-emit! "selector" (read-selector) start) (scan!))
(and (= ch ".") (< (+ pos 1) src-len) (= (hs-peek 1) "."))
(do (hs-advance! 2) (hs-emit! "op" ".." start start-line) (scan!))
(do (hs-emit! "op" ".." start) (hs-advance! 2) (scan!))
(and
(= ch ".")
(< (+ pos 1) src-len)
@@ -474,7 +498,7 @@
(= (hs-peek 1) "_")))
(do
(hs-advance! 1)
(hs-emit! "class" (read-class-name pos) start start-line)
(hs-emit! "class" (read-class-name pos) start)
(scan!))
(and
(= ch "#")
@@ -482,7 +506,7 @@
(hs-ident-start? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "id" (read-ident pos) start start-line)
(hs-emit! "id" (read-ident pos) start)
(scan!))
(and
(= ch "@")
@@ -490,7 +514,7 @@
(hs-ident-char? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "attr" (read-ident pos) start start-line)
(hs-emit! "attr" (read-ident pos) start)
(scan!))
(and
(= ch "^")
@@ -498,7 +522,7 @@
(hs-ident-char? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "hat" (read-ident pos) start start-line)
(hs-emit! "hat" (read-ident pos) start)
(scan!))
(and
(= ch "~")
@@ -506,7 +530,7 @@
(hs-letter? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "component" (str "~" (read-ident pos)) start start-line)
(hs-emit! "component" (str "~" (read-ident pos)) start)
(scan!))
(and
(= ch "*")
@@ -514,7 +538,7 @@
(hs-letter? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "style" (read-ident pos) start start-line)
(hs-emit! "style" (read-ident pos) start)
(scan!))
(and
(= ch ":")
@@ -522,7 +546,7 @@
(hs-ident-start? (hs-peek 1)))
(do
(hs-advance! 1)
(hs-emit! "local" (read-ident pos) start start-line)
(hs-emit! "local" (read-ident pos) start)
(scan!))
(or
(= ch "\"")
@@ -535,20 +559,35 @@
(or
(>= (+ pos 2) src-len)
(not (hs-ident-char? (hs-peek 2))))))))
(do (hs-emit! "string" (read-string ch) start start-line) (scan!))
(do (hs-emit! "string" (read-string ch) start) (scan!))
(= ch "`")
(do (hs-emit! "template" (read-template) start start-line) (scan!))
(do (hs-emit! "template" (read-template) start) (scan!))
(hs-digit? ch)
(do (hs-emit! "number" (read-number start) start start-line) (scan!))
(do (hs-emit! "number" (read-number start) start) (scan!))
(hs-ident-start? ch)
(do
(let
((word (read-ident start)))
(hs-emit!
(if (hs-keyword? word) "keyword" "ident")
word
start
start-line))
(let
((full-word
(if
(and
(< 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!))
(and
(or (= ch "=") (= ch "!") (= ch "<") (= ch ">"))
@@ -560,8 +599,8 @@
(or (= ch "=") (= ch "!"))
(< (+ pos 2) src-len)
(= (hs-peek 2) "="))
(do (hs-advance! 3) (hs-emit! "op" (str ch "==") start start-line))
(do (hs-advance! 2) (hs-emit! "op" (str ch "=") start start-line)))
(do (hs-emit! "op" (str ch "==") start) (hs-advance! 3))
(do (hs-emit! "op" (str ch "=") start) (hs-advance! 2)))
(scan!))
(and
(= ch "'")
@@ -570,66 +609,141 @@
(or
(>= (+ pos 2) src-len)
(not (hs-ident-char? (hs-peek 2)))))
(do (hs-advance! 2) (hs-emit! "op" "'s" start start-line) (scan!))
(do (hs-emit! "op" "'s" start) (hs-advance! 2) (scan!))
(= ch "(")
(do
(hs-emit! "paren-open" "(" start)
(hs-advance! 1)
(hs-emit! "paren-open" "(" start start-line)
(scan!))
(= ch ")")
(do
(hs-emit! "paren-close" ")" start)
(hs-advance! 1)
(hs-emit! "paren-close" ")" start start-line)
(scan!))
(= ch "[")
(do
(hs-emit! "bracket-open" "[" start)
(hs-advance! 1)
(hs-emit! "bracket-open" "[" start start-line)
(scan!))
(= ch "]")
(do
(hs-emit! "bracket-close" "]" start)
(hs-advance! 1)
(hs-emit! "bracket-close" "]" start start-line)
(scan!))
(= ch "{")
(do
(hs-emit! "brace-open" "{" start)
(hs-advance! 1)
(hs-emit! "brace-open" "{" start start-line)
(scan!))
(= ch "}")
(do
(hs-emit! "brace-close" "}" start)
(hs-advance! 1)
(hs-emit! "brace-close" "}" start start-line)
(scan!))
(= ch ",")
(do (hs-advance! 1) (hs-emit! "comma" "," start start-line) (scan!))
(do (hs-emit! "comma" "," start) (hs-advance! 1) (scan!))
(= ch "+")
(do (hs-advance! 1) (hs-emit! "op" "+" start start-line) (scan!))
(do (hs-emit! "op" "+" start) (hs-advance! 1) (scan!))
(= ch "-")
(do (hs-advance! 1) (hs-emit! "op" "-" start start-line) (scan!))
(do (hs-emit! "op" "-" start) (hs-advance! 1) (scan!))
(= ch "/")
(do (hs-advance! 1) (hs-emit! "op" "/" start start-line) (scan!))
(do (hs-emit! "op" "/" start) (hs-advance! 1) (scan!))
(= ch "=")
(do (hs-advance! 1) (hs-emit! "op" "=" start start-line) (scan!))
(do (hs-emit! "op" "=" start) (hs-advance! 1) (scan!))
(= ch "<")
(do (hs-advance! 1) (hs-emit! "op" "<" start start-line) (scan!))
(do (hs-emit! "op" "<" start) (hs-advance! 1) (scan!))
(= ch ">")
(do (hs-advance! 1) (hs-emit! "op" ">" start start-line) (scan!))
(do (hs-emit! "op" ">" start) (hs-advance! 1) (scan!))
(= ch "!")
(do (hs-advance! 1) (hs-emit! "op" "!" start start-line) (scan!))
(do (hs-emit! "op" "!" start) (hs-advance! 1) (scan!))
(= ch "*")
(do (hs-advance! 1) (hs-emit! "op" "*" start start-line) (scan!))
(do (hs-emit! "op" "*" start) (hs-advance! 1) (scan!))
(= ch "%")
(do (hs-advance! 1) (hs-emit! "op" "%" start start-line) (scan!))
(do (hs-emit! "op" "%" start) (hs-advance! 1) (scan!))
(= ch ".")
(do (hs-advance! 1) (hs-emit! "dot" "." start start-line) (scan!))
(do (hs-emit! "dot" "." start) (hs-advance! 1) (scan!))
(= ch "\\")
(do (hs-advance! 1) (hs-emit! "op" "\\" start start-line) (scan!))
(do (hs-emit! "op" "\\" start) (hs-advance! 1) (scan!))
(= ch ":")
(do (hs-advance! 1) (hs-emit! "colon" ":" start start-line) (scan!))
(do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!))
(= ch "|")
(do (hs-advance! 1) (hs-emit! "op" "|" start start-line) (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!)))))))
(scan!)
(hs-emit! "eof" nil pos current-line)
(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)))

View File

@@ -1992,8 +1992,8 @@
(dom-set-attr _el-d2 "id" "d2")
(dom-set-attr _el-div "_" "on click make a <p/> then put #i1.value into its textContent put it.outerHTML at end of #d2")
(dom-append (dom-body) _el-i1)
(dom-append _el-i1 _el-d2)
(dom-append _el-i1 _el-div)
(dom-append (dom-body) _el-d2)
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil)
))
@@ -2494,41 +2494,287 @@
;; ── core/tokenizer (17 tests) ──
(defsuite "hs-upstream-core/tokenizer"
(deftest "handles $ in template properly"
(error "SKIP (untranslated): handles $ in template properly"))
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"" :template) 0)) "\"")
)
(deftest "handles all special escapes properly"
(error "SKIP (untranslated): handles all special escapes properly"))
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\b\""))) (char-from-code 8))
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\f\""))) (char-from-code 12))
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\n\""))) "\n")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\r\""))) "\r")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\t\""))) "\t")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\v\""))) (char-from-code 11))
)
(deftest "handles basic token types"
(error "SKIP (untranslated): handles basic token types"))
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "foo"))) "IDENTIFIER")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1"))) "NUMBER")
(let ((s (hs-tokens-of "1.1")))
(let ((tok (hs-stream-consume s)))
(assert= (hs-token-type tok) "NUMBER")
(assert= (hs-stream-has-more s) false)))
(let ((s (hs-tokens-of "1e6")))
(let ((tok (hs-stream-consume s)))
(assert= (hs-token-type tok) "NUMBER")
(assert= (hs-stream-has-more s) false)))
(let ((s (hs-tokens-of "1e-6")))
(let ((tok (hs-stream-consume s)))
(assert= (hs-token-type tok) "NUMBER")
(assert= (hs-stream-has-more s) false)))
(let ((s (hs-tokens-of "1.1e6")))
(let ((tok (hs-stream-consume s)))
(assert= (hs-token-type tok) "NUMBER")
(assert= (hs-stream-has-more s) false)))
(let ((s (hs-tokens-of "1.1e-6")))
(let ((tok (hs-stream-consume s)))
(assert= (hs-token-type tok) "NUMBER")
(assert= (hs-stream-has-more s) false)))
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of ".a"))) "CLASS_REF")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "#a"))) "ID_REF")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"asdf\""))) "STRING")
)
(deftest "handles class identifiers properly"
(error "SKIP (untranslated): handles class identifiers properly"))
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of ".a"))) "CLASS_REF")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ".a"))) ".a")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of " .a"))) "CLASS_REF")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of " .a"))) ".a")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "a.a"))) "IDENTIFIER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "a.a"))) "a")
(assert= (hs-token-type (nth (get (hs-tokens-of "(a).a") "list") 4)) "IDENTIFIER")
(assert= (hs-token-value (nth (get (hs-tokens-of "(a).a") "list") 4)) "a")
(assert= (hs-token-type (nth (get (hs-tokens-of "{a}.a") "list") 4)) "IDENTIFIER")
(assert= (hs-token-value (nth (get (hs-tokens-of "{a}.a") "list") 4)) "a")
(assert= (hs-token-type (nth (get (hs-tokens-of "[a].a") "list") 4)) "IDENTIFIER")
(assert= (hs-token-value (nth (get (hs-tokens-of "[a].a") "list") 4)) "a")
(assert= (hs-token-type (nth (get (hs-tokens-of "(a(.a") "list") 3)) "CLASS_REF")
(assert= (hs-token-value (nth (get (hs-tokens-of "(a(.a") "list") 3)) ".a")
(assert= (hs-token-type (nth (get (hs-tokens-of "{a{.a") "list") 3)) "CLASS_REF")
(assert= (hs-token-value (nth (get (hs-tokens-of "{a{.a") "list") 3)) ".a")
(assert= (hs-token-type (nth (get (hs-tokens-of "[a[.a") "list") 3)) "CLASS_REF")
(assert= (hs-token-value (nth (get (hs-tokens-of "[a[.a") "list") 3)) ".a")
)
(deftest "handles comments properly"
(error "SKIP (untranslated): handles comments properly"))
(assert= (len (get (hs-tokens-of "--") "list")) 0)
(assert= (len (get (hs-tokens-of "asdf--") "list")) 1)
(assert= (len (get (hs-tokens-of "-- asdf") "list")) 0)
(assert= (len (get (hs-tokens-of "--\nasdf") "list")) 1)
(assert= (len (get (hs-tokens-of "--\nasdf--") "list")) 1)
(assert= (len (get (hs-tokens-of "---asdf") "list")) 0)
(assert= (len (get (hs-tokens-of "----\n---asdf") "list")) 0)
(assert= (len (get (hs-tokens-of "----asdf----") "list")) 0)
(assert= (len (get (hs-tokens-of "---\nasdf---") "list")) 1)
(assert= (len (get (hs-tokens-of "// asdf") "list")) 0)
(assert= (len (get (hs-tokens-of "///asdf") "list")) 0)
(assert= (len (get (hs-tokens-of "asdf//") "list")) 1)
(assert= (len (get (hs-tokens-of "asdf\n//") "list")) 2)
)
(deftest "handles hex escapes properly"
(error "SKIP (untranslated): handles hex escapes properly"))
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\x1f\""))) (char-from-code 31))
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\x41\""))) "A")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"\\x41\\x61\""))) "Aa")
(let ((threw false))
(guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\"\\x\"")))
(assert threw))
(let ((threw false))
(guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\"\\xGG\"")))
(assert threw))
(let ((threw false))
(guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\"\\x4\"")))
(assert threw))
)
(deftest "handles id references properly"
(error "SKIP (untranslated): handles id references properly"))
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "#a"))) "ID_REF")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "#a"))) "#a")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of " #a"))) "ID_REF")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of " #a"))) "#a")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "a#a"))) "IDENTIFIER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "a#a"))) "a")
(assert= (hs-token-type (nth (get (hs-tokens-of "(a)#a") "list") 4)) "IDENTIFIER")
(assert= (hs-token-value (nth (get (hs-tokens-of "(a)#a") "list") 4)) "a")
(assert= (hs-token-type (nth (get (hs-tokens-of "{a}#a") "list") 4)) "IDENTIFIER")
(assert= (hs-token-value (nth (get (hs-tokens-of "{a}#a") "list") 4)) "a")
(assert= (hs-token-type (nth (get (hs-tokens-of "[a]#a") "list") 4)) "IDENTIFIER")
(assert= (hs-token-value (nth (get (hs-tokens-of "[a]#a") "list") 4)) "a")
(assert= (hs-token-type (nth (get (hs-tokens-of "(a(#a") "list") 3)) "ID_REF")
(assert= (hs-token-value (nth (get (hs-tokens-of "(a(#a") "list") 3)) "#a")
(assert= (hs-token-type (nth (get (hs-tokens-of "{a{#a") "list") 3)) "ID_REF")
(assert= (hs-token-value (nth (get (hs-tokens-of "{a{#a") "list") 3)) "#a")
(assert= (hs-token-type (nth (get (hs-tokens-of "[a[#a") "list") 3)) "ID_REF")
(assert= (hs-token-value (nth (get (hs-tokens-of "[a[#a") "list") 3)) "#a")
)
(deftest "handles identifiers properly"
(error "SKIP (untranslated): handles identifiers properly"))
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "foo"))) "IDENTIFIER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "foo"))) "foo")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of " foo "))) "IDENTIFIER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of " foo "))) "foo")
(let ((s (hs-tokens-of " foo bar")))
(let ((tok1 (hs-stream-consume s)))
(assert= (hs-token-type tok1) "IDENTIFIER")
(assert= (hs-token-value tok1) "foo")
(let ((tok2 (hs-stream-consume s)))
(assert= (hs-token-type tok2) "IDENTIFIER")
(assert= (hs-token-value tok2) "bar"))))
(let ((s (hs-tokens-of " foo\n-- a comment\n bar")))
(let ((tok1 (hs-stream-consume s)))
(assert= (hs-token-type tok1) "IDENTIFIER")
(assert= (hs-token-value tok1) "foo")
(let ((tok2 (hs-stream-consume s)))
(assert= (hs-token-type tok2) "IDENTIFIER")
(assert= (hs-token-value tok2) "bar"))))
)
(deftest "handles identifiers with numbers properly"
(error "SKIP (untranslated): handles identifiers with numbers properly"))
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "f1oo"))) "IDENTIFIER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "f1oo"))) "f1oo")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "fo1o"))) "IDENTIFIER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "fo1o"))) "fo1o")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "foo1"))) "IDENTIFIER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "foo1"))) "foo1")
)
(deftest "handles look ahead property"
(error "SKIP (untranslated): handles look ahead property"))
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 0)) "a")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 1)) "1")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 2)) "+")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 3)) "1")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "a 1 + 1") 4)) "<<<EOF>>>")
)
(deftest "handles numbers properly"
(error "SKIP (untranslated): handles numbers properly"))
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1"))) "NUMBER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1"))) "1")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1.1"))) "NUMBER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1.1"))) "1.1")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1234567890.1234567890"))) "NUMBER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1234567890.1234567890"))) "1234567890.1234567890")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1e6"))) "NUMBER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1e6"))) "1e6")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1e-6"))) "NUMBER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1e-6"))) "1e-6")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1.1e6"))) "NUMBER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1.1e6"))) "1.1e6")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "1.1e-6"))) "NUMBER")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "1.1e-6"))) "1.1e-6")
(assert= (hs-token-type (nth (get (hs-tokens-of "1.1.1") "list") 0)) "NUMBER")
(assert= (hs-token-type (nth (get (hs-tokens-of "1.1.1") "list") 1)) "PERIOD")
(assert= (hs-token-type (nth (get (hs-tokens-of "1.1.1") "list") 2)) "NUMBER")
(assert= (len (get (hs-tokens-of "1.1.1") "list")) 3)
)
(deftest "handles operators properly"
(error "SKIP (untranslated): handles operators properly"))
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "+"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "+"))) "+")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "-"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "-"))) "-")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "*"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "*"))) "*")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "."))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "."))) ".")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "\\"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\\"))) "\\")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ":"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ":"))) ":")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "%"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "%"))) "%")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "|"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "|"))) "|")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "!"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "!"))) "!")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "?"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "?"))) "?")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "#"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "#"))) "#")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "&"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "&"))) "&")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ";"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ";"))) ";")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ","))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ","))) ",")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "("))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "("))) "(")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ")"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ")"))) ")")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "<"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "<"))) "<")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ">"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ">"))) ">")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "{"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "{"))) "{")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "}"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "}"))) "}")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "["))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "["))) "[")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "]"))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "]"))) "]")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "="))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "="))) "=")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "<="))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "<="))) "<=")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of ">="))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of ">="))) ">=")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "=="))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "=="))) "==")
(assert= (hs-token-op? (hs-stream-consume (hs-tokens-of "==="))) true)
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "==="))) "===")
)
(deftest "handles strings properly"
(error "SKIP (untranslated): handles strings properly"))
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"foo\""))) "STRING")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"foo\""))) "foo")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"fo'o\""))) "STRING")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"fo'o\""))) "fo'o")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "\"fo\\\"o\""))) "STRING")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "\"fo\\\"o\""))) "fo\"o")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'foo'"))) "STRING")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'foo'"))) "foo")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'fo\"o'"))) "STRING")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'fo\"o'"))) "fo\"o")
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'fo\\'o'"))) "STRING")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'fo\\'o'"))) "fo'o")
(let ((threw false))
(guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "'")))
(assert threw))
(let ((threw false))
(guard (e (true (set! threw true))) (hs-stream-consume (hs-tokens-of "\"")))
(assert threw))
)
(deftest "handles strings properly 2"
(error "SKIP (untranslated): handles strings properly 2"))
(assert= (hs-token-type (hs-stream-consume (hs-tokens-of "'foo'"))) "STRING")
(assert= (hs-token-value (hs-stream-consume (hs-tokens-of "'foo'"))) "foo")
)
(deftest "handles template bootstrap properly"
(error "SKIP (untranslated): handles template bootstrap properly"))
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"" :template) 0)) "\"")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"$" :template) 0)) "\"")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"$" :template) 1)) "$")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${" :template) 0)) "\"")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${" :template) 1)) "$")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${" :template) 2)) "{")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 0)) "\"")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 1)) "$")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 2)) "{")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"" :template) 3)) "asdf")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 0)) "\"")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 1)) "$")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 2)) "{")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 3)) "asdf")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 4)) "}")
(assert= (hs-token-value (hs-stream-token (hs-tokens-of "\"${\"asdf\"}\"" :template) 5)) "\"")
)
(deftest "handles whitespace properly"
(error "SKIP (untranslated): handles whitespace properly"))
(assert= (len (get (hs-tokens-of " ") "list")) 0)
(assert= (len (get (hs-tokens-of " asdf") "list")) 1)
(assert= (len (get (hs-tokens-of " asdf ") "list")) 2)
(assert= (len (get (hs-tokens-of "asdf ") "list")) 2)
(assert= (len (get (hs-tokens-of "\n") "list")) 0)
(assert= (len (get (hs-tokens-of "\nasdf") "list")) 1)
(assert= (len (get (hs-tokens-of "\nasdf\n") "list")) 2)
(assert= (len (get (hs-tokens-of "asdf\n") "list")) 2)
(assert= (len (get (hs-tokens-of "\r") "list")) 0)
(assert= (len (get (hs-tokens-of "\rasdf") "list")) 1)
(assert= (len (get (hs-tokens-of "\rasdf\r") "list")) 2)
(assert= (len (get (hs-tokens-of "asdf\r") "list")) 2)
(assert= (len (get (hs-tokens-of "\t") "list")) 0)
(assert= (len (get (hs-tokens-of "\tasdf") "list")) 1)
(assert= (len (get (hs-tokens-of "\tasdf\t") "list")) 2)
(assert= (len (get (hs-tokens-of "asdf\t") "list")) 2)
)
(deftest "string interpolation isnt surprising"
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click set x to 42 then put `test${x} test ${x} test$x test $x test $x test ${x} test$x test_$x test_${x} test-$x test.$x` into my.innerHTML")
(dom-set-attr _el-div "_" "on click set x to 42 then put `test\\${x} test ${x} test\\$x test $x test \\$x test \\${x} test$x test_$x test_${x} test-$x test.$x` into my.innerHTML")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch _el-div "click" nil)
@@ -3479,11 +3725,11 @@
(dom-set-attr _el-input6 "value" "555-1212")
(dom-append (dom-body) _el-qsdiv)
(dom-append _el-qsdiv _el-input)
(dom-append _el-input _el-br)
(dom-append _el-br _el-input3)
(dom-append _el-input3 _el-br4)
(dom-append _el-br4 _el-input5)
(dom-append _el-input5 _el-input6)
(dom-append _el-qsdiv _el-br)
(dom-append _el-qsdiv _el-input3)
(dom-append _el-qsdiv _el-br4)
(dom-append _el-qsdiv _el-input5)
(dom-append _el-qsdiv _el-input6)
(hs-activate! _el-qsdiv)
))
(deftest "converts an array into HTML"
@@ -4111,9 +4357,9 @@
(dom-append _el-table _el-tr)
(dom-append _el-tr _el-td)
(dom-append _el-td _el-input)
(dom-append _el-input _el-input4)
(dom-append _el-input4 _el-master)
(dom-append _el-master _el-out)
(dom-append _el-td _el-input4)
(dom-append _el-td _el-master)
(dom-append (dom-body) _el-out)
(hs-activate! _el-master)
(dom-dispatch (dom-query-by-id "master") "click" nil)
(assert= (dom-text-content (dom-query-by-id "out")) "2")
@@ -4194,13 +4440,13 @@
(dom-append _el-table _el-tr)
(dom-append _el-tr _el-td)
(dom-append _el-td _el-input)
(dom-append _el-input _el-tr4)
(dom-append _el-table _el-tr4)
(dom-append _el-tr4 _el-td5)
(dom-append _el-td5 _el-input6)
(dom-append _el-input6 _el-tr7)
(dom-append _el-table _el-tr7)
(dom-append _el-tr7 _el-td8)
(dom-append _el-td8 _el-input9)
(dom-append _el-input9 _el-tr10)
(dom-append _el-table _el-tr10)
(dom-append _el-tr10 _el-td11)
(dom-append _el-td11 _el-master)
(hs-activate! _el-master)
@@ -4382,13 +4628,13 @@
(dom-append _el-table _el-tr)
(dom-append _el-tr _el-td)
(dom-append _el-td _el-input)
(dom-append _el-input _el-tr4)
(dom-append _el-table _el-tr4)
(dom-append _el-tr4 _el-td5)
(dom-append _el-td5 _el-input6)
(dom-append _el-input6 _el-tr7)
(dom-append _el-table _el-tr7)
(dom-append _el-tr7 _el-td8)
(dom-append _el-td8 _el-input9)
(dom-append _el-input9 _el-tr10)
(dom-append _el-table _el-tr10)
(dom-append _el-tr10 _el-td11)
(dom-append _el-td11 _el-master)
(hs-activate! _el-master)
@@ -4407,9 +4653,9 @@
(dom-set-inner-html _el-script "<input type=\"checkbox\" _=\"set :checkboxes to <input[type=checkbox]/> in #box where it is not me on change set checked of the :checkboxes to my checked\">")
(dom-append (dom-body) _el-box)
(dom-append _el-box _el-input)
(dom-append _el-input _el-input2)
(dom-append _el-input2 _el-script)
(dom-append _el-input2 _el-test-where-me)
(dom-append _el-box _el-input2)
(dom-append (dom-body) _el-script)
(dom-append (dom-body) _el-test-where-me)
(dom-dispatch (dom-query "test-where-me input") "click" nil)
))
(deftest "works with DOM elements"
@@ -7183,7 +7429,14 @@
;; ── fetch (23 tests) ──
(defsuite "hs-upstream-fetch"
(deftest "Response can be converted to JSON via as JSON"
(error "SKIP (skip-list): Response can be converted to JSON via as JSON"))
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click fetch /test as Response then put (it as JSON).name into me")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch _el-div "click" nil)
(assert= (dom-text-content _el-div) "Joe")
))
(deftest "allows the event handler to change the fetch parameters"
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
@@ -7194,9 +7447,23 @@
(assert= (dom-text-content _el-div) "yay")
))
(deftest "as response does not throw on 404"
(error "SKIP (skip-list): as response does not throw on 404"))
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click fetch /test as response then put it.status into me")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch _el-div "click" nil)
(assert= (dom-text-content _el-div) "404")
))
(deftest "can catch an error that occurs when using fetch"
(error "SKIP (skip-list): can catch an error that occurs when using fetch"))
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click fetch /test catch e log e put \"yay\" into me")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch _el-div "click" nil)
(assert= (dom-text-content _el-div) "yay")
))
(deftest "can do a simple fetch"
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
@@ -7317,9 +7584,23 @@
(assert= (dom-text-content _el-div) "yay")
))
(deftest "do not throw passes through 404 response"
(error "SKIP (skip-list): do not throw passes through 404 response"))
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click fetch /test do not throw then put it into me")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch _el-div "click" nil)
(assert= (dom-text-content _el-div) "the body")
))
(deftest "don't throw passes through 404 response"
(error "SKIP (skip-list): don't throw passes through 404 response"))
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click fetch /test don't throw then put it into me")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch _el-div "click" nil)
(assert= (dom-text-content _el-div) "the body")
))
(deftest "submits the fetch parameters to the event handler"
(hs-cleanup!)
(host-set! (host-global "window") "headerCheckPassed" false)
@@ -7331,9 +7612,26 @@
(assert= (dom-text-content _el-div) "yay")
))
(deftest "throws on non-2xx response by default"
(error "SKIP (skip-list): throws on non-2xx response by default"))
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click fetch /test catch e put \"caught\" into me")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch _el-div "click" nil)
(assert= (dom-text-content _el-div) "caught")
))
(deftest "triggers an event just before fetching"
(error "SKIP (skip-list): triggers an event just before fetching"))
(hs-cleanup!)
(host-call (host-global "window") "addEventListener" "hyperscript:beforeFetch" (fn (_event) (dom-set-attr (host-get _event "target") "class" "foo-set")))
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click fetch \"/test\" then put it into my.innerHTML end")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(assert (not (dom-has-class? _el-div "foo-set")))
(dom-dispatch _el-div "click" nil)
(assert (dom-has-class? _el-div "foo-set"))
(assert= (dom-text-content _el-div) "yay")
))
)
;; ── focus (3 tests) ──

View File

@@ -81,7 +81,7 @@ class El {
hasAttribute(n) { return n in this.attributes; }
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); }
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; }
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; }
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; }
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,6 +297,15 @@ function mt(e,s) {
const m = base.match(/^\[([^\]=]+)(?:="([^"]*)")?\]$/);
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, id] = base.split('#'); return e.tagName.toLowerCase() === tag && e.id === id; }
return e.tagName.toLowerCase() === base.toLowerCase();
@@ -327,6 +336,11 @@ const document = {
createEvent(t){return new Ev(t);}, addEventListener(){}, removeEventListener(){},
};
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', {
@@ -536,6 +550,9 @@ globalThis.console = { log: () => {}, error: () => {}, warn: () => {}, info: ()
const _log = _origLog; // keep reference for our own output
// ─── 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-get',a=>{
if(a[0]==null)return null;
@@ -572,9 +589,28 @@ const _fetchRoutes = {
'/number': { status: 200, body: '1.2' },
'/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" } },
};
function _mockFetch(url) {
const route = _fetchRoutes[url] || _fetchRoutes['/test'];
return { ok: route.status < 400, status: route.status || 200, url: url || '/test',
const scriptRoutes = _fetchScripts[globalThis.__currentHsTestName];
const route = (scriptRoutes && scriptRoutes[url]) || _fetchRoutes[url] || _fetchRoutes['/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 || '' };
}
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);
@@ -582,13 +618,10 @@ globalThis._driveAsync=function driveAsync(r,d){d=d||0;if(d>500||!r||!r.suspende
if(opName==='io-sleep'||opName==='wait')doResume(null);
else if(opName==='io-fetch'){
const url=typeof items[1]==='string'?items[1]:'/test';
const fmt=typeof items[2]==='string'?items[2]:'text';
const route=_fetchRoutes[url]||_fetchRoutes['/test'];
if(fmt==='json'){try{doResume(JSON.parse(route.json||route.body||'{}'));}catch(e){doResume(null);}}
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||'');
const scriptRoutes=_fetchScripts[globalThis.__currentHsTestName];
const route=(scriptRoutes&&scriptRoutes[url])||_fetchRoutes[url]||_fetchRoutes['/test'];
if(route&&route.networkError){doResume({_type:'dict','_network-error':true,message:'aborted'});}
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(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);}}
@@ -685,6 +718,7 @@ for(let i=startTest;i<Math.min(endTest,testCount);i++){
globalThis.__hsCookieStore.clear();
globalThis.__hsMutationRegistry.length = 0;
globalThis.__hsMutationActive = false;
globalThis._windowListeners={};
globalThis.__currentHsTestName = name;
// Enable step limit for timeout protection

View File

@@ -125,19 +125,9 @@ SKIP_TEST_NAMES = {
"can ignore when target doesn't exist",
"can ignore when target doesn\\'t exist",
"can handle an or after a from clause",
# 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.
# upstream 'fetch' category — real DocumentFragment semantics (`its childElementCount`
# after `as html`) not exercisable with our DOM mock.
"can do a simple fetch w/ html",
"triggers an event just before fetching",
"can catch an error that occurs when using fetch",
"throws on non-2xx response by default",
"do not throw passes through 404 response",
"don't throw passes through 404 response",
"as response does not throw on 404",
"Response can be converted to JSON via as JSON",
}
@@ -210,11 +200,18 @@ def parse_html(html):
# button HTML in `properly processes hyperscript X` tests). HTMLParser handles
# 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 = []
stack = []
class Parser(HTMLParser):
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 = {
'tag': tag, 'id': None, 'classes': [], 'hs': None,
'attrs': {}, 'inner': '', 'depth': len(stack),
@@ -244,6 +241,9 @@ def parse_html(html):
elements.append(el)
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:
stack.pop()
@@ -963,6 +963,24 @@ def parse_dev_body(body, elements, var_names):
else:
pre_setups.append(('__hs_config__', op_expr))
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
# evaluate(() => _hyperscript.config.X = ...) single-line variant.
@@ -1254,7 +1272,9 @@ def process_hs_val(hs_val):
hs_val = hs_val.replace('\\n', '\n').replace('\\t', ' ')
# Preserve escaped quotes (\" → placeholder), strip remaining backslashes, restore
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('\x00DOLLAR\x00', '\\$') # restore \$
hs_val = hs_val.replace('\x00QUOT\x00', '\\"')
# Strip line comments BEFORE newline collapse — once newlines become `then`,
# an unterminated `//` / ` --` comment would consume the rest of the input.
@@ -1845,6 +1865,272 @@ def extract_hs_expr(raw):
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):
"""Generate SX deftest for no-HTML tests using eval-hs.
Handles patterns:
@@ -2063,6 +2349,9 @@ def generate_eval_only_test(test, idx):
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}"')
assertions = []