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

sx: step 9 — parser feature registry

Browse Source 
Add `_hs-feature-registry` dict and `hs-register-feature!` to
`lib/hyperscript/parser.sx`. Replace `parse-feat`'s hardcoded `cond`
on feature names with a registry lookup; the paren-open and
default-expression branches remain as fallthroughs.

Each parse-fn receives a `ctx` dict (built per call by `parse-feat-ctx`)
exposing parser internals (`:adv!`, `:tp-val`, `:tp-type`, `:at-end?`,
`:parse-cmd-list`, `:parse-expr`) and the per-feature handlers
(`:parse-on-feat` … `:parse-socket-feat`). All nine builtins
(`on`, `init`, `def`, `behavior`, `live`, `when`, `worker`, `bind`,
`socket`) are registered at file load time, so plugins added later via
`hs-register-feature!` persist across `hs-parse` calls.

Worker stub still raises identically. Mirror `shared/static/wasm/sx/hs-parser.sx`
copied byte-identical. OCaml: 4545/1339, JS: 2591/2465 — both match
baseline, zero regressions.

First piece of plans/designs/hs-plugin-system.md (Steps 10/11 follow).
This commit is contained in:
giles
2026-05-07 00:39:25 +00:00
parent 621e99e456
commit 986d6411d0
3 changed files with 204 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

100
lib/hyperscript/parser.sx
View File

@@ -3,6 +3,17 @@
;; Input: list of {:type T :value V :pos P} tokens from hs-tokenize
;; Output: SX AST forms that map to runtime primitives
;; ── Feature plugin registry ───────────────────────────────────────
;; Plugins call (hs-register-feature! "name" parse-fn) at load time.
;; parse-fn is (fn (ctx) ...) where ctx is a dict exposing parser
;; helpers (:adv! :tp-val :tp-type :parse-cmd-list ...) and the
;; built-in parse-X-feat dispatch fns.
(begin
(define _hs-feature-registry {})
(define
hs-register-feature!
(fn (name parse-fn) (dict-set! _hs-feature-registry name parse-fn))))
;; ── Parser entry point ────────────────────────────────────────────
(define
hs-parse
@@ -3231,6 +3242,24 @@
(do
(match-kw "end")
(list (quote socket) name-path url timeout on-message))))))))))
(define
parse-feat-ctx
(fn
()
{:adv! adv!
:tp-val tp-val
:tp-type tp-type
:at-end? at-end?
:parse-cmd-list parse-cmd-list
:parse-expr parse-expr
:parse-on-feat parse-on-feat
:parse-init-feat parse-init-feat
:parse-def-feat parse-def-feat
:parse-behavior-feat parse-behavior-feat
:parse-live-feat parse-live-feat
:parse-when-feat parse-when-feat
:parse-bind-feat parse-bind-feat
:parse-socket-feat parse-socket-feat}))
(define
parse-feat
(fn
@@ -3261,29 +3290,23 @@
((unit (tp-val)))
(do (adv!) (list (quote string-postfix) inner unit)))
inner))))
((= val "on") (do (adv!) (parse-on-feat)))
((= 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)))
((= val "worker")
(error
"worker plugin is not installed — see https://hyperscript.org/features/worker"))
((= val "bind") (do (adv!) (parse-bind-feat)))
((= val "socket") (do (adv!) (parse-socket-feat)))
(true
(if
(= (tp-type) "keyword")
(parse-cmd-list)
(let
((saved-p p))
(let
((expr (guard (_e (true nil)) (parse-expr))))
(if
(and expr (at-end?))
expr
(do (set! p saved-p) (parse-cmd-list)))))))))))
(let
((reg-fn (dict-get _hs-feature-registry val)))
(if
reg-fn
(reg-fn (parse-feat-ctx))
(if
(= (tp-type) "keyword")
(parse-cmd-list)
(let
((saved-p p))
(let
((expr (guard (_e (true nil)) (parse-expr))))
(if
(and expr (at-end?))
expr
(do (set! p saved-p) (parse-cmd-list)))))))))))))
(define
coll-feats
(fn
@@ -3326,3 +3349,36 @@
(let
((result (hs-parse (hs-tokenize src) src)))
(do (set! hs-span-mode false) result)))))
;; ── Built-in feature registrations ────────────────────────────────
;; These mirror the original parse-feat cond branches. Registering at
;; load time means plugins can override or extend; ctx exposes the
;; parser internals each fn needs.
(begin
(hs-register-feature!
"on"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-on-feat)))))
(hs-register-feature!
"init"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-init-feat)))))
(hs-register-feature!
"def"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-def-feat)))))
(hs-register-feature!
"behavior"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-behavior-feat)))))
(hs-register-feature!
"live"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-live-feat)))))
(hs-register-feature!
"when"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-when-feat)))))
(hs-register-feature!
"worker"
(fn (ctx) (error "worker plugin is not installed — see https://hyperscript.org/features/worker")))
(hs-register-feature!
"bind"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-bind-feat)))))
(hs-register-feature!
"socket"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-socket-feat))))))

2
plans/sx-improvements.md
View File

@@ -215,7 +215,7 @@ these when operands are known numbers/lists.
| 6 — JS AdtValue + define-type + match | [x] | fc8a3916 |
| 7 — nested patterns | [x] | 0679edf5 |
| 8 — exhaustiveness warnings | [x] | 6d391119 |
| 9 — parser feature registry | [ ] | — |
| 9 — parser feature registry | [x] | PENDING |
| 10 — compiler + as converter registry | [ ] | — |
| 11 — plugin migration + worker | [ ] | — |
| 12 — frame records | [ ] | — |

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

@@ -3,6 +3,17 @@
;; Input: list of {:type T :value V :pos P} tokens from hs-tokenize
;; Output: SX AST forms that map to runtime primitives
;; ── Feature plugin registry ───────────────────────────────────────
;; Plugins call (hs-register-feature! "name" parse-fn) at load time.
;; parse-fn is (fn (ctx) ...) where ctx is a dict exposing parser
;; helpers (:adv! :tp-val :tp-type :parse-cmd-list ...) and the
;; built-in parse-X-feat dispatch fns.
(begin
(define _hs-feature-registry {})
(define
hs-register-feature!
(fn (name parse-fn) (dict-set! _hs-feature-registry name parse-fn))))
;; ── Parser entry point ────────────────────────────────────────────
(define
hs-parse
@@ -3015,7 +3026,7 @@
(fn
()
(let
((every? (match-kw "every")) (first? (match-kw "first")))
((first? (match-kw "first")))
(let
((event-name (parse-compound-event-name)))
(let
@@ -3028,7 +3039,27 @@
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
(let
((elsewhere? (cond ((match-kw "elsewhere") true) ((and (= (tp-type) "keyword") (= (tp-val) "from") (let ((nxt (if (< (+ p 1) tok-len) (nth tokens (+ p 1)) nil))) (and nxt (= (get nxt "type") "keyword") (= (get nxt "value") "elsewhere")))) (do (adv!) (adv!) true)) (true false)))
(source (if (match-kw "from") (parse-expr) nil)))
(source
(if
(match-kw "from")
(parse-collection
(parse-cmp
(parse-arith (parse-poss (parse-atom)))))
nil)))
(define
collect-ors!
(fn
(acc)
(if
(match-kw "or")
(let
((or-evt (parse-compound-event-name))
(or-src
(if (match-kw "from") (parse-expr) nil)))
(collect-ors!
(append acc (list (list or-evt or-src)))))
acc)))
(define or-sources (collect-ors! (list)))
(let
((h-margin nil) (h-threshold nil))
(define
@@ -3059,40 +3090,44 @@
(= (tp-val) "queue"))
(do (adv!) (adv!)))
(let
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
((every? (match-kw "every")))
(let
((body (parse-cmd-list)))
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
(let
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
(finally-clause
(if
(match-kw "finally")
(parse-cmd-list)
nil)))
(match-kw "end")
((body (parse-cmd-list)))
(let
((parts (list (quote on) event-name)))
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
(finally-clause
(if
(match-kw "finally")
(parse-cmd-list)
nil)))
(match-kw "end")
(let
((parts (if every? (append parts (list :every true)) parts)))
((parts (list (quote on) event-name)))
(let
((parts (if flt (append parts (list :filter flt)) parts)))
((parts (if every? (append parts (list :every true)) parts)))
(let
((parts (if elsewhere? (append parts (list :elsewhere true)) parts)))
((parts (if flt (append parts (list :filter flt)) parts)))
(let
((parts (if source (append parts (list :from source)) parts)))
((parts (if elsewhere? (append parts (list :elsewhere true)) parts)))
(let
((parts (if count-filter (append parts (list :count-filter count-filter)) parts)))
((parts (if source (append parts (list :from source)) parts)))
(let
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
((parts (if (> (len or-sources) 0) (append parts (list :or-sources or-sources)) parts)))
(let
((parts (if having (append parts (list :having having)) parts)))
((parts (if count-filter (append parts (list :count-filter count-filter)) parts)))
(let
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
(let
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
((parts (if having (append parts (list :having having)) parts)))
(let
((parts (append parts (list (if (> (len event-vars) 0) (cons (quote do) (append (map (fn (nm) (list (quote ref) nm)) event-vars) (if (and (list? body) (= (first body) (quote do))) (rest body) (list body)))) body)))))
parts))))))))))))))))))))))))
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
(let
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
(let
((parts (append parts (list (if (> (len event-vars) 0) (cons (quote do) (append (map (fn (nm) (list (quote ref) nm)) event-vars) (if (and (list? body) (= (first body) (quote do))) (rest body) (list body)))) body)))))
parts))))))))))))))))))))))))))
(define
parse-init-feat
(fn
@@ -3207,6 +3242,24 @@
(do
(match-kw "end")
(list (quote socket) name-path url timeout on-message))))))))))
(define
parse-feat-ctx
(fn
()
{:adv! adv!
:tp-val tp-val
:tp-type tp-type
:at-end? at-end?
:parse-cmd-list parse-cmd-list
:parse-expr parse-expr
:parse-on-feat parse-on-feat
:parse-init-feat parse-init-feat
:parse-def-feat parse-def-feat
:parse-behavior-feat parse-behavior-feat
:parse-live-feat parse-live-feat
:parse-when-feat parse-when-feat
:parse-bind-feat parse-bind-feat
:parse-socket-feat parse-socket-feat}))
(define
parse-feat
(fn
@@ -3237,29 +3290,23 @@
((unit (tp-val)))
(do (adv!) (list (quote string-postfix) inner unit)))
inner))))
((= val "on") (do (adv!) (parse-on-feat)))
((= 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)))
((= val "worker")
(error
"worker plugin is not installed — see https://hyperscript.org/features/worker"))
((= val "bind") (do (adv!) (parse-bind-feat)))
((= val "socket") (do (adv!) (parse-socket-feat)))
(true
(if
(= (tp-type) "keyword")
(parse-cmd-list)
(let
((saved-p p))
(let
((expr (guard (_e (true nil)) (parse-expr))))
(if
(and expr (at-end?))
expr
(do (set! p saved-p) (parse-cmd-list)))))))))))
(let
((reg-fn (dict-get _hs-feature-registry val)))
(if
reg-fn
(reg-fn (parse-feat-ctx))
(if
(= (tp-type) "keyword")
(parse-cmd-list)
(let
((saved-p p))
(let
((expr (guard (_e (true nil)) (parse-expr))))
(if
(and expr (at-end?))
expr
(do (set! p saved-p) (parse-cmd-list)))))))))))))
(define
coll-feats
(fn
@@ -3302,3 +3349,36 @@
(let
((result (hs-parse (hs-tokenize src) src)))
(do (set! hs-span-mode false) result)))))
;; ── Built-in feature registrations ────────────────────────────────
;; These mirror the original parse-feat cond branches. Registering at
;; load time means plugins can override or extend; ctx exposes the
;; parser internals each fn needs.
(begin
(hs-register-feature!
"on"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-on-feat)))))
(hs-register-feature!
"init"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-init-feat)))))
(hs-register-feature!
"def"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-def-feat)))))
(hs-register-feature!
"behavior"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-behavior-feat)))))
(hs-register-feature!
"live"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-live-feat)))))
(hs-register-feature!
"when"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-when-feat)))))
(hs-register-feature!
"worker"
(fn (ctx) (error "worker plugin is not installed — see https://hyperscript.org/features/worker")))
(hs-register-feature!
"bind"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-bind-feat)))))
(hs-register-feature!
"socket"
(fn (ctx) (begin ((dict-get ctx :adv!)) ((dict-get ctx :parse-socket-feat))))))