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

Bytecode compiler: desugar let-match, fix SPA navigation

Browse Source 
The bytecode compiler now handles let-match (both variants):
- Variant 1: (let-match name expr {:k v} body...) — named binding + destructure
- Variant 2: (let-match {:k v} expr body...) — pattern-only destructure

Desugars to sequential let + get calls — no new opcodes needed.

This was the last blocker for SPA navigation. The bytecoded orchestration
and router modules used let-match which compiled to CALL_PRIM "let-match"
(undefined at runtime). Now desugared at compile time.

Also synced dist/sx/ sources with web/ and recompiled all 26 .sxbc modules.

2650/2650 tests pass.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-04 21:31:17 +00:00
parent c0665ba58e
commit 9b060ef8c5
7 changed files with 1208 additions and 1130 deletions
Download Patch File Download Diff File Expand all files Collapse all files

44
lib/compiler.sx
View File

@@ -41,6 +41,7 @@
compile-or
compile-begin
compile-let
desugar-let-match
compile-letrec
compile-lambda
compile-define
@@ -250,6 +251,8 @@
(compile-let em args scope tail?)
(= name "let*")
(compile-let em args scope tail?)
(= name "let-match")
(compile-let em (desugar-let-match args) scope tail?)
(= name "begin")
(compile-begin em args scope tail?)
(= name "do")
@@ -446,6 +449,47 @@
(compile-expr em (first exprs) scope false)
(emit-op em 5)
(compile-begin em (rest exprs) scope tail?))))))
(define
desugar-let-match
(fn
(args)
(let
((first-arg (first args)))
(if (dict? first-arg)
;; Variant 2: (let-match {:k v} expr body...)
(let
((pattern first-arg)
(expr (nth args 1))
(body (slice args 2))
(src-sym (make-symbol "__lm_tmp"))
(bindings (list)))
(append! bindings (list src-sym expr))
(for-each
(fn (k)
(append! bindings
(list (get pattern k)
(list (make-symbol "get") src-sym (str k)))))
(keys pattern))
(cons bindings body))
;; Variant 1: (let-match name expr {:k v} body...)
(let
((name-sym first-arg)
(expr (nth args 1))
(pattern (nth args 2))
(body (slice args 3))
(src-sym (if (= (str name-sym) "_")
(make-symbol "__lm_tmp")
name-sym))
(bindings (list)))
(append! bindings (list src-sym expr))
(when (dict? pattern)
(for-each
(fn (k)
(append! bindings
(list (get pattern k)
(list (make-symbol "get") src-sym (str k)))))
(keys pattern)))
(cons bindings body))))))
(define
compile-let
(fn

44
shared/static/wasm/sx/compiler.sx
View File

@@ -41,6 +41,7 @@
compile-or
compile-begin
compile-let
desugar-let-match
compile-letrec
compile-lambda
compile-define
@@ -250,6 +251,8 @@
(compile-let em args scope tail?)
(= name "let*")
(compile-let em args scope tail?)
(= name "let-match")
(compile-let em (desugar-let-match args) scope tail?)
(= name "begin")
(compile-begin em args scope tail?)
(= name "do")
@@ -446,6 +449,47 @@
(compile-expr em (first exprs) scope false)
(emit-op em 5)
(compile-begin em (rest exprs) scope tail?))))))
(define
desugar-let-match
(fn
(args)
(let
((first-arg (first args)))
(if (dict? first-arg)
;; Variant 2: (let-match {:k v} expr body...)
(let
((pattern first-arg)
(expr (nth args 1))
(body (slice args 2))
(src-sym (make-symbol "__lm_tmp"))
(bindings (list)))
(append! bindings (list src-sym expr))
(for-each
(fn (k)
(append! bindings
(list (get pattern k)
(list (make-symbol "get") src-sym (str k)))))
(keys pattern))
(cons bindings body))
;; Variant 1: (let-match name expr {:k v} body...)
(let
((name-sym first-arg)
(expr (nth args 1))
(pattern (nth args 2))
(body (slice args 3))
(src-sym (if (= (str name-sym) "_")
(make-symbol "__lm_tmp")
name-sym))
(bindings (list)))
(append! bindings (list src-sym expr))
(when (dict? pattern)
(for-each
(fn (k)
(append! bindings
(list (get pattern k)
(list (make-symbol "get") src-sym (str k)))))
(keys pattern)))
(cons bindings body))))))
(define
compile-let
(fn

4
shared/static/wasm/sx/compiler.sxbc
View File

File diff suppressed because one or more lines are too long

179
shared/static/wasm/sx/deps.sx
View File

@@ -1,6 +1,7 @@
(define-library (web deps)
(define-library
(web deps)
(export
scan-refs
scan-refs-walk
@@ -22,33 +23,30 @@
page-render-plan
env-components)
(begin
(define
(define
scan-refs
:effects ()
(fn (node) (let ((refs (list))) (scan-refs-walk node refs) refs)))
(define
(define
scan-refs-walk
:effects ()
(fn
(node (refs :as list))
(cond
(= (type-of node) "symbol")
(match
(type-of node)
("symbol"
(let
((name (symbol-name node)))
(when
(starts-with? name "~")
(when (not (contains? refs name)) (append! refs name))))
(= (type-of node) "list")
(for-each (fn (item) (scan-refs-walk item refs)) node)
(= (type-of node) "dict")
(when (not (contains? refs name)) (append! refs name)))))
("list" (for-each (fn (item) (scan-refs-walk item refs)) node))
("dict"
(for-each
(fn (key) (scan-refs-walk (dict-get node key) refs))
(keys node))
:else nil)))
(define
(keys node)))
(_ nil))))
(define
transitive-deps-walk
:effects ()
(fn
@@ -58,18 +56,28 @@
(append! seen n)
(let
((val (env-get env n)))
(cond
(or (= (type-of val) "component") (= (type-of val) "island"))
(match
(type-of val)
("component"
(for-each
(fn ((ref :as string)) (transitive-deps-walk ref seen env))
(scan-refs (component-body val)))
(= (type-of val) "macro")
(fn
((ref :as string))
(transitive-deps-walk ref seen env))
(scan-refs (component-body val))))
("island"
(for-each
(fn ((ref :as string)) (transitive-deps-walk ref seen env))
(scan-refs (macro-body val)))
:else nil)))))
(define
(fn
((ref :as string))
(transitive-deps-walk ref seen env))
(scan-refs (component-body val))))
("macro"
(for-each
(fn
((ref :as string))
(transitive-deps-walk ref seen env))
(scan-refs (macro-body val))))
(_ nil))))))
(define
transitive-deps
:effects ()
(fn
@@ -79,8 +87,7 @@
(key (if (starts-with? name "~") name (str "~" name))))
(transitive-deps-walk key seen env)
(filter (fn ((x :as string)) (not (= x key))) seen))))
(define
(define
compute-all-deps
:effects (mutation)
(fn
@@ -91,11 +98,12 @@
(let
((val (env-get env name)))
(when
(or (= (type-of val) "component") (= (type-of val) "island"))
(or
(= (type-of val) "component")
(= (type-of val) "island"))
(component-set-deps! val (transitive-deps name env)))))
(env-components env))))
(define
(define
scan-components-from-source
:effects ()
(fn
@@ -103,8 +111,7 @@
(let
((matches (regex-find-all "\\(~([a-zA-Z_][a-zA-Z0-9_\\-:/]*)" source)))
(map (fn ((m :as string)) (str "~" m)) matches))))
(define
(define
components-needed
:effects ()
(fn
@@ -115,7 +122,9 @@
(for-each
(fn
((name :as string))
(when (not (contains? all-needed name)) (append! all-needed name))
(when
(not (contains? all-needed name))
(append! all-needed name))
(let
((val (env-get env name)))
(let
@@ -129,15 +138,13 @@
deps))))
direct)
all-needed)))
(define
(define
page-component-bundle
:effects ()
(fn
((page-source :as string) (env :as dict))
(components-needed page-source env)))
(define
(define
page-css-classes
:effects ()
(fn
@@ -154,7 +161,9 @@
(for-each
(fn
((cls :as string))
(when (not (contains? classes cls)) (append! classes cls)))
(when
(not (contains? classes cls))
(append! classes cls)))
(component-css-classes val)))))
needed)
(for-each
@@ -163,35 +172,37 @@
(when (not (contains? classes cls)) (append! classes cls)))
(scan-css-classes page-source))
classes)))
(define
(define
scan-io-refs-walk
:effects ()
(fn
(node (io-names :as list) (refs :as list))
(cond
(= (type-of node) "symbol")
(match
(type-of node)
("symbol"
(let
((name (symbol-name node)))
(when
(contains? io-names name)
(when (not (contains? refs name)) (append! refs name))))
(= (type-of node) "list")
(for-each (fn (item) (scan-io-refs-walk item io-names refs)) node)
(= (type-of node) "dict")
(when (not (contains? refs name)) (append! refs name)))))
("list"
(for-each
(fn (key) (scan-io-refs-walk (dict-get node key) io-names refs))
(keys node))
:else nil)))
(define
(fn (item) (scan-io-refs-walk item io-names refs))
node))
("dict"
(for-each
(fn
(key)
(scan-io-refs-walk (dict-get node key) io-names refs))
(keys node)))
(_ nil))))
(define
scan-io-refs
:effects ()
(fn
(node (io-names :as list))
(let ((refs (list))) (scan-io-refs-walk node io-names refs) refs)))
(define
(define
transitive-io-refs-walk
:effects ()
(fn
@@ -205,34 +216,38 @@
(append! seen n)
(let
((val (env-get env n)))
(cond
(= (type-of val) "component")
(match
(type-of val)
("component"
(do
(for-each
(fn
((ref :as string))
(when (not (contains? all-refs ref)) (append! all-refs ref)))
(when
(not (contains? all-refs ref))
(append! all-refs ref)))
(scan-io-refs (component-body val) io-names))
(for-each
(fn
((dep :as string))
(transitive-io-refs-walk dep seen all-refs env io-names))
(scan-refs (component-body val))))
(= (type-of val) "macro")
(scan-refs (component-body val)))))
("macro"
(do
(for-each
(fn
((ref :as string))
(when (not (contains? all-refs ref)) (append! all-refs ref)))
(when
(not (contains? all-refs ref))
(append! all-refs ref)))
(scan-io-refs (macro-body val) io-names))
(for-each
(fn
((dep :as string))
(transitive-io-refs-walk dep seen all-refs env io-names))
(scan-refs (macro-body val))))
:else nil)))))
(define
(scan-refs (macro-body val)))))
(_ nil))))))
(define
transitive-io-refs
:effects ()
(fn
@@ -243,8 +258,7 @@
(key (if (starts-with? name "~") name (str "~" name))))
(transitive-io-refs-walk key seen all-refs env io-names)
all-refs)))
(define
(define
compute-all-io-refs
:effects (mutation)
(fn
@@ -260,8 +274,7 @@
val
(transitive-io-refs name env io-names)))))
(env-components env))))
(define
(define
component-io-refs-cached
:effects ()
(fn
@@ -277,8 +290,7 @@
(not (empty? (component-io-refs val))))
(component-io-refs val)
(transitive-io-refs name env io-names))))))
(define
(define
component-pure?
:effects ()
(fn
@@ -294,8 +306,7 @@
(not (empty? (component-io-refs val))))
false
(empty? (transitive-io-refs name env io-names)))))))
(define
(define
render-target
:effects ()
(fn
@@ -307,18 +318,16 @@
(if
(not (= (type-of val) "component"))
"server"
(let
((affinity (component-affinity val)))
(cond
(= affinity "server")
"server"
(= affinity "client")
"client"
(match
(component-affinity val)
("server" "server")
("client" "client")
(_
(if
(not (component-pure? name env io-names))
"server"
:else "client")))))))
(define
"client"))))))))
(define
page-render-plan
:effects ()
(fn
@@ -349,8 +358,7 @@
(append! client-list name))))
needed)
{:io-deps io-deps :server server-list :components comp-targets :client client-list})))
(define
(define
env-components
:effects ()
(fn
@@ -359,10 +367,7 @@
(fn
((k :as string))
(let ((v (env-get env k))) (or (component? v) (macro? v))))
(keys env))))
)) ;; end define-library
(keys env)))))) ;; end define-library
;; Re-export to global namespace for backward compatibility
(import (web deps))

4
shared/static/wasm/sx/deps.sxbc
View File

File diff suppressed because one or more lines are too long

205
shared/static/wasm/sx/engine.sx
View File

@@ -4,7 +4,8 @@
(import (sx dom))
(import (sx browser))
(define-library (web engine)
(define-library
(web engine)
(export
ENGINE_VERBS
DEFAULT_SWAP
@@ -40,12 +41,9 @@
should-boost-form?
parse-sse-swap)
(begin
(define ENGINE_VERBS (list "get" "post" "put" "delete" "patch"))
(define DEFAULT_SWAP "outerHTML")
(define
(define ENGINE_VERBS (list "get" "post" "put" "delete" "patch"))
(define DEFAULT_SWAP "outerHTML")
(define
parse-time
:effects ()
(fn
@@ -60,8 +58,7 @@
(ends-with? s "s")
(* (parse-int (replace s "s" "") 0) 1000)
(parse-int s 0))))))
(define
(define
parse-trigger-spec
:effects ()
(fn
@@ -82,7 +79,9 @@
(empty? tokens)
nil
(if
(and (= (first tokens) "every") (>= (len tokens) 2))
(and
(= (first tokens) "every")
(>= (len tokens) 2))
(dict
"event"
"every"
@@ -127,23 +126,19 @@
mods))
(dict "event" raw-event "modifiers" mods)))))))))
raw-parts))))))
(define
(define
default-trigger
:effects ()
(fn
((tag-name :as string))
(cond
(= tag-name "form")
(list (dict "event" "submit" "modifiers" (dict)))
(or
(= tag-name "input")
(= tag-name "select")
(= tag-name "textarea"))
(list (dict "event" "change" "modifiers" (dict)))
:else (list (dict "event" "click" "modifiers" (dict))))))
(define
(match
tag-name
("form" (list (dict "event" "submit" "modifiers" (dict))))
("input" (list (dict "event" "change" "modifiers" (dict))))
("select" (list (dict "event" "change" "modifiers" (dict))))
("textarea" (list (dict "event" "change" "modifiers" (dict))))
(_ (list (dict "event" "click" "modifiers" (dict)))))))
(define
get-verb-info
:effects (io)
(fn
@@ -155,8 +150,7 @@
((url (dom-get-attr el (str "sx-" verb))))
(if url (dict "method" (upper verb) "url" url) nil)))
ENGINE_VERBS)))
(define
(define
build-request-headers
:effects (io)
(fn
@@ -168,7 +162,9 @@
(when target-sel (dict-set! headers "SX-Target" target-sel)))
(let
((comp-hash (dom-get-attr (dom-query "script[data-components][data-hash]") "data-hash")))
(when comp-hash (dict-set! headers "SX-Components-Hash" comp-hash)))
(when
comp-hash
(dict-set! headers "SX-Components-Hash" comp-hash)))
(let
((extra-h (dom-get-attr el "sx-headers")))
(when
@@ -183,8 +179,7 @@
(dict-set! headers key (str (get parsed key))))
(keys parsed))))))
headers)))
(define
(define
process-response-headers
:effects ()
(fn
@@ -214,8 +209,7 @@
(get-header "SX-Cache-Invalidate")
"cache-update"
(get-header "SX-Cache-Update"))))
(define
(define
parse-swap-spec
:effects ()
(fn
@@ -234,8 +228,7 @@
(set! use-transition false)))
(rest parts))
(dict "style" style "transition" use-transition))))
(define
(define
parse-retry-spec
:effects ()
(fn
@@ -252,15 +245,13 @@
(parse-int (nth parts 1) 1000)
"cap-ms"
(parse-int (nth parts 2) 30000))))))
(define
(define
next-retry-ms
:effects ()
(fn
((current-ms :as number) (cap-ms :as number))
(min (* current-ms 2) cap-ms)))
(define
(define
filter-params
:effects ()
(fn
@@ -279,29 +270,29 @@
(let
((excluded (map trim (split (slice params-spec 4) ","))))
(filter
(fn ((p :as list)) (not (contains? excluded (first p))))
(fn
((p :as list))
(not (contains? excluded (first p))))
all-params))
(let
((allowed (map trim (split params-spec ","))))
(filter
(fn ((p :as list)) (contains? allowed (first p)))
all-params))))))))
(define
(define
resolve-target
:effects (io)
(fn
(el)
(let
((sel (dom-get-attr el "sx-target")))
(cond
(or (nil? sel) (= sel "this"))
el
(= sel "closest")
(dom-parent el)
:else (dom-query sel)))))
(define
(match
sel
(nil el)
("this" el)
("closest" (dom-parent el))
(_ (dom-query sel))))))
(define
apply-optimistic
:effects (mutation io)
(fn
@@ -322,7 +313,10 @@
(dom-set-style target "pointer-events" "none"))
(= directive "disable")
(do
(dict-set! state "disabled" (dom-get-prop target "disabled"))
(dict-set!
state
"disabled"
(dom-get-prop target "disabled"))
(dom-set-prop target "disabled" true))
(starts-with? directive "add-class:")
(let
@@ -330,8 +324,7 @@
(dict-set! state "add-class" cls)
(dom-add-class target cls)))
state)))))
(define
(define
revert-optimistic
:effects (mutation io)
(fn
@@ -339,18 +332,24 @@
(when
state
(let
((target (get state "target")) (directive (get state "directive")))
((target (get state "target"))
(directive (get state "directive")))
(cond
(= directive "remove")
(do
(dom-set-style target "opacity" (or (get state "opacity") ""))
(dom-set-style
target
"opacity"
(or (get state "opacity") ""))
(dom-set-style target "pointer-events" ""))
(= directive "disable")
(dom-set-prop target "disabled" (or (get state "disabled") false))
(dom-set-prop
target
"disabled"
(or (get state "disabled") false))
(get state "add-class")
(dom-remove-class target (get state "add-class")))))))
(define
(define
find-oob-swaps
:effects (mutation io)
(fn
@@ -383,8 +382,7 @@
oob-els)))
(list "sx-swap-oob" "hx-swap-oob"))
results)))
(define
(define
morph-node
:effects (mutation io)
(fn
@@ -416,9 +414,12 @@
(dom-parent old-node)
(dom-clone new-node true)
old-node)
(or (= (dom-node-type old-node) 3) (= (dom-node-type old-node) 8))
(or
(= (dom-node-type old-node) 3)
(= (dom-node-type old-node) 8))
(when
(not (= (dom-text-content old-node) (dom-text-content new-node)))
(not
(= (dom-text-content old-node) (dom-text-content new-node)))
(dom-set-text-content old-node (dom-text-content new-node)))
(= (dom-node-type old-node) 1)
(do
@@ -439,8 +440,7 @@
(dom-is-active-element? old-node)
(dom-is-input-element? old-node)))
(morph-children old-node new-node))))))
(define
(define
sync-attrs
:effects (mutation io)
(fn
@@ -471,8 +471,7 @@
(not (= aname "data-sx-reactive-attrs")))
(dom-remove-attr old-el aname))))
(dom-attr-list old-el)))))
(define
(define
morph-children
:effects (mutation io)
(fn
@@ -501,8 +500,10 @@
(new-child)
(let
((raw-id (dom-id new-child))
(match-id (if (and raw-id (not (empty? raw-id))) raw-id nil))
(match-by-id (if match-id (dict-get old-by-id match-id) nil)))
(match-id
(if (and raw-id (not (empty? raw-id))) raw-id nil))
(match-by-id
(if match-id (dict-get old-by-id match-id) nil)))
(cond
(and match-by-id (not (nil? match-by-id)))
(do
@@ -552,8 +553,7 @@
(not (dom-has-attr? leftover "sx-ignore")))
(dom-remove-child old-parent leftover)))))
(range 0 (len old-kids))))))
(define
(define
morph-island-children
:effects (mutation io)
(fn
@@ -598,11 +598,12 @@
((id (dom-get-attr old-marsh "data-sx-marsh")))
(let
((new-marsh (dict-get new-marsh-map id)))
(when new-marsh (morph-marsh old-marsh new-marsh old-island)))))
(when
new-marsh
(morph-marsh old-marsh new-marsh old-island)))))
old-marshes)
(process-signal-updates new-island)))))
(define
(define
morph-marsh
:effects (mutation io)
(fn
@@ -629,8 +630,7 @@
(do
(sync-attrs old-marsh new-marsh)
(morph-children old-marsh new-marsh))))))
(define
(define
process-signal-updates
:effects (mutation io)
(fn
@@ -656,8 +656,7 @@
(reset! (use-store store-name) parsed))
(dom-remove-attr el "data-sx-signal")))))))
signal-els))))
(define
(define
swap-dom-nodes
:effects (mutation io)
(fn
@@ -674,7 +673,8 @@
(morph-children target wrapper)))
"outerHTML"
(let
((parent (dom-parent target)) (new-el (dom-clone new-nodes true)))
((parent (dom-parent target))
(new-el (dom-clone new-nodes true)))
(if
(dom-is-fragment? new-nodes)
(let
@@ -709,8 +709,7 @@
((wrapper (dom-create-element "div" nil)))
(dom-append wrapper new-nodes)
(morph-children target wrapper))))))
(define
(define
insert-remaining-siblings
:effects (mutation io)
(fn
@@ -721,8 +720,7 @@
((next (dom-next-sibling sib)))
(dom-insert-after ref-node sib)
(insert-remaining-siblings parent sib next)))))
(define
(define
swap-html-string
:effects (mutation io)
(fn
@@ -750,8 +748,7 @@
"none"
nil
:else (dom-set-inner-html target html))))
(define
(define
handle-history
:effects (io)
(fn
@@ -768,11 +765,10 @@
(save-scroll-position)
(browser-push-state (if (= push-url "true") url push-url)))
(and replace-url (not (= replace-url "false")))
(browser-replace-state (if (= replace-url "true") url replace-url))))))
(define PRELOAD_TTL 30000)
(define
(browser-replace-state
(if (= replace-url "true") url replace-url))))))
(define PRELOAD_TTL 30000)
(define
preload-cache-get
:effects (mutation)
(fn
@@ -786,8 +782,7 @@
(> (- (now-ms) (get entry "timestamp")) PRELOAD_TTL)
(do (dict-delete! cache url) nil)
(do (dict-delete! cache url) entry))))))
(define
(define
preload-cache-set
:effects (mutation)
(fn
@@ -799,26 +794,21 @@
cache
url
(dict "text" text "content-type" content-type "timestamp" (now-ms)))))
(define
(define
classify-trigger
:effects ()
(fn
((trigger :as dict))
(let
((event (get trigger "event")))
(cond
(= event "every")
"poll"
(= event "intersect")
"intersect"
(= event "load")
"load"
(= event "revealed")
"revealed"
:else "event"))))
(define
(match
event
("every" "poll")
("intersect" "intersect")
("load" "load")
("revealed" "revealed")
(_ "event")))))
(define
should-boost-link?
:effects (io)
(fn
@@ -834,8 +824,7 @@
(not (dom-has-attr? link "sx-get"))
(not (dom-has-attr? link "sx-post"))
(not (dom-has-attr? link "sx-disable"))))))
(define
(define
should-boost-form?
:effects (io)
(fn
@@ -844,14 +833,10 @@
(not (dom-has-attr? form "sx-get"))
(not (dom-has-attr? form "sx-post"))
(not (dom-has-attr? form "sx-disable")))))
(define
(define
parse-sse-swap
:effects (io)
(fn (el) (or (dom-get-attr el "sx-sse-swap") "message")))
)) ;; end define-library
(fn (el) (or (dom-get-attr el "sx-sse-swap") "message"))))) ;; end define-library
;; Re-export to global namespace for backward compatibility
(import (web engine))

4
shared/static/wasm/sx/engine.sxbc
View File

File diff suppressed because one or more lines are too long