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

sx: step 10 — compiler command + as converter registries

Browse Source 
Add `_hs-command-registry` and `_hs-converter-registry` dicts plus
`hs-register-command!` / `hs-register-converter!` to
`lib/hyperscript/compiler.sx`. Inside `hs-to-sx`, before the existing
`cond` over head symbols, check both registries: an `as` form whose
type-name has a registered converter dispatches to that converter; any
list head whose name (`(str head)`) is in the command registry
dispatches to that compile-fn. On registry miss, the original ~180
hardcoded branches handle the form.

Each registered fn receives a ctx dict (built per call) exposing
`:hs-to-sx` for recursion plus the AST fields the dispatch needs
(`:ast :head` for commands; `:ast :value-ast :type-name` for
converters). Mirrors Step 9's parser feature registry shape.

Smoke tested: register custom command + converter, both dispatch;
built-in `(as x \"Int\")` still produces `(hs-coerce x \"Int\")`.

Mirror `shared/static/wasm/sx/hs-compiler.sx` copied byte-identical.
OCaml: 4545/1339, JS: 2591/2465 — both match baseline, zero regressions.

Second piece of plans/designs/hs-plugin-system.md (Step 11 next).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-07 00:50:53 +00:00
parent 00121e137e
commit d22361e471
2 changed files with 131 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
lib/hyperscript/compiler.sx
View File

@@ -7,6 +7,22 @@
;; (hs-to-sx (hs-compile "on click add .active to me")) ;; (hs-to-sx (hs-compile "on click add .active to me"))
;; → (hs-on me "click" (fn (event) (dom-add-class me "active"))) ;; → (hs-on me "click" (fn (event) (dom-add-class me "active")))
;; ── Compiler plugin registries ────────────────────────────────────
;; Plugins call (hs-register-command! "head" compile-fn) and
;; (hs-register-converter! "TypeName" convert-fn) at load time. Both
;; compile-fn and convert-fn receive a ctx dict (built per call inside
;; hs-to-sx) exposing :hs-to-sx for recursion plus the AST node fields
;; the dispatch needs. Compile-fn returns an SX expression.
(begin
(define _hs-command-registry {})
(define _hs-converter-registry {})
(define
hs-register-command!
(fn (name compile-fn) (dict-set! _hs-command-registry name compile-fn)))
(define
hs-register-converter!
(fn (name convert-fn) (dict-set! _hs-converter-registry name convert-fn))))
(define (define
hs-to-sx hs-to-sx
(let (let
@@ -952,6 +968,22 @@
(true (true
(let (let
((head (first ast))) ((head (first ast)))
(let
((reg-cmd-fn (dict-get _hs-command-registry (str head)))
(reg-conv-fn
(and
(= head (quote as))
(dict-get _hs-converter-registry (nth ast 2)))))
(cond
(reg-conv-fn
(reg-conv-fn
{:hs-to-sx hs-to-sx
:ast ast
:value-ast (nth ast 1)
:type-name (nth ast 2)}))
(reg-cmd-fn
(reg-cmd-fn {:hs-to-sx hs-to-sx :ast ast :head head}))
(true
(cond (cond
((= head (quote __bind-from-detail__)) ((= head (quote __bind-from-detail__))
(let (let
@@ -2667,7 +2699,7 @@
(quote begin) (quote begin)
(list (quote set!) (quote it) (quote __hs-js)) (list (quote set!) (quote it) (quote __hs-js))
(quote __hs-js)))))) (quote __hs-js))))))
(true ast))))))))) (true ast))))))))))))
;; ── Convenience: source → SX ───────────────────────────────── ;; ── Convenience: source → SX ─────────────────────────────────
(define (define

111
shared/static/wasm/sx/hs-compiler.sx
View File

@@ -7,6 +7,22 @@
;; (hs-to-sx (hs-compile "on click add .active to me")) ;; (hs-to-sx (hs-compile "on click add .active to me"))
;; → (hs-on me "click" (fn (event) (dom-add-class me "active"))) ;; → (hs-on me "click" (fn (event) (dom-add-class me "active")))
;; ── Compiler plugin registries ────────────────────────────────────
;; Plugins call (hs-register-command! "head" compile-fn) and
;; (hs-register-converter! "TypeName" convert-fn) at load time. Both
;; compile-fn and convert-fn receive a ctx dict (built per call inside
;; hs-to-sx) exposing :hs-to-sx for recursion plus the AST node fields
;; the dispatch needs. Compile-fn returns an SX expression.
(begin
(define _hs-command-registry {})
(define _hs-converter-registry {})
(define
hs-register-command!
(fn (name compile-fn) (dict-set! _hs-command-registry name compile-fn)))
(define
hs-register-converter!
(fn (name convert-fn) (dict-set! _hs-converter-registry name convert-fn))))
(define (define
hs-to-sx hs-to-sx
(let (let
@@ -48,6 +64,15 @@
prop prop
value)) value))
(list (quote hs-query-all) (nth base-ast 1)))) (list (quote hs-query-all) (nth base-ast 1))))
((and (list? base-ast) (= (first base-ast) (quote query)))
(list
(quote dom-set-prop)
(list
(quote hs-named-target)
(nth base-ast 1)
(list (quote hs-query-first) (nth base-ast 1)))
prop
value))
((and (list? base-ast) (= (first base-ast) dot-sym) (let ((inner (nth base-ast 1))) (and (list? inner) (= (first inner) (quote query)) (let ((s (nth inner 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) ".")))))) ((and (list? base-ast) (= (first base-ast) dot-sym) (let ((inner (nth base-ast 1))) (and (list? inner) (= (first inner) (quote query)) (let ((s (nth inner 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))))
(let (let
((inner (nth base-ast 1)) ((inner (nth base-ast 1))
@@ -221,7 +246,8 @@
having-info having-info
of-filter-info of-filter-info
count-filter-info count-filter-info
elsewhere?) elsewhere?
or-sources)
(cond (cond
((<= (len items) 1) ((<= (len items) 1)
(let (let
@@ -279,7 +305,27 @@
having-info having-info
(get having-info "threshold") (get having-info "threshold")
nil)))) nil))))
(true on-call)))))))))))) (true
(if
or-sources
(cons
(quote do)
(cons
on-call
(map
(fn
(pair)
(list
(quote hs-on)
(if
(nth pair 1)
(hs-to-sx
(nth pair 1))
(quote me))
(first pair)
handler))
or-sources)))
on-call)))))))))))))
((= (first items) :from) ((= (first items) :from)
(scan-on (scan-on
(rest (rest items)) (rest (rest items))
@@ -291,7 +337,8 @@
having-info having-info
of-filter-info of-filter-info
count-filter-info count-filter-info
elsewhere?)) elsewhere?
or-sources))
((= (first items) :filter) ((= (first items) :filter)
(scan-on (scan-on
(rest (rest items)) (rest (rest items))
@@ -303,7 +350,8 @@
having-info having-info
of-filter-info of-filter-info
count-filter-info count-filter-info
elsewhere?)) elsewhere?
or-sources))
((= (first items) :every) ((= (first items) :every)
(scan-on (scan-on
(rest (rest items)) (rest (rest items))
@@ -315,7 +363,8 @@
having-info having-info
of-filter-info of-filter-info
count-filter-info count-filter-info
elsewhere?)) elsewhere?
or-sources))
((= (first items) :catch) ((= (first items) :catch)
(scan-on (scan-on
(rest (rest items)) (rest (rest items))
@@ -327,7 +376,8 @@
having-info having-info
of-filter-info of-filter-info
count-filter-info count-filter-info
elsewhere?)) elsewhere?
or-sources))
((= (first items) :finally) ((= (first items) :finally)
(scan-on (scan-on
(rest (rest items)) (rest (rest items))
@@ -339,7 +389,8 @@
having-info having-info
of-filter-info of-filter-info
count-filter-info count-filter-info
elsewhere?)) elsewhere?
or-sources))
((= (first items) :having) ((= (first items) :having)
(scan-on (scan-on
(rest (rest items)) (rest (rest items))
@@ -351,7 +402,8 @@
(nth items 1) (nth items 1)
of-filter-info of-filter-info
count-filter-info count-filter-info
elsewhere?)) elsewhere?
or-sources))
((= (first items) :of-filter) ((= (first items) :of-filter)
(scan-on (scan-on
(rest (rest items)) (rest (rest items))
@@ -363,7 +415,8 @@
having-info having-info
(nth items 1) (nth items 1)
count-filter-info count-filter-info
elsewhere?)) elsewhere?
or-sources))
((= (first items) :count-filter) ((= (first items) :count-filter)
(scan-on (scan-on
(rest (rest items)) (rest (rest items))
@@ -375,7 +428,8 @@
having-info having-info
of-filter-info of-filter-info
(nth items 1) (nth items 1)
elsewhere?)) elsewhere?
or-sources))
((= (first items) :elsewhere) ((= (first items) :elsewhere)
(scan-on (scan-on
(rest (rest items)) (rest (rest items))
@@ -387,6 +441,20 @@
having-info having-info
of-filter-info of-filter-info
count-filter-info count-filter-info
(nth items 1)
or-sources))
((= (first items) :or-sources)
(scan-on
(rest (rest items))
source
filter
every?
catch-info
finally-info
having-info
of-filter-info
count-filter-info
elsewhere?
(nth items 1))) (nth items 1)))
(true (true
(scan-on (scan-on
@@ -399,8 +467,9 @@
having-info having-info
of-filter-info of-filter-info
count-filter-info count-filter-info
elsewhere?))))) elsewhere?
(scan-on (rest parts) nil nil false nil nil nil nil nil false))))) or-sources)))))
(scan-on (rest parts) nil nil false nil nil nil nil nil false nil)))))
(define (define
emit-send emit-send
(fn (fn
@@ -899,6 +968,22 @@
(true (true
(let (let
((head (first ast))) ((head (first ast)))
(let
((reg-cmd-fn (dict-get _hs-command-registry (str head)))
(reg-conv-fn
(and
(= head (quote as))
(dict-get _hs-converter-registry (nth ast 2)))))
(cond
(reg-conv-fn
(reg-conv-fn
{:hs-to-sx hs-to-sx
:ast ast
:value-ast (nth ast 1)
:type-name (nth ast 2)}))
(reg-cmd-fn
(reg-cmd-fn {:hs-to-sx hs-to-sx :ast ast :head head}))
(true
(cond (cond
((= head (quote __bind-from-detail__)) ((= head (quote __bind-from-detail__))
(let (let
@@ -2614,7 +2699,7 @@
(quote begin) (quote begin)
(list (quote set!) (quote it) (quote __hs-js)) (list (quote set!) (quote it) (quote __hs-js))
(quote __hs-js)))))) (quote __hs-js))))))
(true ast))))))))) (true ast))))))))))))
;; ── Convenience: source → SX ───────────────────────────────── ;; ── Convenience: source → SX ─────────────────────────────────
(define (define