HS: fetch don't throw contraction (+1 test)

This commit is contained in:
2026-04-26 10:15:44 +00:00
parent 3a755947ef
commit 1b1b67c72e
4 changed files with 78 additions and 32 deletions

View File

@@ -1684,7 +1684,7 @@
((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil))) ((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil)))
(list (quote fetch-gql) gql-source url)))) (list (quote fetch-gql) gql-source url))))
(let (let
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (= (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 (let
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom))))) ((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
(let (let
@@ -1702,17 +1702,24 @@
((fmt (or fmt-before fmt-after "text"))) ((fmt (or fmt-before fmt-after "text")))
(let (let
((do-not-throw ((do-not-throw
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) (cond
(do ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do"))
(adv!) (do
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) (adv!)
(do (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not"))
(adv!) (do
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (adv!)
(do (adv!) true) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw"))
false)) (do (adv!) true)
false)) false))
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)))))))))) (list (quote fetch) url fmt do-not-throw))))))))))
(define (define
parse-call-args parse-call-args

View File

@@ -536,10 +536,26 @@
(do (do
(let (let
((word (read-ident start))) ((word (read-ident start)))
(hs-emit! (let
(if (hs-keyword? word) "keyword" "ident") ((full-word
word (if
start)) (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!)) (scan!))
(and (and
(or (= ch "=") (= ch "!") (= ch "<") (= ch ">")) (or (= ch "=") (= ch "!") (= ch "<") (= ch ">"))

View File

@@ -1684,7 +1684,7 @@
((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil))) ((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil)))
(list (quote fetch-gql) gql-source url)))) (list (quote fetch-gql) gql-source url))))
(let (let
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (= (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 (let
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom))))) ((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
(let (let
@@ -1702,17 +1702,24 @@
((fmt (or fmt-before fmt-after "text"))) ((fmt (or fmt-before fmt-after "text")))
(let (let
((do-not-throw ((do-not-throw
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) (cond
(do ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do"))
(adv!) (do
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) (adv!)
(do (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not"))
(adv!) (do
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (adv!)
(do (adv!) true) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw"))
false)) (do (adv!) true)
false)) false))
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)))))))))) (list (quote fetch) url fmt do-not-throw))))))))))
(define (define
parse-call-args parse-call-args

View File

@@ -536,10 +536,26 @@
(do (do
(let (let
((word (read-ident start))) ((word (read-ident start)))
(hs-emit! (let
(if (hs-keyword? word) "keyword" "ident") ((full-word
word (if
start)) (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!)) (scan!))
(and (and
(or (= ch "=") (= ch "!") (= ch "<") (= ch ">")) (or (= ch "=") (= ch "!") (= ch "<") (= ch ">"))