Compare commits
14 Commits
f2993f0582
...
41fac7ac29
| Author | SHA1 | Date | |
|---|---|---|---|
| 41fac7ac29 | |||
| 4c48a8dd57 | |||
| a48110417b | |||
| 4c43918a99 | |||
| d7244d1dc8 | |||
| 1b1b67c72e | |||
| 3a755947ef | |||
| 880503e2b6 | |||
| 3003c8a069 | |||
| 8c62137d32 | |||
| 8ac669c739 | |||
| 8e4bdb7216 | |||
| ea1bdab82c | |||
| 04164aa2d4 |
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
|
||||
@@ -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))))
|
||||
|
||||
@@ -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)))
|
||||
@@ -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 A–D 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
|
||||
|
||||
@@ -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, +12–16 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, +16–17 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
@@ -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
|
||||
|
||||
@@ -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))))
|
||||
|
||||
@@ -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)))
|
||||
@@ -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) ──
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 = []
|
||||
|
||||
Reference in New Issue
Block a user