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

Compiler: dict destructuring in let, paren-aware library stripping — 31/31 sxbc

Browse Source 
compile-let now handles dict destructuring patterns:
(let {:key1 var1 :key2 var2} source body). This unblocked core-signals.sx
(deref uses dict destructuring) which was the sole bytecode skip.

Rewrote stripLibraryWrapper from line-based to paren-aware extraction.
The old regex missed (define-library on its own line (no trailing space),
silently passing the full wrapper to the compiler.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-11 08:52:36 +00:00
parent bca0d8e4e5
commit ef8f8b7c03
17 changed files with 278 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files

110
hosts/ocaml/browser/compile-modules.js
View File

@@ -126,36 +126,102 @@ for (const file of FILES) {
// ---------------------------------------------------------------------------
function stripLibraryWrapper(source) {
// Line-based stripping: unwrap (define-library ... (begin BODY)), keep (import ...).
const lines = source.split('\n');
const result = [];
let skip = false; // inside header region (define-library, export)
// Paren-aware stripping: find (begin ...) inside (define-library ...), extract body.
// Keep top-level (import ...) forms outside the define-library.
for (let i = 0; i < lines.length; i++) {
const line = lines[i];
const trimmed = line.trim();
// Find (define-library at the start
const dlMatch = source.match(/^[\s\S]*?\(define-library\b/);
if (!dlMatch) return source; // no define-library, return as-is
// Skip (define-library ...) header lines until (begin
if (trimmed.startsWith('(define-library ')) { skip = true; continue; }
if (skip && trimmed.startsWith('(export')) { continue; }
if (skip && trimmed.match(/^\(begin/)) { skip = false; continue; }
if (skip) continue;
// Find the (begin that opens the body — skip past (export ...) using paren counting
const afterDL = dlMatch[0].length;
let pos = afterDL;
let foundBegin = -1;
// Skip closing )) of define-library — line is just ) or )) optionally with comments
if (trimmed.match(/^\)+(\s*;.*)?$/)) {
// Check if this is the end-of-define-library closer (only `)` chars + optional comment)
// vs a regular body closer like ` )` inside a nested form
// Only skip if at column 0 (not indented = top-level closer)
if (line.match(/^\)/)) continue;
while (pos < source.length) {
// Skip whitespace and comments
while (pos < source.length && /[\s]/.test(source[pos])) pos++;
if (pos >= source.length) break;
if (source[pos] === ';') { // skip comment line
while (pos < source.length && source[pos] !== '\n') pos++;
continue;
}
// Skip standalone comments that are just structural markers
if (trimmed.match(/^;;\s*(end define-library|Re-export)/)) continue;
// Check for (begin
if (source.startsWith('(begin', pos)) {
foundBegin = pos;
break;
}
result.push(line);
// Skip balanced sexp (the library name and export list)
if (source[pos] === '(') {
let depth = 1;
pos++;
while (pos < source.length && depth > 0) {
if (source[pos] === '(') depth++;
else if (source[pos] === ')') depth--;
else if (source[pos] === '"') { // skip strings
pos++;
while (pos < source.length && source[pos] !== '"') {
if (source[pos] === '\\') pos++;
pos++;
}
} else if (source[pos] === ';') { // skip comments
while (pos < source.length && source[pos] !== '\n') pos++;
continue;
}
pos++;
}
} else {
// Skip atom
while (pos < source.length && !/[\s()]/.test(source[pos])) pos++;
}
}
return result.join('\n');
if (foundBegin === -1) return source; // no (begin found
// Find the body inside (begin ...) — skip "(begin" + optional whitespace
let bodyStart = foundBegin + 6; // len("(begin") = 6
// Skip optional newline/whitespace after (begin
while (bodyStart < source.length && /[\s]/.test(source[bodyStart])) bodyStart++;
// Find matching close of (begin ...) using paren counting from foundBegin
pos = foundBegin + 1; // after opening (
let depth = 1;
while (pos < source.length && depth > 0) {
if (source[pos] === '(') depth++;
else if (source[pos] === ')') depth--;
else if (source[pos] === '"') {
pos++;
while (pos < source.length && source[pos] !== '"') {
if (source[pos] === '\\') pos++;
pos++;
}
} else if (source[pos] === ';') {
while (pos < source.length && source[pos] !== '\n') pos++;
continue;
}
if (depth > 0) pos++;
}
const beginClose = pos; // position of closing ) for (begin ...)
// Extract body (everything between (begin and its closing paren)
const body = source.slice(bodyStart, beginClose);
// Find any (import ...) forms AFTER the define-library
// The define-library's closing paren is right after begin's
let dlClose = beginClose + 1;
while (dlClose < source.length && source[dlClose] !== ')') {
if (source[dlClose] === ';') {
while (dlClose < source.length && source[dlClose] !== '\n') dlClose++;
}
dlClose++;
}
dlClose++; // past the closing )
const afterDLForm = source.slice(dlClose);
return body + '\n' + afterDLForm;
}
// Compile each module (stripped of define-library/import wrappers)

74
lib/compiler.sx
View File

@@ -589,24 +589,64 @@
(list (list (make-symbol loop-name) lambda-expr)))
(call-expr (cons (make-symbol loop-name) inits)))
(compile-letrec em (list letrec-bindings call-expr) scope tail?)))
(let
((bindings (first args))
(body (rest args))
(let-scope (make-scope scope)))
(dict-set! let-scope "next-slot" (get scope "next-slot"))
(for-each
(fn
(binding)
(let
((name (if (= (type-of (first binding)) "symbol") (symbol-name (first binding)) (first binding)))
(value (nth binding 1)))
(compile-expr em value let-scope false)
(if
(dict? (first args))
(let
((pattern (first args))
(source-expr (nth args 1))
(body (slice args 2))
(let-scope (make-scope scope)))
(dict-set! let-scope "next-slot" (get scope "next-slot"))
(compile-expr em source-expr let-scope false)
(let
((temp-slot (scope-define-local let-scope "__dict_src")))
(emit-op em 17)
(emit-byte em temp-slot)
(for-each
(fn
(k)
(let
((var-name (get pattern k))
(key-str
(if
(= (type-of k) "keyword")
(keyword-name k)
(str k))))
(emit-op em 16)
(emit-byte em temp-slot)
(let
((key-idx (pool-add (get em "pool") key-str)))
(emit-op em 2)
(emit-u16 em key-idx))
(let
((get-idx (pool-add (get em "pool") "get")))
(emit-op em 10)
(emit-u16 em get-idx)
(emit-byte em 2))
(let
((slot (scope-define-local let-scope (if (= (type-of var-name) "symbol") (symbol-name var-name) var-name))))
(emit-op em 17)
(emit-byte em slot))))
(keys pattern))
(compile-begin em body let-scope tail?)))
(let
((bindings (first args))
(body (rest args))
(let-scope (make-scope scope)))
(dict-set! let-scope "next-slot" (get scope "next-slot"))
(for-each
(fn
(binding)
(let
((slot (scope-define-local let-scope name)))
(emit-op em 17)
(emit-byte em slot))))
bindings)
(compile-begin em body let-scope tail?)))))
((name (if (= (type-of (first binding)) "symbol") (first binding) (make-symbol (first binding))))
(value (nth binding 1)))
(compile-expr em value let-scope false)
(let
((slot (scope-define-local let-scope (symbol-name name))))
(emit-op em 17)
(emit-byte em slot))))
bindings)
(compile-begin em body let-scope tail?))))))
(define
compile-letrec
(fn

2
shared/static/wasm/sx/adapter-dom.sxbc
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx/adapter-html.sxbc
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx/adapter-sx.sxbc
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx/boot-helpers.sxbc
View File

File diff suppressed because one or more lines are too long

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

@@ -589,24 +589,64 @@
(list (list (make-symbol loop-name) lambda-expr)))
(call-expr (cons (make-symbol loop-name) inits)))
(compile-letrec em (list letrec-bindings call-expr) scope tail?)))
(let
((bindings (first args))
(body (rest args))
(let-scope (make-scope scope)))
(dict-set! let-scope "next-slot" (get scope "next-slot"))
(for-each
(fn
(binding)
(let
((name (if (= (type-of (first binding)) "symbol") (symbol-name (first binding)) (first binding)))
(value (nth binding 1)))
(compile-expr em value let-scope false)
(if
(dict? (first args))
(let
((pattern (first args))
(source-expr (nth args 1))
(body (slice args 2))
(let-scope (make-scope scope)))
(dict-set! let-scope "next-slot" (get scope "next-slot"))
(compile-expr em source-expr let-scope false)
(let
((temp-slot (scope-define-local let-scope "__dict_src")))
(emit-op em 17)
(emit-byte em temp-slot)
(for-each
(fn
(k)
(let
((var-name (get pattern k))
(key-str
(if
(= (type-of k) "keyword")
(keyword-name k)
(str k))))
(emit-op em 16)
(emit-byte em temp-slot)
(let
((key-idx (pool-add (get em "pool") key-str)))
(emit-op em 2)
(emit-u16 em key-idx))
(let
((get-idx (pool-add (get em "pool") "get")))
(emit-op em 10)
(emit-u16 em get-idx)
(emit-byte em 2))
(let
((slot (scope-define-local let-scope (if (= (type-of var-name) "symbol") (symbol-name var-name) var-name))))
(emit-op em 17)
(emit-byte em slot))))
(keys pattern))
(compile-begin em body let-scope tail?)))
(let
((bindings (first args))
(body (rest args))
(let-scope (make-scope scope)))
(dict-set! let-scope "next-slot" (get scope "next-slot"))
(for-each
(fn
(binding)
(let
((slot (scope-define-local let-scope name)))
(emit-op em 17)
(emit-byte em slot))))
bindings)
(compile-begin em body let-scope tail?)))))
((name (if (= (type-of (first binding)) "symbol") (first binding) (make-symbol (first binding))))
(value (nth binding 1)))
(compile-expr em value let-scope false)
(let
((slot (scope-define-local let-scope (symbol-name name))))
(emit-op em 17)
(emit-byte em slot))))
bindings)
(compile-begin em body let-scope tail?))))))
(define
compile-letrec
(fn

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

File diff suppressed because one or more lines are too long

4
shared/static/wasm/sx/core-signals.sxbc
View File

File diff suppressed because one or more lines are too long

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

File diff suppressed because one or more lines are too long

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

File diff suppressed because one or more lines are too long

4
shared/static/wasm/sx/hs-parser.sxbc
View File

File diff suppressed because one or more lines are too long

4
shared/static/wasm/sx/hs-runtime.sxbc
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx/orchestration.sxbc
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx/signals.sxbc
View File

@@ -1,3 +1,3 @@
(sxbc 1 "232c1519553b1d5f"
(code
:constants ({:library (sx dom) :op "import"} {:library (sx browser) :op "import"} "with-marsh-scope" {:upvalue-count 0 :arity 2 :constants ("list" "with-island-scope" {:upvalue-count 1 :arity 1 :constants ("append!") :bytecode (18 0 16 0 52 0 0 2 50)} "dom-set-data" "sx-marsh-disposers") :bytecode (52 0 0 0 17 2 20 1 0 51 2 0 1 2 16 1 48 2 5 20 3 0 16 0 1 4 0 16 2 49 3 50)} "dispose-marsh-scope" {:upvalue-count 0 :arity 1 :constants ("dom-get-data" "sx-marsh-disposers" "for-each" {:upvalue-count 0 :arity 1 :constants ("cek-call") :bytecode (16 0 2 52 0 0 2 50)} "dom-set-data") :bytecode (20 0 0 16 0 1 1 0 48 2 17 1 16 1 33 24 0 51 3 0 16 1 52 2 0 2 5 20 4 0 16 0 1 1 0 2 49 3 32 1 0 2 50)} "emit-event" {:upvalue-count 0 :arity 3 :constants ("dom-dispatch") :bytecode (20 0 0 16 0 16 1 16 2 49 3 50)} "on-event" {:upvalue-count 0 :arity 3 :constants ("dom-on") :bytecode (20 0 0 16 0 16 1 16 2 49 3 50)} "bridge-event" {:upvalue-count 0 :arity 4 :constants ("effect" {:upvalue-count 4 :arity 0 :constants ("dom-on" {:upvalue-count 2 :arity 1 :constants ("event-detail" "cek-call" "list" "reset!") :bytecode (20 0 0 16 0 48 1 17 1 18 0 33 15 0 18 0 16 1 52 2 0 1 52 1 0 2 32 2 0 16 1 17 2 20 3 0 18 1 16 2 49 2 50)}) :bytecode (20 0 0 18 0 18 1 51 1 0 0 2 0 3 48 3 17 0 16 0 50)}) :bytecode (20 0 0 51 1 0 1 0 1 1 1 3 1 2 49 1 50)} "resource" {:upvalue-count 0 :arity 1 :constants ("signal" "dict" "loading" "data" "error" "promise-then" "cek-call" {:upvalue-count 1 :arity 1 :constants ("reset!" "dict" "loading" "data" "error") :bytecode (20 0 0 18 0 1 2 0 4 1 3 0 16 0 1 4 0 2 52 1 0 6 49 2 50)} {:upvalue-count 1 :arity 1 :constants ("reset!" "dict" "loading" "data" "error") :bytecode (20 0 0 18 0 1 2 0 4 1 3 0 2 1 4 0 16 0 52 1 0 6 49 2 50)}) :bytecode (20 0 0 1 2 0 3 1 3 0 2 1 4 0 2 52 1 0 6 48 1 17 1 20 5 0 16 0 2 52 6 0 2 51 7 0 1 1 51 8 0 1 1 48 3 5 16 1 50)} {:library (sx signals-web) :op "import"}) :bytecode (1 0 0 112 5 1 1 0 112 5 51 3 0 128 2 0 5 51 5 0 128 4 0 5 51 7 0 128 6 0 5 51 9 0 128 8 0 5 51 11 0 128 10 0 5 51 13 0 128 12 0 5 1 14 0 112 50)))
:constants ("with-marsh-scope" {:upvalue-count 0 :arity 2 :constants ("list" "with-island-scope" {:upvalue-count 1 :arity 1 :constants ("append!") :bytecode (18 0 16 0 52 0 0 2 50)} "dom-set-data" "sx-marsh-disposers") :bytecode (52 0 0 0 17 2 20 1 0 51 2 0 1 2 16 1 48 2 5 20 3 0 16 0 1 4 0 16 2 49 3 50)} "dispose-marsh-scope" {:upvalue-count 0 :arity 1 :constants ("dom-get-data" "sx-marsh-disposers" "for-each" {:upvalue-count 0 :arity 1 :constants ("cek-call") :bytecode (16 0 2 52 0 0 2 50)} "dom-set-data") :bytecode (20 0 0 16 0 1 1 0 48 2 17 1 16 1 33 24 0 51 3 0 16 1 52 2 0 2 5 20 4 0 16 0 1 1 0 2 49 3 32 1 0 2 50)} "emit-event" {:upvalue-count 0 :arity 3 :constants ("dom-dispatch") :bytecode (20 0 0 16 0 16 1 16 2 49 3 50)} "on-event" {:upvalue-count 0 :arity 3 :constants ("dom-on") :bytecode (20 0 0 16 0 16 1 16 2 49 3 50)} "bridge-event" {:upvalue-count 0 :arity 4 :constants ("effect" {:upvalue-count 4 :arity 0 :constants ("dom-on" {:upvalue-count 2 :arity 1 :constants ("event-detail" "cek-call" "list" "reset!") :bytecode (20 0 0 16 0 48 1 17 1 18 0 33 15 0 18 0 16 1 52 2 0 1 52 1 0 2 32 2 0 16 1 17 2 20 3 0 18 1 16 2 49 2 50)}) :bytecode (20 0 0 18 0 18 1 51 1 0 0 2 0 3 48 3 17 0 16 0 50)}) :bytecode (20 0 0 51 1 0 1 0 1 1 1 3 1 2 49 1 50)} "resource" {:upvalue-count 0 :arity 1 :constants ("signal" "dict" "loading" "data" "error" "promise-then" "cek-call" {:upvalue-count 1 :arity 1 :constants ("reset!" "dict" "loading" "data" "error") :bytecode (20 0 0 18 0 1 2 0 4 1 3 0 16 0 1 4 0 2 52 1 0 6 49 2 50)} {:upvalue-count 1 :arity 1 :constants ("reset!" "dict" "loading" "data" "error") :bytecode (20 0 0 18 0 1 2 0 4 1 3 0 2 1 4 0 16 0 52 1 0 6 49 2 50)}) :bytecode (20 0 0 1 2 0 3 1 3 0 2 1 4 0 2 52 1 0 6 48 1 17 1 20 5 0 16 0 2 52 6 0 2 51 7 0 1 1 51 8 0 1 1 48 3 5 16 1 50)} {:library (sx signals-web) :op "import"}) :bytecode (51 1 0 128 0 0 5 51 3 0 128 2 0 5 51 5 0 128 4 0 5 51 7 0 128 6 0 5 51 9 0 128 8 0 5 51 11 0 128 10 0 5 1 12 0 112 50)))

68
shared/static/wasm/sx_browser.bc.js
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx_browser.bc.wasm.js
View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
}
(globalThis))
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-42ed14c8",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-acaac3c1",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["sx-7ec49d05",[2,3]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,5]],["dune__exe__Sx_browser-acaac3c1",[2,4,6]],["std_exit-10fb8830",[2]],["start-f808dbe1",0]],"generated":(b=>{var
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new