diff --git a/wasm/asm/lumbda.wat b/wasm/asm/lumbda.wat index 62d26dd..0ec5860 100644 --- a/wasm/asm/lumbda.wat +++ b/wasm/asm/lumbda.wat @@ -2247,9 +2247,92 @@ (local.set $body (i32.load offset=8 (local.get $fn))) (local.set $env (i32.load offset=12 (local.get $fn))) (local.set $new_env (call $bind_params (local.get $params) (local.get $args) (local.get $env))) + ;; R7RS internal definitions: leading (define ...) forms in a + ;; lambda body bind locally (letrec*-style) instead of polluting + ;; the global env. hoist_internal_defines returns the env extended + ;; with placeholder VOID bindings and advances $body past them; + ;; then we evaluate each define's value-expression in the new env + ;; (so mutual references work) and env_set the real value. + (local.set $new_env (call $hoist_internal_defines (local.get $body) (local.get $new_env))) + (local.set $body (call $strip_leading_defines (local.get $body))) + (call $fill_internal_defines (i32.load offset=8 (local.get $fn)) (local.get $new_env)) (return_call $eval_begin (local.get $body) (local.get $new_env)))) (global.get $VOID)) + ;; Walk leading (define ...) forms in $body; for each, add a placeholder + ;; VOID binding to $env. Returns the extended env. Body is unchanged + ;; (we strip and fill separately to keep iteration simple). + (func $hoist_internal_defines (param $body i32) (param $env i32) (result i32) + (local $form i32) + (local $head i32) + (local $rest i32) + (local $name i32) + (block $done + (loop $l + (br_if $done (i32.eqz (call $is_pair (local.get $body)))) + (local.set $form (call $car (local.get $body))) + (br_if $done (i32.eqz (call $is_pair (local.get $form)))) + (br_if $done (i32.ne (call $car (local.get $form)) (global.get $sym_define))) + (local.set $rest (call $cdr (local.get $form))) + (local.set $head (call $car (local.get $rest))) + ;; (define name expr) — head is a symbol + ;; (define (f . args) body) — head is a pair, name = car + (if (call $is_pair (local.get $head)) + (then (local.set $name (call $car (local.get $head)))) + (else (local.set $name (local.get $head)))) + (local.set $env (call $env_define (local.get $env) (local.get $name) (global.get $VOID))) + (local.set $body (call $cdr (local.get $body))) + (br $l))) + (local.get $env)) + + (func $strip_leading_defines (param $body i32) (result i32) + (local $form i32) + (block $done + (loop $l + (br_if $done (i32.eqz (call $is_pair (local.get $body)))) + (local.set $form (call $car (local.get $body))) + (br_if $done (i32.eqz (call $is_pair (local.get $form)))) + (br_if $done (i32.ne (call $car (local.get $form)) (global.get $sym_define))) + (local.set $body (call $cdr (local.get $body))) + (br $l))) + (local.get $body)) + + ;; Second pass of letrec* expansion — evaluate each internal-define's + ;; value-expression in the new env, env_set the real value. Operates + ;; on the ORIGINAL body (with defines still in it) so we know what to + ;; bind. Forms after the leading defines are skipped. + (func $fill_internal_defines (param $body i32) (param $env i32) + (local $form i32) + (local $rest i32) + (local $head i32) + (local $name i32) + (local $value_expr i32) + (local $params i32) + (local $closure_body i32) + (block $done + (loop $l + (br_if $done (i32.eqz (call $is_pair (local.get $body)))) + (local.set $form (call $car (local.get $body))) + (br_if $done (i32.eqz (call $is_pair (local.get $form)))) + (br_if $done (i32.ne (call $car (local.get $form)) (global.get $sym_define))) + (local.set $rest (call $cdr (local.get $form))) + (local.set $head (call $car (local.get $rest))) + (if (call $is_pair (local.get $head)) + (then + ;; (define (f . params) body...) → desugar to closure + (local.set $name (call $car (local.get $head))) + (local.set $params (call $cdr (local.get $head))) + (local.set $closure_body (call $cdr (local.get $rest))) + (drop (call $env_set (local.get $env) (local.get $name) + (call $make_closure (local.get $params) (local.get $closure_body) (local.get $env))))) + (else + (local.set $name (local.get $head)) + (local.set $value_expr (call $car (call $cdr (local.get $rest)))) + (drop (call $env_set (local.get $env) (local.get $name) + (call $eval (local.get $value_expr) (local.get $env)))))) + (local.set $body (call $cdr (local.get $body))) + (br $l)))) + ;; Pairwise bind params (a list of symbols, or symbol for rest) to args. (func $bind_params (param $params i32) (param $args i32) (param $env i32) (result i32) (local $new i32) diff --git a/wasm/c/lumbda_wasm_entry.c b/wasm/c/lumbda_wasm_entry.c index b4648e2..af407c5 100644 --- a/wasm/c/lumbda_wasm_entry.c +++ b/wasm/c/lumbda_wasm_entry.c @@ -1,12 +1,39 @@ /* lumbda_wasm_entry.c — Emscripten entry points for the C tier. * + * MEMORY MODEL — c-wasm tier + * --------------------------- + * The native C tier links libgc (Boehm conservative collector) and + * everything is GC-managed. The WASM build defines LUMBDA_NO_BOEHM (no + * libgc port wired up to Emscripten), so gc.c takes its plain-malloc + * fallback path. malloc returns memory; nothing ever returns it. + * + * For browser use this manifests as monotonic linear-memory growth in + * the worker. The REPL surfaces the pressure in its tabbar ("c 48M ↑") + * and the "reboot tier" button gives users a manual reclaim path — + * terminate + respawn the worker, which destroys the heap entirely. + * + * Real fixes, in order of decreasing cost: + * 1. Build bdwgc (github.com/ivmai/bdwgc) with emcc and link the + * WASM build with USE_BOEHM_GC defined. Their build system has + * a single-threaded mode that would suit our worker context. + * 2. Write a small mark-sweep over the existing NaN-boxed heap. + * The asm WAT tier already does this with a Cheney copying GC + * (lumbda_gc, gc_collect in asm/lumbda.wat). Same algorithm + * ports here once we know each lumbda struct's pointer-field + * layout — types.c is the source of truth there. + * 3. Generational reset: between top-level evals, snapshot global + * env + interns to s-expressions, tear down everything, replay. + * Crudest of the three. + * + * ENTRY POINTS + * ------------ * The JS loader provides Module.print / Module.printErr callbacks that * Emscripten routes stdout/stderr through, so output capture happens on * the JS side. We only expose: * - * lumbda_wasm_init() — set up symbols + env + stdlib - * lumbda_wasm_eval(src) — eval src, last value printed if non-void - * lumbda_wasm_free_result(p) — free a string returned to JS + * lumbda_wasm_init() - set up symbols + env + stdlib + * lumbda_wasm_eval(src) - eval src, last value printed if non-void + * lumbda_wasm_free_result(p) - free a string returned to JS * * The env is module-global so successive eval calls preserve defines. */ diff --git a/wasm/dist-repl/asm/lumbda-asm.wasm b/wasm/dist-repl/asm/lumbda-asm.wasm index f1374d1..b937d55 100644 Binary files a/wasm/dist-repl/asm/lumbda-asm.wasm and b/wasm/dist-repl/asm/lumbda-asm.wasm differ diff --git a/wasm/tests/parity-corpus.mjs b/wasm/tests/parity-corpus.mjs index 1979f3c..460ea15 100644 --- a/wasm/tests/parity-corpus.mjs +++ b/wasm/tests/parity-corpus.mjs @@ -50,6 +50,14 @@ export const CORPUS = [ { tag: "gc-survives-eval", expected: "(1 4 9 16)", src: "(let loop ((i 0)) (if (= i 200) 0 (begin (cons i i) (loop (+ i 1))))) (map (lambda (x) (* x x)) (list 1 2 3 4))" }, + // ─── Internal-define scoping (R7RS letrec*) ────────────────────── + { tag: "internal-define-local", expected: "1", + src: "(define x 1) (define (f) (define x 99) x) (f) x" }, + { tag: "internal-define-returns", expected: "99", + src: "(define (f) (define x 99) x) (f)" }, + { tag: "internal-define-mutual", expected: "#t", + src: "(define (g) (define (e? n) (if (= n 0) #t (o? (- n 1)))) (define (o? n) (if (= n 0) #f (e? (- n 1)))) (e? 6)) (g)" }, + // ─── division semantics ────────────────────────────────────────── { tag: "quotient-pos", src: "(quotient 17 5)", expected: "3" }, { tag: "quotient-neg", src: "(quotient -17 5)", expected: "-3" }, diff --git a/www/playground/asm/lumbda-asm.wasm b/www/playground/asm/lumbda-asm.wasm index f1374d1..b937d55 100644 Binary files a/www/playground/asm/lumbda-asm.wasm and b/www/playground/asm/lumbda-asm.wasm differ diff --git a/www/repl/asm/lumbda-asm.wasm b/www/repl/asm/lumbda-asm.wasm index f1374d1..b937d55 100644 Binary files a/www/repl/asm/lumbda-asm.wasm and b/www/repl/asm/lumbda-asm.wasm differ