From 745e78ab05ba5a78713b029f8bd7b853d51ac2f8 Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 14 Apr 2026 20:19:33 +0000 Subject: [PATCH] HS parser: 'does not start/end with' negation support MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- lib/hyperscript/parser.sx | 27 ++++++++++++---- shared/static/wasm/sx/hs-parser.sx | 49 +++++++++++++++++++++++++----- tests/hs-run-fast.js | 1 + 3 files changed, 64 insertions(+), 13 deletions(-) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 4a5bcad6..154f2a77 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -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 diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index 951e7f82..154f2a77 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -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 diff --git a/tests/hs-run-fast.js b/tests/hs-run-fast.js index 04f038b5..6002facc 100644 --- a/tests/hs-run-fast.js +++ b/tests/hs-run-fast.js @@ -282,6 +282,7 @@ for(let i=startTest;i 5000)process.stdout.write(` SLOW: test ${i} took ${elapsed}ms [${suite}] ${name}\n`); if(!ok && err && err.includes('TIMEOUT'))process.stdout.write(` TIMEOUT: test ${i} [${suite}] ${name}\n`); if(!ok && err && err.includes('Expected') && err.includes(', got '))process.stdout.write(` WRONG: test ${i} [${suite}] ${name} — ${err}\n`); + if(!ok && err && err.includes("at position"))process.stdout.write(` PARSE: test ${i} [${suite}] ${name} — ${err}\n`); } process.stdout.write(`\nResults: ${passed}/${passed+failed} (${(100*passed/(passed+failed)).toFixed(0)}%)\n\n`);