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

HS: parse live/when as no-ops, gql as ident, behavioral test ctx + hs-return guard

Browse Source 
Why: behavioral tests compile real _hyperscript fragments that use `live`/`when`
features and `gql` queries — parser/compiler now accept them so tests compile.
Test harness accepts an optional context (me + locals bindings) and catches
`hs-return` raises so `return` from a handler produces a value instead of
propagating as an error.
This commit is contained in:
giles
2026-04-22 10:34:19 +00:00
parent 7357988af6
commit be3fbae584
3 changed files with 92 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
lib/hyperscript/compiler.sx
View File

@@ -1207,6 +1207,8 @@
((= head (quote continue))
(list (quote raise) "hs-continue"))
((= head (quote exit)) nil)
((= head (quote live-no-op)) nil)
((= head (quote when-feat-no-op)) nil)
((= head (quote on)) (emit-on ast))
((= head (quote init))
(list

40
lib/hyperscript/parser.sx
View File

@@ -1370,11 +1370,13 @@
(fn
()
(if
(and (= (tp-type) "keyword") (= (tp-val) "gql"))
(and
(or (= (tp-type) "keyword") (= (tp-type) "ident"))
(= (tp-val) "gql"))
(do
(adv!)
(let
((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 ""))) ""))))
((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 (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "query")) (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "mutation")) (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (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))))
@@ -2047,6 +2049,38 @@
((body (parse-cmd-list)))
(match-kw "end")
(list (quote init) body))))
(define
parse-live-feat
(fn
()
(define
plf-skip
(fn
()
(cond
((at-end?) nil)
((and (= (tp-type) "keyword") (or (= (tp-val) "end") (= (tp-val) "on") (= (tp-val) "init") (= (tp-val) "def") (= (tp-val) "behavior") (= (tp-val) "live") (= (tp-val) "when")))
nil)
(true (do (adv!) (plf-skip))))))
(plf-skip)
(match-kw "end")
(list (quote live-no-op))))
(define
parse-when-feat
(fn
()
(define
pwf-skip
(fn
()
(cond
((at-end?) nil)
((and (= (tp-type) "keyword") (or (= (tp-val) "end") (= (tp-val) "on") (= (tp-val) "init") (= (tp-val) "def") (= (tp-val) "behavior") (= (tp-val) "live") (= (tp-val) "when")))
nil)
(true (do (adv!) (pwf-skip))))))
(pwf-skip)
(match-kw "end")
(list (quote when-feat-no-op))))
(define
parse-feat
(fn
@@ -2058,6 +2092,8 @@
((= val "init") (do (adv!) (parse-init-feat)))
((= val "def") (do (adv!) (parse-def-feat)))
((= val "behavior") (do (adv!) (parse-behavior-feat)))
((= val "live") (do (adv!) (parse-live-feat)))
((= val "when") (do (adv!) (parse-when-feat)))
(true (parse-cmd-list))))))
(define
coll-feats