engineering/lumbda
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
lumbda/wasm/asm/lumbda.wat
russell@unturf.com 1b7de2c9c6
wasm/playground: cancel button, asm state-leak fix, restyle to match homepage 
User-visible changes
  - Cancel button — terminates the running worker. Pyodide's slow mandelbrot
    no longer freezes the UI; click cancel and the elapsed counter freezes
    at "(cancelled @ NNNN ms)".
  - Live ms counter ticks per animation frame while a tier is busy, so the
    Pyodide tier's ~5-15 s wait is visible instead of looking hung.
  - Restyled to match lumbda.com: chunkfive wordmark, --green: #227842
    (light) / #5ec07a (dark), lumbda-logo-green.png, lowercase "lumbda"
    everywhere. Pulls fonts/chunkfive locally so the playground stays
    self-contained.

Architecture
  - All tier evaluations now run inside a Web Worker (wasm/app/worker.mjs)
    so the main thread stays responsive. Cancel = worker.terminate(); next
    eval respawns a fresh worker.
  - Loaders use new URL("./...", import.meta.url) so paths resolve against
    the loader file's own location — works identically in window and
    worker contexts, no baseURL argument needed.
  - C tier Emscripten build flipped to EXPORT_ES6=1; loader uses dynamic
    `import()` of the factory module. Integration test updated accordingly.
  - Python loader uses `import("pyodide.mjs")` (ES module) instead of
    document.createElement, which doesn't exist in workers.

Bug fixes
  - Asm tier state leak: running the same demo twice on a cached WASM
    instance produced corrupted output (every other cell on row 2+ rendered
    as " " instead of the expected shade char). Root cause: top-level eval
    passed `global_env` as the env, so closures captured stale globals;
    fixed by passing NIL — env_lookup falls back to the CURRENT global_env
    via its existing two-pass walk. Multi-run regression added to the
    functional test suite.
  - fib-ack demo: (ack 3 4) was too heavy for Pyodide (minutes). Cut to
    (ack 3 3) + (fib 20) max so every tier finishes in seconds.

Test discipline
  - Root `make test-all` now includes `wasm-test`. Adding a language
    feature without exercising it on all six implementations is no longer
    possible by accident.
  - Functional suite: 11 assertions (was 10) — adds asm multi-run stability.
  - Integration + unit: still 20 + 8.
2026-06-14 12:13:20 -04:00

1206 lines
50 KiB
Text
Raw Blame History

;; wasm/asm/lumbda.wat
;; Lumbda asm tier for the browser — hand-written WebAssembly Text format.
;;
;; This is the parallel implementation to asm/lumbda.s (x86_64). Both
;; target raw stack-machine assembly with no libc; both manage their
;; own linear memory. The instruction set differs (WASM is a stack
;; machine, x86_64 is register), the spirit matches.
;;
;; SUBSET: arithmetic, lambda, define, if, quote, cond (via cascaded if),
;; cons/car/cdr/null?/pair?/eq?, display/newline/print, list/length,
;; closures with lexical scope, tail-recursive enough for fib & ack.
;; Symbols intern via linear scan (acceptable for the demo programs;
;; would be MOAD-0001 at scale, documented in the SPA).
;;
;; Value encoding (32-bit i32):
;; bit 0 = 1 → fixnum, value = (v >> 1) sign-extended (31-bit range)
;; bit 0 = 0 → heap address or reserved immediate
;; v = 4 → NIL
;; v = 8 → TRUE (#t)
;; v = 12 → FALSE (#f)
;; v = 16 → VOID
;; v ≥ 32 → heap object, first i32 is type tag
;;
;; Heap object tags:
;; 1 = pair [tag, car, cdr] 12 bytes
;; 2 = symbol [tag, len, bytes...] 8 + N bytes
;; 3 = closure [tag, params, body, env] 16 bytes
;; 4 = primitive [tag, prim_id] 8 bytes
;; 5 = string [tag, len, bytes...] 8 + N bytes
;;
;; Memory map:
;; 0x00000..0x0001F reserved (immediates + slot 0)
;; 0x00020..0x000FF globals (heap_ptr, output_len, source pos, intern list, env)
;; 0x10000..0x1FFFF output buffer (64 KB)
;; 0x20000..0x2FFFF source input copy (64 KB)
;; 0x30000..onward heap (bump allocator)
;;
;; Built-in symbols (interned at init) live early on the heap.
(module
;; ─── Memory & exports ──────────────────────────────────────────
(memory (export "memory") 32 4096) ;; 32 pages = 2 MB initial, grow to 256 MB
(global $heap_ptr (mut i32) (i32.const 0x30000))
(global $output_len (mut i32) (i32.const 0))
(global $source_ptr (mut i32) (i32.const 0x20000))
(global $source_end (mut i32) (i32.const 0x20000))
(global $intern_list (mut i32) (i32.const 4)) ;; NIL initially
(global $global_env (mut i32) (i32.const 4)) ;; NIL initially
(global $initialized (mut i32) (i32.const 0))
;; Pre-allocated symbol pointers for special forms — filled at init.
(global $sym_quote (mut i32) (i32.const 0))
(global $sym_if (mut i32) (i32.const 0))
(global $sym_lambda (mut i32) (i32.const 0))
(global $sym_define (mut i32) (i32.const 0))
(global $sym_begin (mut i32) (i32.const 0))
(global $sym_cond (mut i32) (i32.const 0))
(global $sym_else (mut i32) (i32.const 0))
(global $sym_let (mut i32) (i32.const 0))
(global $sym_and (mut i32) (i32.const 0))
(global $sym_or (mut i32) (i32.const 0))
(global $sym_set (mut i32) (i32.const 0))
;; Constants (immediate value addresses)
(global $NIL i32 (i32.const 4))
(global $TRUE i32 (i32.const 8))
(global $FALSE i32 (i32.const 12))
(global $VOID i32 (i32.const 16))
;; ─── Allocator ─────────────────────────────────────────────────
;; Bump-only. Grows linear memory by 16 pages (1 MB) at a time when
;; heap_ptr nears the limit. No free, no GC — fine for browser demos
;; where the tab tears down at unload. Matches the asm/lumbda.s
;; discipline (heap never shrinks) — see CLAUDE.md.
(func $alloc (param $n i32) (result i32)
(local $p i32)
(local $end i32)
(local $limit i32)
(local.set $p (global.get $heap_ptr))
(local.set $end (i32.add (local.get $p) (local.get $n)))
(local.set $limit (i32.mul (memory.size) (i32.const 65536)))
(if (i32.ge_u (local.get $end) (local.get $limit))
(then
(drop (memory.grow (i32.const 16)))))
(global.set $heap_ptr
(i32.and
(i32.add (local.get $end) (i32.const 3))
(i32.const 0xFFFFFFFC)))
(local.get $p))
;; ─── Tag predicates ────────────────────────────────────────────
(func $is_fixnum (param $v i32) (result i32)
(i32.and (local.get $v) (i32.const 1)))
(func $is_immediate (param $v i32) (result i32)
;; immediate iff 4 ≤ v ≤ 16 and low bit 0
(i32.and
(i32.eqz (i32.and (local.get $v) (i32.const 1)))
(i32.and
(i32.le_u (i32.const 4) (local.get $v))
(i32.le_u (local.get $v) (i32.const 16)))))
(func $obj_tag (param $v i32) (result i32)
;; assumes v is a heap address ≥ 32
(i32.load (local.get $v)))
(func $is_pair (param $v i32) (result i32)
(if (result i32) (call $is_fixnum (local.get $v))
(then (i32.const 0))
(else
(if (result i32) (call $is_immediate (local.get $v))
(then (i32.const 0))
(else (i32.eq (call $obj_tag (local.get $v)) (i32.const 1)))))))
(func $is_symbol (param $v i32) (result i32)
(if (result i32) (call $is_fixnum (local.get $v))
(then (i32.const 0))
(else
(if (result i32) (call $is_immediate (local.get $v))
(then (i32.const 0))
(else (i32.eq (call $obj_tag (local.get $v)) (i32.const 2)))))))
(func $is_closure (param $v i32) (result i32)
(if (result i32) (call $is_fixnum (local.get $v))
(then (i32.const 0))
(else
(if (result i32) (call $is_immediate (local.get $v))
(then (i32.const 0))
(else (i32.eq (call $obj_tag (local.get $v)) (i32.const 3)))))))
(func $is_primitive (param $v i32) (result i32)
(if (result i32) (call $is_fixnum (local.get $v))
(then (i32.const 0))
(else
(if (result i32) (call $is_immediate (local.get $v))
(then (i32.const 0))
(else (i32.eq (call $obj_tag (local.get $v)) (i32.const 4)))))))
(func $is_string (param $v i32) (result i32)
(if (result i32) (call $is_fixnum (local.get $v))
(then (i32.const 0))
(else
(if (result i32) (call $is_immediate (local.get $v))
(then (i32.const 0))
(else (i32.eq (call $obj_tag (local.get $v)) (i32.const 5)))))))
;; ─── Constructors ──────────────────────────────────────────────
(func $make_fixnum (export "make_fixnum") (param $n i32) (result i32)
(i32.or (i32.shl (local.get $n) (i32.const 1)) (i32.const 1)))
(func $fixnum_val (param $v i32) (result i32)
(i32.shr_s (local.get $v) (i32.const 1)))
(func $make_pair (param $car i32) (param $cdr i32) (result i32)
(local $p i32)
(local.set $p (call $alloc (i32.const 12)))
(i32.store (local.get $p) (i32.const 1))
(i32.store offset=4 (local.get $p) (local.get $car))
(i32.store offset=8 (local.get $p) (local.get $cdr))
(local.get $p))
(func $car (param $p i32) (result i32)
(i32.load offset=4 (local.get $p)))
(func $cdr (param $p i32) (result i32)
(i32.load offset=8 (local.get $p)))
(func $set_car (param $p i32) (param $v i32)
(i32.store offset=4 (local.get $p) (local.get $v)))
(func $set_cdr (param $p i32) (param $v i32)
(i32.store offset=8 (local.get $p) (local.get $v)))
;; Allocate a symbol object with given char bytes.
;; The bytes are at $src_ptr for $len bytes. Returns symbol pointer.
(func $alloc_symbol (param $src_ptr i32) (param $len i32) (result i32)
(local $sym i32)
(local $i i32)
(local.set $sym (call $alloc (i32.add (i32.const 8) (local.get $len))))
(i32.store (local.get $sym) (i32.const 2))
(i32.store offset=4 (local.get $sym) (local.get $len))
(local.set $i (i32.const 0))
(block $done
(loop $copy
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(i32.store8
(i32.add (i32.add (local.get $sym) (i32.const 8)) (local.get $i))
(i32.load8_u (i32.add (local.get $src_ptr) (local.get $i))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $copy)))
(local.get $sym))
;; Compare two symbol payloads by bytes.
(func $sym_bytes_eq (param $sym i32) (param $src_ptr i32) (param $len i32) (result i32)
(local $slen i32)
(local $i i32)
(local.set $slen (i32.load offset=4 (local.get $sym)))
(if (i32.ne (local.get $slen) (local.get $len))
(then (return (i32.const 0))))
(local.set $i (i32.const 0))
(block $done
(loop $cmp
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(if (i32.ne
(i32.load8_u
(i32.add (i32.add (local.get $sym) (i32.const 8)) (local.get $i)))
(i32.load8_u (i32.add (local.get $src_ptr) (local.get $i))))
(then (return (i32.const 0))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $cmp)))
(i32.const 1))
;; Intern a symbol by string content (bytes at $src_ptr, length $len).
;; Returns the symbol's heap pointer; reuses existing entry if found.
(func $intern (param $src_ptr i32) (param $len i32) (result i32)
(local $list i32)
(local $sym i32)
(local $new i32)
(local.set $list (global.get $intern_list))
(block $done
(loop $scan
(br_if $done (i32.eq (local.get $list) (global.get $NIL)))
(local.set $sym (call $car (local.get $list)))
(if (call $sym_bytes_eq (local.get $sym) (local.get $src_ptr) (local.get $len))
(then (return (local.get $sym))))
(local.set $list (call $cdr (local.get $list)))
(br $scan)))
(local.set $new (call $alloc_symbol (local.get $src_ptr) (local.get $len)))
(global.set $intern_list (call $make_pair (local.get $new) (global.get $intern_list)))
(local.get $new))
(func $make_primitive (param $id i32) (result i32)
(local $p i32)
(local.set $p (call $alloc (i32.const 8)))
(i32.store (local.get $p) (i32.const 4))
(i32.store offset=4 (local.get $p) (local.get $id))
(local.get $p))
(func $make_closure (param $params i32) (param $body i32) (param $env i32) (result i32)
(local $c i32)
(local.set $c (call $alloc (i32.const 16)))
(i32.store (local.get $c) (i32.const 3))
(i32.store offset=4 (local.get $c) (local.get $params))
(i32.store offset=8 (local.get $c) (local.get $body))
(i32.store offset=12 (local.get $c) (local.get $env))
(local.get $c))
;; ─── Environment (assoc list of (sym . value) pairs) ───────────
(func $env_define (param $env i32) (param $sym i32) (param $val i32) (result i32)
(call $make_pair
(call $make_pair (local.get $sym) (local.get $val))
(local.get $env)))
;; Walk captured env chain first (lexical scope), then fall back to the
;; current global_env (so top-level defines that happen AFTER a closure
;; is captured are still visible to it — required for forward references
;; and mutual recursion at the top level).
(func $env_lookup (param $env i32) (param $sym i32) (result i32)
(local $bind i32)
(local $cur i32)
(local.set $cur (local.get $env))
(block $done
(loop $scan
(br_if $done (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $bind (call $car (local.get $cur)))
(if (i32.eq (call $car (local.get $bind)) (local.get $sym))
(then (return (call $cdr (local.get $bind)))))
(local.set $cur (call $cdr (local.get $cur)))
(br $scan)))
(local.set $cur (global.get $global_env))
(block $done2
(loop $scan2
(br_if $done2 (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $bind (call $car (local.get $cur)))
(if (i32.eq (call $car (local.get $bind)) (local.get $sym))
(then (return (call $cdr (local.get $bind)))))
(local.set $cur (call $cdr (local.get $cur)))
(br $scan2)))
(global.get $VOID))
(func $env_set (param $env i32) (param $sym i32) (param $val i32) (result i32)
(local $bind i32)
(block $done
(loop $scan
(br_if $done (i32.eq (local.get $env) (global.get $NIL)))
(local.set $bind (call $car (local.get $env)))
(if (i32.eq (call $car (local.get $bind)) (local.get $sym))
(then
(call $set_cdr (local.get $bind) (local.get $val))
(return (global.get $VOID))))
(local.set $env (call $cdr (local.get $env)))
(br $scan)))
(global.get $VOID))
;; ─── Output buffer ─────────────────────────────────────────────
(func $out_char (param $c i32)
(i32.store8
(i32.add (i32.const 0x10000) (global.get $output_len))
(local.get $c))
(global.set $output_len (i32.add (global.get $output_len) (i32.const 1))))
(func $out_str (param $ptr i32) (param $len i32)
(local $i i32)
(local.set $i (i32.const 0))
(block $done
(loop $loop
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(call $out_char (i32.load8_u (i32.add (local.get $ptr) (local.get $i))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $loop))))
;; Print an integer (signed) to the output buffer.
(func $out_int (param $n i32)
(local $buf_off i32)
(local $neg i32)
(local $digits_start i32)
(local $i i32)
(local $tmp i32)
(local $j i32)
(local $swap i32)
;; Use a small scratch area at 0x100 (256 bytes)
(local.set $buf_off (i32.const 0x100))
(local.set $neg (i32.const 0))
(if (i32.lt_s (local.get $n) (i32.const 0))
(then
(local.set $neg (i32.const 1))
(local.set $n (i32.sub (i32.const 0) (local.get $n)))))
(local.set $i (i32.const 0))
(if (i32.eqz (local.get $n))
(then
(i32.store8 (i32.add (local.get $buf_off) (local.get $i)) (i32.const 48))
(local.set $i (i32.const 1)))
(else
(block $done
(loop $loop
(br_if $done (i32.eqz (local.get $n)))
(i32.store8
(i32.add (local.get $buf_off) (local.get $i))
(i32.add (i32.const 48) (i32.rem_u (local.get $n) (i32.const 10))))
(local.set $n (i32.div_u (local.get $n) (i32.const 10)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $loop)))))
(if (local.get $neg)
(then (call $out_char (i32.const 45))))
;; Reverse output: digits are stored low-to-high, emit high-to-low.
(local.set $j (i32.sub (local.get $i) (i32.const 1)))
(block $done2
(loop $loop2
(br_if $done2 (i32.lt_s (local.get $j) (i32.const 0)))
(call $out_char (i32.load8_u (i32.add (local.get $buf_off) (local.get $j))))
(local.set $j (i32.sub (local.get $j) (i32.const 1)))
(br $loop2))))
;; Print a value (display semantics; minimal show).
(func $print_value (param $v i32)
(local $bytes i32)
(local $len i32)
(if (call $is_fixnum (local.get $v))
(then (call $out_int (call $fixnum_val (local.get $v))) (return)))
(if (i32.eq (local.get $v) (global.get $NIL))
(then (call $out_str (i32.const 0xF000) (i32.const 2)) (return))) ;; "()"
(if (i32.eq (local.get $v) (global.get $TRUE))
(then (call $out_str (i32.const 0xF010) (i32.const 2)) (return))) ;; "#t"
(if (i32.eq (local.get $v) (global.get $FALSE))
(then (call $out_str (i32.const 0xF020) (i32.const 2)) (return))) ;; "#f"
(if (i32.eq (local.get $v) (global.get $VOID))
(then (return)))
(if (call $is_symbol (local.get $v))
(then
(local.set $bytes (i32.add (local.get $v) (i32.const 8)))
(local.set $len (i32.load offset=4 (local.get $v)))
(call $out_str (local.get $bytes) (local.get $len))
(return)))
(if (call $is_string (local.get $v))
(then
(local.set $bytes (i32.add (local.get $v) (i32.const 8)))
(local.set $len (i32.load offset=4 (local.get $v)))
(call $out_str (local.get $bytes) (local.get $len))
(return)))
(if (call $is_pair (local.get $v))
(then
(call $out_char (i32.const 40)) ;; (
(call $print_list_items (local.get $v))
(call $out_char (i32.const 41)) ;; )
(return)))
;; closure / primitive
(call $out_str (i32.const 0xF030) (i32.const 11))) ;; "<procedure>"
(func $print_list_items (param $p i32)
(block $done
(loop $loop
(br_if $done (i32.eqz (call $is_pair (local.get $p))))
(call $print_value (call $car (local.get $p)))
(local.set $p (call $cdr (local.get $p)))
(if (call $is_pair (local.get $p))
(then (call $out_char (i32.const 32)))) ;; space
(br $loop)))
(if (i32.ne (local.get $p) (global.get $NIL))
(then
(call $out_str (i32.const 0xF040) (i32.const 3)) ;; " . "
(call $print_value (local.get $p)))))
;; ─── Reader ────────────────────────────────────────────────────
;; Advance $source_ptr past whitespace + ; comments.
(func $skip_ws
(local $c i32)
(block $done
(loop $loop
(br_if $done (i32.ge_u (global.get $source_ptr) (global.get $source_end)))
(local.set $c (i32.load8_u (global.get $source_ptr)))
(if (i32.eq (local.get $c) (i32.const 32)) ;; space
(then (global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1))) (br $loop)))
(if (i32.eq (local.get $c) (i32.const 9)) ;; tab
(then (global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1))) (br $loop)))
(if (i32.eq (local.get $c) (i32.const 10)) ;; LF
(then (global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1))) (br $loop)))
(if (i32.eq (local.get $c) (i32.const 13)) ;; CR
(then (global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1))) (br $loop)))
(if (i32.eq (local.get $c) (i32.const 59)) ;; ;
(then
(block $cdone
(loop $cloop
(br_if $cdone (i32.ge_u (global.get $source_ptr) (global.get $source_end)))
(br_if $cdone
(i32.eq (i32.load8_u (global.get $source_ptr)) (i32.const 10)))
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(br $cloop)))
(br $loop)))
(br $done))))
(func $is_digit (param $c i32) (result i32)
(i32.and
(i32.ge_u (local.get $c) (i32.const 48))
(i32.le_u (local.get $c) (i32.const 57))))
(func $is_atom_char (param $c i32) (result i32)
;; non-whitespace, non-paren, non-quote, non-string-delim
(if (result i32) (i32.le_u (local.get $c) (i32.const 32))
(then (i32.const 0))
(else
(if (result i32) (i32.eq (local.get $c) (i32.const 40)) ;; (
(then (i32.const 0))
(else
(if (result i32) (i32.eq (local.get $c) (i32.const 41)) ;; )
(then (i32.const 0))
(else
(if (result i32) (i32.eq (local.get $c) (i32.const 39)) ;; '
(then (i32.const 0))
(else
(if (result i32) (i32.eq (local.get $c) (i32.const 34)) ;; "
(then (i32.const 0))
(else (i32.const 1))))))))))))
;; Parse one s-expression starting at $source_ptr. Returns the Value.
(func $read (result i32)
(local $c i32)
(local $start i32)
(local $len i32)
(local $n i32)
(local $neg i32)
(local $i i32)
(local $byte i32)
(local $sym i32)
(local $end_str i32)
(call $skip_ws)
(if (i32.ge_u (global.get $source_ptr) (global.get $source_end))
(then (return (global.get $VOID))))
(local.set $c (i32.load8_u (global.get $source_ptr)))
;; ( — read list
(if (i32.eq (local.get $c) (i32.const 40))
(then
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(return (call $read_list))))
;; ' — quote shorthand
(if (i32.eq (local.get $c) (i32.const 39))
(then
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(return (call $make_pair (global.get $sym_quote)
(call $make_pair (call $read) (global.get $NIL))))))
;; " — string
(if (i32.eq (local.get $c) (i32.const 34))
(then
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(return (call $read_string))))
;; #t #f
(if (i32.eq (local.get $c) (i32.const 35)) ;; #
(then
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(if (i32.ge_u (global.get $source_ptr) (global.get $source_end))
(then (return (global.get $VOID))))
(local.set $c (i32.load8_u (global.get $source_ptr)))
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(if (i32.eq (local.get $c) (i32.const 116)) ;; t
(then (return (global.get $TRUE))))
(if (i32.eq (local.get $c) (i32.const 102)) ;; f
(then (return (global.get $FALSE))))
(return (global.get $VOID))))
;; Atom: digits or symbol chars
(local.set $start (global.get $source_ptr))
(block $atom_done
(loop $atom_loop
(br_if $atom_done (i32.ge_u (global.get $source_ptr) (global.get $source_end)))
(br_if $atom_done
(i32.eqz (call $is_atom_char (i32.load8_u (global.get $source_ptr)))))
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(br $atom_loop)))
(local.set $len (i32.sub (global.get $source_ptr) (local.get $start)))
;; Number? must start with digit, or -digit / +digit with len > 1
(local.set $neg (i32.const 0))
(local.set $i (i32.const 0))
(local.set $byte (i32.load8_u (local.get $start)))
(if (i32.and
(i32.eq (local.get $byte) (i32.const 45)) ;; -
(i32.gt_s (local.get $len) (i32.const 1)))
(then
(local.set $neg (i32.const 1))
(local.set $i (i32.const 1))
(local.set $byte (i32.load8_u (i32.add (local.get $start) (i32.const 1))))))
(if (i32.and
(i32.eq (local.get $byte) (i32.const 43)) ;; +
(i32.gt_s (local.get $len) (i32.const 1)))
(then
(local.set $i (i32.const 1))
(local.set $byte (i32.load8_u (i32.add (local.get $start) (i32.const 1))))))
(if (call $is_digit (local.get $byte))
(then
(local.set $n (i32.const 0))
(block $num_done
(loop $num_loop
(br_if $num_done (i32.ge_u (local.get $i) (local.get $len)))
(local.set $byte (i32.load8_u (i32.add (local.get $start) (local.get $i))))
(br_if $num_done (i32.eqz (call $is_digit (local.get $byte))))
(local.set $n (i32.add (i32.mul (local.get $n) (i32.const 10))
(i32.sub (local.get $byte) (i32.const 48))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $num_loop)))
(if (i32.eq (local.get $i) (local.get $len))
(then
(if (local.get $neg)
(then (local.set $n (i32.sub (i32.const 0) (local.get $n)))))
(return (call $make_fixnum (local.get $n)))))))
;; Symbol
(return (call $intern (local.get $start) (local.get $len))))
;; Read list contents until ).
(func $read_list (result i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local $item i32)
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(block $done
(loop $loop
(call $skip_ws)
(if (i32.ge_u (global.get $source_ptr) (global.get $source_end))
(then (br $done)))
(if (i32.eq (i32.load8_u (global.get $source_ptr)) (i32.const 41)) ;; )
(then
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(br $done)))
(local.set $item (call $read))
(local.set $new (call $make_pair (local.get $item) (global.get $NIL)))
(if (i32.eq (local.get $head) (global.get $NIL))
(then
(local.set $head (local.get $new))
(local.set $tail (local.get $new)))
(else
(call $set_cdr (local.get $tail) (local.get $new))
(local.set $tail (local.get $new))))
(br $loop)))
(local.get $head))
;; Read a string literal (we've already consumed the opening ").
(func $read_string (result i32)
(local $start i32)
(local $len i32)
(local $s i32)
(local $i i32)
(local.set $start (global.get $source_ptr))
(block $done
(loop $loop
(br_if $done (i32.ge_u (global.get $source_ptr) (global.get $source_end)))
(br_if $done
(i32.eq (i32.load8_u (global.get $source_ptr)) (i32.const 34)))
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(br $loop)))
(local.set $len (i32.sub (global.get $source_ptr) (local.get $start)))
;; consume closing "
(if (i32.lt_u (global.get $source_ptr) (global.get $source_end))
(then (global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))))
;; Allocate a string object (same layout as symbol but tag=5).
(local.set $s (call $alloc (i32.add (i32.const 8) (local.get $len))))
(i32.store (local.get $s) (i32.const 5))
(i32.store offset=4 (local.get $s) (local.get $len))
(local.set $i (i32.const 0))
(block $cdone
(loop $cloop
(br_if $cdone (i32.ge_u (local.get $i) (local.get $len)))
(i32.store8
(i32.add (i32.add (local.get $s) (i32.const 8)) (local.get $i))
(i32.load8_u (i32.add (local.get $start) (local.get $i))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $cloop)))
(local.get $s))
;; ─── Eval ──────────────────────────────────────────────────────
(func $eval (param $expr i32) (param $env i32) (result i32)
(local $op i32)
(local $head i32)
(local $rest i32)
(local $val i32)
(local $params i32)
(local $body i32)
;; Self-evaluating: fixnum, immediate, string, closure, primitive
(if (call $is_fixnum (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_immediate (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_string (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_closure (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_primitive (local.get $expr))
(then (return (local.get $expr))))
;; Symbol — lookup
(if (call $is_symbol (local.get $expr))
(then (return (call $env_lookup (local.get $env) (local.get $expr)))))
;; Pair — special form or application
(if (call $is_pair (local.get $expr))
(then
(local.set $head (call $car (local.get $expr)))
(local.set $rest (call $cdr (local.get $expr)))
(if (i32.eq (local.get $head) (global.get $sym_quote))
(then (return (call $car (local.get $rest)))))
(if (i32.eq (local.get $head) (global.get $sym_if))
(then
(local.set $val (call $eval (call $car (local.get $rest)) (local.get $env)))
(if (i32.ne (local.get $val) (global.get $FALSE))
(then (return (call $eval (call $car (call $cdr (local.get $rest)))
(local.get $env))))
(else
(local.set $rest (call $cdr (call $cdr (local.get $rest))))
(if (i32.eq (local.get $rest) (global.get $NIL))
(then (return (global.get $VOID))))
(return (call $eval (call $car (local.get $rest)) (local.get $env)))))))
(if (i32.eq (local.get $head) (global.get $sym_lambda))
(then
(local.set $params (call $car (local.get $rest)))
(local.set $body (call $cdr (local.get $rest)))
(return (call $make_closure (local.get $params) (local.get $body) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_define))
(then (return (call $eval_define (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_set))
(then
(local.set $val (call $eval (call $car (call $cdr (local.get $rest))) (local.get $env)))
(call $env_set (local.get $env) (call $car (local.get $rest)) (local.get $val))
(return (global.get $VOID))))
(if (i32.eq (local.get $head) (global.get $sym_begin))
(then (return (call $eval_begin (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_cond))
(then (return (call $eval_cond (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_let))
(then (return (call $eval_let (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_and))
(then (return (call $eval_and (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_or))
(then (return (call $eval_or (local.get $rest) (local.get $env)))))
;; Function application
(return (call $apply
(call $eval (local.get $head) (local.get $env))
(call $eval_args (local.get $rest) (local.get $env))))))
(global.get $VOID))
;; (define x v) or (define (f a b) ...)
(func $eval_define (param $rest i32) (param $env i32) (result i32)
(local $head i32)
(local $val i32)
(local $name i32)
(local $params i32)
(local $body i32)
(local $closure i32)
(local $bind i32)
(local $g i32)
(local.set $head (call $car (local.get $rest)))
(if (call $is_pair (local.get $head))
(then
;; (define (f args...) body)
(local.set $name (call $car (local.get $head)))
(local.set $params (call $cdr (local.get $head)))
(local.set $body (call $cdr (local.get $rest)))
(local.set $closure (call $make_closure (local.get $params) (local.get $body) (local.get $env))))
(else
(local.set $name (local.get $head))
(local.set $closure (call $eval (call $car (call $cdr (local.get $rest))) (local.get $env)))))
;; Define in the global env (top frame) so mutual recursion works.
;; We mutate global_env to prepend a new binding.
(local.set $bind (call $make_pair (local.get $name) (local.get $closure)))
(global.set $global_env (call $make_pair (local.get $bind) (global.get $global_env)))
(global.get $VOID))
(func $eval_begin (param $rest i32) (param $env i32) (result i32)
(local $val i32)
(local.set $val (global.get $VOID))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $rest) (global.get $NIL)))
(local.set $val (call $eval (call $car (local.get $rest)) (local.get $env)))
(local.set $rest (call $cdr (local.get $rest)))
(br $loop)))
(local.get $val))
(func $eval_cond (param $rest i32) (param $env i32) (result i32)
(local $clause i32)
(local $test i32)
(local $body i32)
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $rest) (global.get $NIL)))
(local.set $clause (call $car (local.get $rest)))
(local.set $test (call $car (local.get $clause)))
(local.set $body (call $cdr (local.get $clause)))
(if (i32.eq (local.get $test) (global.get $sym_else))
(then (return (call $eval_begin (local.get $body) (local.get $env)))))
(if (i32.ne (call $eval (local.get $test) (local.get $env)) (global.get $FALSE))
(then (return (call $eval_begin (local.get $body) (local.get $env)))))
(local.set $rest (call $cdr (local.get $rest)))
(br $loop)))
(global.get $VOID))
;; (let ((x e) ...) body) — non-recursive form
(func $eval_let (param $rest i32) (param $env i32) (result i32)
(local $bindings i32)
(local $body i32)
(local $new_env i32)
(local $b i32)
(local $sym i32)
(local $val i32)
(local.set $bindings (call $car (local.get $rest)))
(local.set $body (call $cdr (local.get $rest)))
(local.set $new_env (local.get $env))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $bindings) (global.get $NIL)))
(local.set $b (call $car (local.get $bindings)))
(local.set $sym (call $car (local.get $b)))
(local.set $val (call $eval (call $car (call $cdr (local.get $b))) (local.get $env)))
(local.set $new_env (call $env_define (local.get $new_env) (local.get $sym) (local.get $val)))
(local.set $bindings (call $cdr (local.get $bindings)))
(br $loop)))
(call $eval_begin (local.get $body) (local.get $new_env)))
(func $eval_and (param $rest i32) (param $env i32) (result i32)
(local $val i32)
(local.set $val (global.get $TRUE))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $rest) (global.get $NIL)))
(local.set $val (call $eval (call $car (local.get $rest)) (local.get $env)))
(if (i32.eq (local.get $val) (global.get $FALSE))
(then (return (global.get $FALSE))))
(local.set $rest (call $cdr (local.get $rest)))
(br $loop)))
(local.get $val))
(func $eval_or (param $rest i32) (param $env i32) (result i32)
(local $val i32)
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $rest) (global.get $NIL)))
(local.set $val (call $eval (call $car (local.get $rest)) (local.get $env)))
(if (i32.ne (local.get $val) (global.get $FALSE))
(then (return (local.get $val))))
(local.set $rest (call $cdr (local.get $rest)))
(br $loop)))
(global.get $FALSE))
;; Evaluate each item in a list, returning a fresh list of values.
(func $eval_args (param $args i32) (param $env i32) (result i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $args) (global.get $NIL)))
(local.set $new
(call $make_pair
(call $eval (call $car (local.get $args)) (local.get $env))
(global.get $NIL)))
(if (i32.eq (local.get $head) (global.get $NIL))
(then
(local.set $head (local.get $new))
(local.set $tail (local.get $new)))
(else
(call $set_cdr (local.get $tail) (local.get $new))
(local.set $tail (local.get $new))))
(local.set $args (call $cdr (local.get $args)))
(br $loop)))
(local.get $head))
;; Apply a callable to an arg list.
(func $apply (param $fn i32) (param $args i32) (result i32)
(local $params i32)
(local $body i32)
(local $env i32)
(local $new_env i32)
(if (call $is_primitive (local.get $fn))
(then (return (call $apply_primitive
(i32.load offset=4 (local.get $fn))
(local.get $args)))))
(if (call $is_closure (local.get $fn))
(then
(local.set $params (i32.load offset=4 (local.get $fn)))
(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)))
(return (call $eval_begin (local.get $body) (local.get $new_env)))))
(global.get $VOID))
;; 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)
(local.set $new (local.get $env))
(block $done
(loop $loop
(if (call $is_symbol (local.get $params))
(then
;; rest binding
(local.set $new (call $env_define (local.get $new) (local.get $params) (local.get $args)))
(br $done)))
(br_if $done (i32.eq (local.get $params) (global.get $NIL)))
(br_if $done (i32.eq (local.get $args) (global.get $NIL)))
(local.set $new
(call $env_define (local.get $new)
(call $car (local.get $params))
(call $car (local.get $args))))
(local.set $params (call $cdr (local.get $params)))
(local.set $args (call $cdr (local.get $args)))
(br $loop)))
(local.get $new))
;; ─── Primitives ────────────────────────────────────────────────
(func $apply_primitive (param $id i32) (param $args i32) (result i32)
(local $a i32)
(local $b i32)
(local $sum i32)
(local $cur i32)
;; Fetch first 2 args (most prims use 1 or 2). Defaults to fixnum 0.
(local.set $a (call $make_fixnum (i32.const 0)))
(local.set $b (call $make_fixnum (i32.const 0)))
(if (i32.ne (local.get $args) (global.get $NIL))
(then
(local.set $a (call $car (local.get $args)))
(if (i32.ne (call $cdr (local.get $args)) (global.get $NIL))
(then (local.set $b (call $car (call $cdr (local.get $args))))))))
;; +
(if (i32.eq (local.get $id) (i32.const 1))
(then
(local.set $sum (i32.const 0))
(local.set $cur (local.get $args))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $sum (i32.add (local.get $sum)
(call $fixnum_val (call $car (local.get $cur)))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(return (call $make_fixnum (local.get $sum)))))
;; -
(if (i32.eq (local.get $id) (i32.const 2))
(then
(if (i32.eq (call $cdr (local.get $args)) (global.get $NIL))
(then (return (call $make_fixnum (i32.sub (i32.const 0) (call $fixnum_val (local.get $a)))))))
(local.set $sum (call $fixnum_val (local.get $a)))
(local.set $cur (call $cdr (local.get $args)))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $sum (i32.sub (local.get $sum)
(call $fixnum_val (call $car (local.get $cur)))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(return (call $make_fixnum (local.get $sum)))))
;; *
(if (i32.eq (local.get $id) (i32.const 3))
(then
(local.set $sum (i32.const 1))
(local.set $cur (local.get $args))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $sum (i32.mul (local.get $sum)
(call $fixnum_val (call $car (local.get $cur)))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(return (call $make_fixnum (local.get $sum)))))
;; /
(if (i32.eq (local.get $id) (i32.const 4))
(then
(return (call $make_fixnum (i32.div_s (call $fixnum_val (local.get $a))
(call $fixnum_val (local.get $b)))))))
;; =
(if (i32.eq (local.get $id) (i32.const 5))
(then
(if (i32.eq (call $fixnum_val (local.get $a)) (call $fixnum_val (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; <
(if (i32.eq (local.get $id) (i32.const 6))
(then
(if (i32.lt_s (call $fixnum_val (local.get $a)) (call $fixnum_val (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; >
(if (i32.eq (local.get $id) (i32.const 7))
(then
(if (i32.gt_s (call $fixnum_val (local.get $a)) (call $fixnum_val (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; <=
(if (i32.eq (local.get $id) (i32.const 8))
(then
(if (i32.le_s (call $fixnum_val (local.get $a)) (call $fixnum_val (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; >=
(if (i32.eq (local.get $id) (i32.const 9))
(then
(if (i32.ge_s (call $fixnum_val (local.get $a)) (call $fixnum_val (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; cons
(if (i32.eq (local.get $id) (i32.const 10))
(then (return (call $make_pair (local.get $a) (local.get $b)))))
;; car
(if (i32.eq (local.get $id) (i32.const 11))
(then (return (call $car (local.get $a)))))
;; cdr
(if (i32.eq (local.get $id) (i32.const 12))
(then (return (call $cdr (local.get $a)))))
;; null?
(if (i32.eq (local.get $id) (i32.const 13))
(then
(if (i32.eq (local.get $a) (global.get $NIL))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; pair?
(if (i32.eq (local.get $id) (i32.const 14))
(then
(if (call $is_pair (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; eq?
(if (i32.eq (local.get $id) (i32.const 15))
(then
(if (i32.eq (local.get $a) (local.get $b))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; not
(if (i32.eq (local.get $id) (i32.const 16))
(then
(if (i32.eq (local.get $a) (global.get $FALSE))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; display
(if (i32.eq (local.get $id) (i32.const 17))
(then (call $print_value (local.get $a)) (return (global.get $VOID))))
;; newline
(if (i32.eq (local.get $id) (i32.const 18))
(then (call $out_char (i32.const 10)) (return (global.get $VOID))))
;; print
(if (i32.eq (local.get $id) (i32.const 19))
(then
(call $print_value (local.get $a))
(call $out_char (i32.const 10))
(return (global.get $VOID))))
;; list
(if (i32.eq (local.get $id) (i32.const 20))
(then (return (local.get $args))))
;; length
(if (i32.eq (local.get $id) (i32.const 21))
(then
(local.set $sum (i32.const 0))
(local.set $cur (local.get $a))
(block $done
(loop $loop
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $sum (i32.add (local.get $sum) (i32.const 1)))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(return (call $make_fixnum (local.get $sum)))))
;; abs
(if (i32.eq (local.get $id) (i32.const 22))
(then
(local.set $sum (call $fixnum_val (local.get $a)))
(if (i32.lt_s (local.get $sum) (i32.const 0))
(then (local.set $sum (i32.sub (i32.const 0) (local.get $sum)))))
(return (call $make_fixnum (local.get $sum)))))
;; modulo
(if (i32.eq (local.get $id) (i32.const 23))
(then
(return (call $make_fixnum (i32.rem_s (call $fixnum_val (local.get $a))
(call $fixnum_val (local.get $b)))))))
;; zero?
(if (i32.eq (local.get $id) (i32.const 24))
(then
(if (i32.eqz (call $fixnum_val (local.get $a)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
(global.get $VOID))
;; ─── Init ──────────────────────────────────────────────────────
;; Set up immediates' bytes (for "()" "#t" "#f" "<procedure>" " . ").
;; We park them at 0xF000 onward.
(data (i32.const 0xF000) "()")
(data (i32.const 0xF010) "#t")
(data (i32.const 0xF020) "#f")
(data (i32.const 0xF030) "<procedure>")
(data (i32.const 0xF040) " . ")
;; Helper to intern from a fixed-string region. We embed literal symbols
;; in dataregions 0xE000+ and intern them at init.
;; Layout per slot: 16 bytes; we just record start+len ad hoc inline.
(data (i32.const 0xE000) "quote")
(data (i32.const 0xE010) "if")
(data (i32.const 0xE020) "lambda")
(data (i32.const 0xE030) "define")
(data (i32.const 0xE040) "begin")
(data (i32.const 0xE050) "cond")
(data (i32.const 0xE060) "else")
(data (i32.const 0xE070) "let")
(data (i32.const 0xE080) "and")
(data (i32.const 0xE090) "or")
(data (i32.const 0xE0A0) "set!")
;; Primitive name strings (interned + bound at init).
(data (i32.const 0xE100) "+")
(data (i32.const 0xE104) "-")
(data (i32.const 0xE108) "*")
(data (i32.const 0xE10C) "/")
(data (i32.const 0xE110) "=")
(data (i32.const 0xE114) "<")
(data (i32.const 0xE118) ">")
(data (i32.const 0xE11C) "<=")
(data (i32.const 0xE120) ">=")
(data (i32.const 0xE124) "cons")
(data (i32.const 0xE12C) "car")
(data (i32.const 0xE130) "cdr")
(data (i32.const 0xE134) "null?")
(data (i32.const 0xE13C) "pair?")
(data (i32.const 0xE144) "eq?")
(data (i32.const 0xE148) "not")
(data (i32.const 0xE14C) "display")
(data (i32.const 0xE154) "newline")
(data (i32.const 0xE15C) "print")
(data (i32.const 0xE164) "list")
(data (i32.const 0xE16C) "length")
(data (i32.const 0xE174) "abs")
(data (i32.const 0xE178) "modulo")
(data (i32.const 0xE180) "zero?")
(func $bind_prim (param $name_ptr i32) (param $name_len i32) (param $id i32)
(local $sym i32)
(local.set $sym (call $intern (local.get $name_ptr) (local.get $name_len)))
(global.set $global_env
(call $env_define (global.get $global_env)
(local.get $sym)
(call $make_primitive (local.get $id)))))
(func $lumbda_init (export "lumbda_init")
(if (global.get $initialized) (then (return)))
(global.set $initialized (i32.const 1))
;; Intern special-form symbols (these are matched by identity in eval).
(global.set $sym_quote (call $intern (i32.const 0xE000) (i32.const 5)))
(global.set $sym_if (call $intern (i32.const 0xE010) (i32.const 2)))
(global.set $sym_lambda (call $intern (i32.const 0xE020) (i32.const 6)))
(global.set $sym_define (call $intern (i32.const 0xE030) (i32.const 6)))
(global.set $sym_begin (call $intern (i32.const 0xE040) (i32.const 5)))
(global.set $sym_cond (call $intern (i32.const 0xE050) (i32.const 4)))
(global.set $sym_else (call $intern (i32.const 0xE060) (i32.const 4)))
(global.set $sym_let (call $intern (i32.const 0xE070) (i32.const 3)))
(global.set $sym_and (call $intern (i32.const 0xE080) (i32.const 3)))
(global.set $sym_or (call $intern (i32.const 0xE090) (i32.const 2)))
(global.set $sym_set (call $intern (i32.const 0xE0A0) (i32.const 4)))
(call $bind_prim (i32.const 0xE100) (i32.const 1) (i32.const 1)) ;; +
(call $bind_prim (i32.const 0xE104) (i32.const 1) (i32.const 2)) ;; -
(call $bind_prim (i32.const 0xE108) (i32.const 1) (i32.const 3)) ;; *
(call $bind_prim (i32.const 0xE10C) (i32.const 1) (i32.const 4)) ;; /
(call $bind_prim (i32.const 0xE110) (i32.const 1) (i32.const 5)) ;; =
(call $bind_prim (i32.const 0xE114) (i32.const 1) (i32.const 6)) ;; <
(call $bind_prim (i32.const 0xE118) (i32.const 1) (i32.const 7)) ;; >
(call $bind_prim (i32.const 0xE11C) (i32.const 2) (i32.const 8)) ;; <=
(call $bind_prim (i32.const 0xE120) (i32.const 2) (i32.const 9)) ;; >=
(call $bind_prim (i32.const 0xE124) (i32.const 4) (i32.const 10)) ;; cons
(call $bind_prim (i32.const 0xE12C) (i32.const 3) (i32.const 11)) ;; car
(call $bind_prim (i32.const 0xE130) (i32.const 3) (i32.const 12)) ;; cdr
(call $bind_prim (i32.const 0xE134) (i32.const 5) (i32.const 13)) ;; null?
(call $bind_prim (i32.const 0xE13C) (i32.const 5) (i32.const 14)) ;; pair?
(call $bind_prim (i32.const 0xE144) (i32.const 3) (i32.const 15)) ;; eq?
(call $bind_prim (i32.const 0xE148) (i32.const 3) (i32.const 16)) ;; not
(call $bind_prim (i32.const 0xE14C) (i32.const 7) (i32.const 17)) ;; display
(call $bind_prim (i32.const 0xE154) (i32.const 7) (i32.const 18)) ;; newline
(call $bind_prim (i32.const 0xE15C) (i32.const 5) (i32.const 19)) ;; print
(call $bind_prim (i32.const 0xE164) (i32.const 4) (i32.const 20)) ;; list
(call $bind_prim (i32.const 0xE16C) (i32.const 6) (i32.const 21)) ;; length
(call $bind_prim (i32.const 0xE174) (i32.const 3) (i32.const 22)) ;; abs
(call $bind_prim (i32.const 0xE178) (i32.const 6) (i32.const 23)) ;; modulo
(call $bind_prim (i32.const 0xE180) (i32.const 5) (i32.const 24))) ;; zero?
;; ─── Public eval entry ─────────────────────────────────────────
;; JS writes UTF-8 source into 0x20000 and calls lumbda_eval(len).
;; Returns: nothing. Output is at 0x10000, length in $output_len.
(func $lumbda_eval (export "lumbda_eval") (param $src_len i32)
(local $val i32)
(call $lumbda_init)
(global.set $output_len (i32.const 0))
(global.set $source_ptr (i32.const 0x20000))
(global.set $source_end (i32.add (i32.const 0x20000) (local.get $src_len)))
(local.set $val (global.get $VOID))
(block $done
(loop $loop
(call $skip_ws)
(br_if $done (i32.ge_u (global.get $source_ptr) (global.get $source_end)))
;; Top-level env = NIL. env_lookup walks env to NIL then falls back
;; to the CURRENT global_env. Closures defined at top-level capture
;; NIL too, so when re-running a demo the new top-level defines are
;; visible without older snapshots shadowing them. Without this,
;; running mandelbrot twice on a cached instance corrupts every
;; other cell because escape-count's captured global_env points
;; into a chain that no longer reflects current bindings.
(local.set $val (call $eval (call $read) (global.get $NIL)))
(br $loop)))
(if (i32.ne (local.get $val) (global.get $VOID))
(then
(if (i32.gt_u (global.get $output_len) (i32.const 0))
(then
(if (i32.ne
(i32.load8_u
(i32.sub (i32.add (i32.const 0x10000) (global.get $output_len))
(i32.const 1)))
(i32.const 10))
(then (call $out_char (i32.const 10))))))
(call $print_value (local.get $val)))))
(func $lumbda_output_ptr (export "lumbda_output_ptr") (result i32)
(i32.const 0x10000))
(func $lumbda_output_len (export "lumbda_output_len") (result i32)
(global.get $output_len))
(func $lumbda_source_ptr (export "lumbda_source_ptr") (result i32)
(i32.const 0x20000))
)
Reference in a new issue View git blame Copy permalink