coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 7 Packages Projects Releases Wiki Activity

HS parser: 'does not start/end with' negation support

Browse Source 
Parser now handles 'does not start with' and 'does not end with'
comparison operators, compiling to (not (starts-with? ...)) and
(not (ends-with? ...)) respectively.

Test runner: host-set!/host-get stringify innerHTML/textContent.

437/831 (52.6%) — parser fix doesn't change count yet (comparison tests
use 'is a' type checks which need separate fix).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-14 20:19:33 +00:00
parent 8bf874c50c
commit 745e78ab05
3 changed files with 64 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
shared/static/wasm/sx/hs-parser.sx
View File

@@ -606,6 +606,12 @@
(list
(quote not)
(list (quote contains?) left (parse-expr))))
((match-kw "start")
(do (match-kw "with")
(list (quote not) (list (quote starts-with?) left (parse-expr)))))
((match-kw "end")
(do (match-kw "with")
(list (quote not) (list (quote ends-with?) left (parse-expr)))))
(true left))))
((and (= typ "keyword") (= val "equals"))
(do (adv!) (list (quote =) left (parse-expr))))
@@ -1111,13 +1117,22 @@
parse-fetch-cmd
(fn
()
(let
((url-atom (parse-atom)))
(let
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
(if
(and (= (tp-type) "keyword") (= (tp-val) "gql"))
(do
(adv!)
(let
((fmt (if (match-kw "as") (let ((f (tp-val))) (adv!) f) "json")))
(list (quote fetch) url fmt))))))
((gql-source (if (= (tp-type) "brace-open") (do (adv!) (define collect-gql (fn (acc depth) (cond ((at-end?) (join " " acc)) ((= (tp-type) "brace-open") (do (adv!) (collect-gql (append acc (list "{")) (+ depth 1)))) ((= (tp-type) "brace-close") (if (= depth 0) (do (adv!) (join " " acc)) (do (adv!) (collect-gql (append acc (list "}")) (- depth 1))))) (true (let ((v (tp-val))) (adv!) (collect-gql (append acc (list (if v v ""))) depth)))))) (str "{ " (collect-gql (list) 0) " }")) (if (or (and (= (tp-type) "keyword") (= (tp-val) "query")) (and (= (tp-type) "keyword") (= (tp-val) "mutation")) (and (= (tp-type) "keyword") (= (tp-val) "subscription"))) (let ((op-word (tp-val))) (adv!) (if (= (tp-type) "brace-open") (do (adv!) (define collect-gql2 (fn (acc depth) (cond ((at-end?) (join " " acc)) ((= (tp-type) "brace-open") (do (adv!) (collect-gql2 (append acc (list "{")) (+ depth 1)))) ((= (tp-type) "brace-close") (if (= depth 0) (do (adv!) (join " " acc)) (do (adv!) (collect-gql2 (append acc (list "}")) (- depth 1))))) (true (let ((v (tp-val))) (adv!) (collect-gql2 (append acc (list (if v v ""))) depth)))))) (str op-word " { " (collect-gql2 (list) 0) " }")) (str op-word ""))) ""))))
(let
((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 (parse-atom)))
(let
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
(let
((fmt (if (match-kw "as") (let ((f (tp-val))) (adv!) f) "json")))
(list (quote fetch) url fmt)))))))
(define
parse-call-args
(fn
@@ -1495,6 +1510,20 @@
((lhs (parse-expr)))
(match-kw "with")
(let ((rhs (parse-expr))) (list (quote swap!) lhs rhs)))))
(define
parse-open-cmd
(fn
()
(let
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
(list (quote open-element) target))))
(define
parse-close-cmd
(fn
()
(let
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
(list (quote close-element) target))))
(define
parse-cmd
(fn
@@ -1582,6 +1611,10 @@
(do (adv!) (parse-empty-cmd)))
((and (= typ "keyword") (= val "swap"))
(do (adv!) (parse-swap-cmd)))
((and (= typ "keyword") (= val "open"))
(do (adv!) (parse-open-cmd)))
((and (= typ "keyword") (= val "close"))
(do (adv!) (parse-close-cmd)))
(true (parse-expr))))))
(define
parse-cmd-list
@@ -1630,7 +1663,9 @@
(= v "focus")
(= v "empty")
(= v "clear")
(= v "swap"))))
(= v "swap")
(= v "open")
(= v "close"))))
(define
cl-collect
(fn