From 986d6411d010c9d00a888944f7ca8baf8a8074ec Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 00:39:25 +0000 Subject: [PATCH] =?UTF-8?q?sx:=20step=209=20=E2=80=94=20parser=20feature?= =?UTF-8?q?=20registry?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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). --- lib/hyperscript/parser.sx | 100 +++++++++++++---- plans/sx-improvements.md | 2 +- shared/static/wasm/sx/hs-parser.sx | 170 +++++++++++++++++++++-------- 3 files changed, 204 insertions(+), 68 deletions(-) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 3cc8dacc..6c98e9ef 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -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)))))) diff --git a/plans/sx-improvements.md b/plans/sx-improvements.md index 2ceae91e..c6049f47 100644 --- a/plans/sx-improvements.md +++ b/plans/sx-improvements.md @@ -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 | [ ] | — | diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index e245f39c..6c98e9ef 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -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))))))