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

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:
2026-04-11 08:52:36 +00:00
parent bca0d8e4e5
commit ef8f8b7c03
17 changed files with 278 additions and 84 deletions

View File

@@ -126,36 +126,102 @@ for (const file of FILES) {
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
function stripLibraryWrapper(source) { function stripLibraryWrapper(source) {
// Line-based stripping: unwrap (define-library ... (begin BODY)), keep (import ...). // Paren-aware stripping: find (begin ...) inside (define-library ...), extract body.
const lines = source.split('\n'); // Keep top-level (import ...) forms outside the define-library.
const result = [];
let skip = false; // inside header region (define-library, export)
for (let i = 0; i < lines.length; i++) { // Find (define-library at the start
const line = lines[i]; const dlMatch = source.match(/^[\s\S]*?\(define-library\b/);
const trimmed = line.trim(); if (!dlMatch) return source; // no define-library, return as-is
// Skip (define-library ...) header lines until (begin // Find the (begin that opens the body — skip past (export ...) using paren counting
if (trimmed.startsWith('(define-library ')) { skip = true; continue; } const afterDL = dlMatch[0].length;
if (skip && trimmed.startsWith('(export')) { continue; } let pos = afterDL;
if (skip && trimmed.match(/^\(begin/)) { skip = false; continue; } let foundBegin = -1;
if (skip) continue;
// Skip closing )) of define-library — line is just ) or )) optionally with comments while (pos < source.length) {
if (trimmed.match(/^\)+(\s*;.*)?$/)) { // Skip whitespace and comments
// Check if this is the end-of-define-library closer (only `)` chars + optional comment) while (pos < source.length && /[\s]/.test(source[pos])) pos++;
// vs a regular body closer like ` )` inside a nested form if (pos >= source.length) break;
// Only skip if at column 0 (not indented = top-level closer) if (source[pos] === ';') { // skip comment line
if (line.match(/^\)/)) continue; while (pos < source.length && source[pos] !== '\n') pos++;
continue;
} }
// Skip standalone comments that are just structural markers // Check for (begin
if (trimmed.match(/^;;\s*(end define-library|Re-export)/)) continue; 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) // Compile each module (stripped of define-library/import wrappers)

View File

@@ -589,24 +589,64 @@
(list (list (make-symbol loop-name) lambda-expr))) (list (list (make-symbol loop-name) lambda-expr)))
(call-expr (cons (make-symbol loop-name) inits))) (call-expr (cons (make-symbol loop-name) inits)))
(compile-letrec em (list letrec-bindings call-expr) scope tail?))) (compile-letrec em (list letrec-bindings call-expr) scope tail?)))
(let (if
((bindings (first args)) (dict? (first args))
(body (rest args)) (let
(let-scope (make-scope scope))) ((pattern (first args))
(dict-set! let-scope "next-slot" (get scope "next-slot")) (source-expr (nth args 1))
(for-each (body (slice args 2))
(fn (let-scope (make-scope scope)))
(binding) (dict-set! let-scope "next-slot" (get scope "next-slot"))
(let (compile-expr em source-expr let-scope false)
((name (if (= (type-of (first binding)) "symbol") (symbol-name (first binding)) (first binding))) (let
(value (nth binding 1))) ((temp-slot (scope-define-local let-scope "__dict_src")))
(compile-expr em value let-scope false) (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 (let
((slot (scope-define-local let-scope name))) ((name (if (= (type-of (first binding)) "symbol") (first binding) (make-symbol (first binding))))
(emit-op em 17) (value (nth binding 1)))
(emit-byte em slot)))) (compile-expr em value let-scope false)
bindings) (let
(compile-begin em body let-scope tail?))))) ((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 (define
compile-letrec compile-letrec
(fn (fn

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View File

@@ -589,24 +589,64 @@
(list (list (make-symbol loop-name) lambda-expr))) (list (list (make-symbol loop-name) lambda-expr)))
(call-expr (cons (make-symbol loop-name) inits))) (call-expr (cons (make-symbol loop-name) inits)))
(compile-letrec em (list letrec-bindings call-expr) scope tail?))) (compile-letrec em (list letrec-bindings call-expr) scope tail?)))
(let (if
((bindings (first args)) (dict? (first args))
(body (rest args)) (let
(let-scope (make-scope scope))) ((pattern (first args))
(dict-set! let-scope "next-slot" (get scope "next-slot")) (source-expr (nth args 1))
(for-each (body (slice args 2))
(fn (let-scope (make-scope scope)))
(binding) (dict-set! let-scope "next-slot" (get scope "next-slot"))
(let (compile-expr em source-expr let-scope false)
((name (if (= (type-of (first binding)) "symbol") (symbol-name (first binding)) (first binding))) (let
(value (nth binding 1))) ((temp-slot (scope-define-local let-scope "__dict_src")))
(compile-expr em value let-scope false) (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 (let
((slot (scope-define-local let-scope name))) ((name (if (= (type-of (first binding)) "symbol") (first binding) (make-symbol (first binding))))
(emit-op em 17) (value (nth binding 1)))
(emit-byte em slot)))) (compile-expr em value let-scope false)
bindings) (let
(compile-begin em body let-scope tail?))))) ((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 (define
compile-letrec compile-letrec
(fn (fn

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View File

@@ -1,3 +1,3 @@
(sxbc 1 "232c1519553b1d5f" (sxbc 1 "232c1519553b1d5f"
(code (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)))

File diff suppressed because one or more lines are too long

View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create}; blake2_js_for_wasm_create: blake2_js_for_wasm_create};
} }
(globalThis)) (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 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_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 Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new