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
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

673
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,347 +23,351 @@
page-render-plan
env-components)
(begin
(define
scan-refs
:effects ()
(fn (node) (let ((refs (list))) (scan-refs-walk node refs) refs)))
(define
scan-refs-walk
:effects ()
(fn
(node (refs :as list))
(cond
(= (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")
(for-each
(fn (key) (scan-refs-walk (dict-get node key) refs))
(keys node))
:else nil)))
(define
transitive-deps-walk
:effects ()
(fn
((n :as string) (seen :as list) (env :as dict))
(when
(not (contains? seen n))
(append! seen n)
(let
((val (env-get env n)))
(cond
(or (= (type-of val) "component") (= (type-of val) "island"))
(for-each
(fn ((ref :as string)) (transitive-deps-walk ref seen env))
(scan-refs (component-body val)))
(= (type-of val) "macro")
(for-each
(fn ((ref :as string)) (transitive-deps-walk ref seen env))
(scan-refs (macro-body val)))
:else nil)))))
(define
transitive-deps
:effects ()
(fn
((name :as string) (env :as dict))
(let
((seen (list))
(key (if (starts-with? name "~") name (str "~" name))))
(transitive-deps-walk key seen env)
(filter (fn ((x :as string)) (not (= x key))) seen))))
(define
compute-all-deps
:effects (mutation)
(fn
((env :as dict))
(for-each
(define
scan-refs
:effects ()
(fn (node) (let ((refs (list))) (scan-refs-walk node refs) refs)))
(define
scan-refs-walk
:effects ()
(fn
((name :as string))
(let
((val (env-get env name)))
(when
(or (= (type-of val) "component") (= (type-of val) "island"))
(component-set-deps! val (transitive-deps name env)))))
(env-components env))))
(define
scan-components-from-source
:effects ()
(fn
((source :as string))
(let
((matches (regex-find-all "\\(~([a-zA-Z_][a-zA-Z0-9_\\-:/]*)" source)))
(map (fn ((m :as string)) (str "~" m)) matches))))
(define
components-needed
:effects ()
(fn
((page-source :as string) (env :as dict))
(let
((direct (scan-components-from-source page-source))
(all-needed (list)))
(for-each
(fn
((name :as string))
(when (not (contains? all-needed name)) (append! all-needed name))
(let
((val (env-get env name)))
(node (refs :as list))
(match
(type-of node)
("symbol"
(let
((deps (if (and (= (type-of val) "component") (not (empty? (component-deps val)))) (component-deps val) (transitive-deps name env))))
(for-each
(fn
((dep :as string))
(when
(not (contains? all-needed dep))
(append! all-needed dep)))
deps))))
direct)
all-needed)))
(define
page-component-bundle
:effects ()
(fn
((page-source :as string) (env :as dict))
(components-needed page-source env)))
(define
page-css-classes
:effects ()
(fn
((page-source :as string) (env :as dict))
(let
((needed (components-needed page-source env)) (classes (list)))
(for-each
(fn
((name :as string))
(let
((val (env-get env name)))
(when
(= (type-of val) "component")
(for-each
(fn
((cls :as string))
(when (not (contains? classes cls)) (append! classes cls)))
(component-css-classes val)))))
needed)
(for-each
(fn
((cls :as string))
(when (not (contains? classes cls)) (append! classes cls)))
(scan-css-classes page-source))
classes)))
(define
scan-io-refs-walk
:effects ()
(fn
(node (io-names :as list) (refs :as list))
(cond
(= (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")
(for-each
(fn (key) (scan-io-refs-walk (dict-get node key) io-names refs))
(keys node))
:else 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
transitive-io-refs-walk
:effects ()
(fn
((n :as string)
(seen :as list)
(all-refs :as list)
(env :as dict)
(io-names :as list))
(when
(not (contains? seen n))
(append! seen n)
(let
((val (env-get env n)))
(cond
(= (type-of val) "component")
(do
((name (symbol-name node)))
(when
(starts-with? name "~")
(when (not (contains? refs name)) (append! refs name)))))
("list" (for-each (fn (item) (scan-refs-walk item refs)) node))
("dict"
(for-each
(fn
((ref :as string))
(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")
(do
(for-each
(fn
((ref :as string))
(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
transitive-io-refs
:effects ()
(fn
((name :as string) (env :as dict) (io-names :as list))
(let
((all-refs (list))
(seen (list))
(key (if (starts-with? name "~") name (str "~" name))))
(transitive-io-refs-walk key seen all-refs env io-names)
all-refs)))
(define
compute-all-io-refs
:effects (mutation)
(fn
((env :as dict) (io-names :as list))
(for-each
(fn (key) (scan-refs-walk (dict-get node key) refs))
(keys node)))
(_ nil))))
(define
transitive-deps-walk
:effects ()
(fn
((name :as string))
(let
((val (env-get env name)))
(when
(= (type-of val) "component")
(component-set-io-refs!
val
(transitive-io-refs name env io-names)))))
(env-components env))))
(define
component-io-refs-cached
:effects ()
(fn
((name :as string) (env :as dict) (io-names :as list))
(let
((key (if (starts-with? name "~") name (str "~" name))))
(let
((val (env-get env key)))
(if
(and
(= (type-of val) "component")
(not (nil? (component-io-refs val)))
(not (empty? (component-io-refs val))))
(component-io-refs val)
(transitive-io-refs name env io-names))))))
(define
component-pure?
:effects ()
(fn
(name (env :as dict) (io-names :as list))
(let
((key (if (starts-with? name "~") name (str "~" name))))
(let
((val (if (env-has? env key) (env-get env key) nil)))
(if
(and
(= (type-of val) "component")
(not (nil? (component-io-refs val)))
(not (empty? (component-io-refs val))))
false
(empty? (transitive-io-refs name env io-names)))))))
(define
render-target
:effects ()
(fn
(name (env :as dict) (io-names :as list))
(let
((key (if (starts-with? name "~") name (str "~" name))))
(let
((val (if (env-has? env key) (env-get env key) nil)))
(if
(not (= (type-of val) "component"))
"server"
((n :as string) (seen :as list) (env :as dict))
(when
(not (contains? seen n))
(append! seen n)
(let
((affinity (component-affinity val)))
(cond
(= affinity "server")
"server"
(= affinity "client")
"client"
(not (component-pure? name env io-names))
"server"
:else "client")))))))
(define
page-render-plan
:effects ()
(fn
((page-source :as string) (env :as dict) (io-names :as list))
(let
((needed (components-needed page-source env))
(comp-targets (dict))
(server-list (list))
(client-list (list))
(io-deps (list)))
(for-each
(fn
((name :as string))
(let
((target (render-target name env io-names)))
(dict-set! comp-targets name target)
(if
(= target "server")
(do
(append! server-list name)
((val (env-get env n)))
(match
(type-of val)
("component"
(for-each
(fn
((io-ref :as string))
(when
(not (contains? io-deps io-ref))
(append! io-deps io-ref)))
(component-io-refs-cached name env io-names)))
(append! client-list name))))
needed)
{:io-deps io-deps :server server-list :components comp-targets :client client-list})))
(define
env-components
:effects ()
(fn
((env :as dict))
(filter
((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 (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
((k :as string))
(let ((v (env-get env k))) (or (component? v) (macro? v))))
(keys env))))
)) ;; end define-library
((name :as string) (env :as dict))
(let
((seen (list))
(key (if (starts-with? name "~") name (str "~" name))))
(transitive-deps-walk key seen env)
(filter (fn ((x :as string)) (not (= x key))) seen))))
(define
compute-all-deps
:effects (mutation)
(fn
((env :as dict))
(for-each
(fn
((name :as string))
(let
((val (env-get env name)))
(when
(or
(= (type-of val) "component")
(= (type-of val) "island"))
(component-set-deps! val (transitive-deps name env)))))
(env-components env))))
(define
scan-components-from-source
:effects ()
(fn
((source :as string))
(let
((matches (regex-find-all "\\(~([a-zA-Z_][a-zA-Z0-9_\\-:/]*)" source)))
(map (fn ((m :as string)) (str "~" m)) matches))))
(define
components-needed
:effects ()
(fn
((page-source :as string) (env :as dict))
(let
((direct (scan-components-from-source page-source))
(all-needed (list)))
(for-each
(fn
((name :as string))
(when
(not (contains? all-needed name))
(append! all-needed name))
(let
((val (env-get env name)))
(let
((deps (if (and (= (type-of val) "component") (not (empty? (component-deps val)))) (component-deps val) (transitive-deps name env))))
(for-each
(fn
((dep :as string))
(when
(not (contains? all-needed dep))
(append! all-needed dep)))
deps))))
direct)
all-needed)))
(define
page-component-bundle
:effects ()
(fn
((page-source :as string) (env :as dict))
(components-needed page-source env)))
(define
page-css-classes
:effects ()
(fn
((page-source :as string) (env :as dict))
(let
((needed (components-needed page-source env)) (classes (list)))
(for-each
(fn
((name :as string))
(let
((val (env-get env name)))
(when
(= (type-of val) "component")
(for-each
(fn
((cls :as string))
(when
(not (contains? classes cls))
(append! classes cls)))
(component-css-classes val)))))
needed)
(for-each
(fn
((cls :as string))
(when (not (contains? classes cls)) (append! classes cls)))
(scan-css-classes page-source))
classes)))
(define
scan-io-refs-walk
:effects ()
(fn
(node (io-names :as list) (refs :as list))
(match
(type-of node)
("symbol"
(let
((name (symbol-name node)))
(when
(contains? io-names name)
(when (not (contains? refs name)) (append! refs name)))))
("list"
(for-each
(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
transitive-io-refs-walk
:effects ()
(fn
((n :as string)
(seen :as list)
(all-refs :as list)
(env :as dict)
(io-names :as list))
(when
(not (contains? seen n))
(append! seen n)
(let
((val (env-get env n)))
(match
(type-of val)
("component"
(do
(for-each
(fn
((ref :as string))
(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)))))
("macro"
(do
(for-each
(fn
((ref :as string))
(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)))))
(_ nil))))))
(define
transitive-io-refs
:effects ()
(fn
((name :as string) (env :as dict) (io-names :as list))
(let
((all-refs (list))
(seen (list))
(key (if (starts-with? name "~") name (str "~" name))))
(transitive-io-refs-walk key seen all-refs env io-names)
all-refs)))
(define
compute-all-io-refs
:effects (mutation)
(fn
((env :as dict) (io-names :as list))
(for-each
(fn
((name :as string))
(let
((val (env-get env name)))
(when
(= (type-of val) "component")
(component-set-io-refs!
val
(transitive-io-refs name env io-names)))))
(env-components env))))
(define
component-io-refs-cached
:effects ()
(fn
((name :as string) (env :as dict) (io-names :as list))
(let
((key (if (starts-with? name "~") name (str "~" name))))
(let
((val (env-get env key)))
(if
(and
(= (type-of val) "component")
(not (nil? (component-io-refs val)))
(not (empty? (component-io-refs val))))
(component-io-refs val)
(transitive-io-refs name env io-names))))))
(define
component-pure?
:effects ()
(fn
(name (env :as dict) (io-names :as list))
(let
((key (if (starts-with? name "~") name (str "~" name))))
(let
((val (if (env-has? env key) (env-get env key) nil)))
(if
(and
(= (type-of val) "component")
(not (nil? (component-io-refs val)))
(not (empty? (component-io-refs val))))
false
(empty? (transitive-io-refs name env io-names)))))))
(define
render-target
:effects ()
(fn
(name (env :as dict) (io-names :as list))
(let
((key (if (starts-with? name "~") name (str "~" name))))
(let
((val (if (env-has? env key) (env-get env key) nil)))
(if
(not (= (type-of val) "component"))
"server"
(match
(component-affinity val)
("server" "server")
("client" "client")
(_
(if
(not (component-pure? name env io-names))
"server"
"client"))))))))
(define
page-render-plan
:effects ()
(fn
((page-source :as string) (env :as dict) (io-names :as list))
(let
((needed (components-needed page-source env))
(comp-targets (dict))
(server-list (list))
(client-list (list))
(io-deps (list)))
(for-each
(fn
((name :as string))
(let
((target (render-target name env io-names)))
(dict-set! comp-targets name target)
(if
(= target "server")
(do
(append! server-list name)
(for-each
(fn
((io-ref :as string))
(when
(not (contains? io-deps io-ref))
(append! io-deps io-ref)))
(component-io-refs-cached name env io-names)))
(append! client-list name))))
needed)
{:io-deps io-deps :server server-list :components comp-targets :client client-list})))
(define
env-components
:effects ()
(fn
((env :as dict))
(filter
(fn
((k :as string))
(let ((v (env-get env k))) (or (component? v) (macro? v))))
(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

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

File diff suppressed because it is too large Load Diff

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

File diff suppressed because one or more lines are too long