engineering/lumbda
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
lumbda/wasm/asm/lumbda.wat
russell@unturf.com 7e32eefd6b
playground+repl: bend dispatch from WASM + 1.33 zoom + free-form runner 
bend!-call from the WAT tier
  - New WAT import: (import "env" "bend_call"). The host loader supplies
    a sync XMLHttpRequest that POSTs the payload to a configured URL
    (workers only — sync XHR isn't allowed on main thread).
  - New primitive (bend!-call "<payload>") returns the response as a
    lumbda string. Works in playground and REPL once the bend URL is
    saved in the new top bar.
  - bendUrl persists in plain localStorage (not encrypted — it's a
    server address, not a secret).
  - Tests stub the import with a no-op so unit / integration / functional
    suites keep instantiating cleanly.

Playground + REPL zoom 133% by default
  - html { zoom: 1.33 } so the styleguide sizes read comfortably without
    requiring browser-level zoom.

Free-form default = cross-tier assertion runner in Lisp
  - The default editor content for "free form" is now a small assertion
    framework matching tests/functional.lsp's PASS/FAIL convention. A
    starter the user can extend, runs identically on the three tiers.

C tier + Python tier (bend) are wired through the runner stub; full
bend integration in those tiers comes next once their loaders learn
about setBendUrl.
2026-06-14 13:05:06 -04:00

3099 lines
134 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
;; ─── Imports from host JS ──────────────────────────────────────
;; bend_call(src_ptr, src_len, resp_ptr) -> resp_len.
;; JS does a synchronous XHR to the configured gpu-worker URL,
;; writes the response bytes at resp_ptr, returns the byte length.
;; Worker context only — sync XHR isn't allowed on the main thread.
(import "env" "bend_call"
(func $js_bend_call (param i32 i32 i32) (result i32)))
;; ─── 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))
(global $sym_letstar (mut i32) (i32.const 0))
(global $sym_letrec (mut i32) (i32.const 0))
(global $sym_when (mut i32) (i32.const 0))
(global $sym_unless (mut i32) (i32.const 0))
(global $sym_case (mut i32) (i32.const 0))
(global $sym_do (mut i32) (i32.const 0))
;; Prelude — Lisp source evaluated after primitive binding to define
;; higher-order functions on top of the C-level primitives.
(global $prelude_ptr i32 (i32.const 0x50000))
(global $prelude_len (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)))))))
(func $is_char (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 6)))))))
(func $make_char (param $code i32) (result i32)
(local $p i32)
(local.set $p (call $alloc (i32.const 8)))
(i32.store (local.get $p) (i32.const 6))
(i32.store offset=4 (local.get $p) (local.get $code))
(local.get $p))
;; ─── Vectors (tag=7) ───────────────────────────────────────────
;; Layout: [tag=7, len, elem_0, elem_1, ...] — 8 + 4*len bytes.
(func $is_vector (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 7)))))))
(func $make_vector_raw (param $len i32) (result i32)
(local $p i32)
(local.set $p (call $alloc (i32.add (i32.const 8) (i32.mul (local.get $len) (i32.const 4)))))
(i32.store (local.get $p) (i32.const 7))
(i32.store offset=4 (local.get $p) (local.get $len))
(local.get $p))
(func $vector_len (param $v i32) (result i32)
(i32.load offset=4 (local.get $v)))
(func $vector_get (param $v i32) (param $i i32) (result i32)
(i32.load (i32.add (i32.add (local.get $v) (i32.const 8)) (i32.mul (local.get $i) (i32.const 4)))))
(func $vector_put (param $v i32) (param $i i32) (param $val i32)
(i32.store (i32.add (i32.add (local.get $v) (i32.const 8)) (i32.mul (local.get $i) (i32.const 4))) (local.get $val)))
;; ─── Hash tables (tag=8) ───────────────────────────────────────
;; Layout: [tag=8, count, alist_ptr]. alist is a list of (key . val) pairs.
;; Lookup is linear — fine for browser demos; would be MOAD-0001 at scale,
;; same caveat as my linear symbol intern.
(func $is_hashtable (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 8)))))))
(func $make_hashtable (result i32)
(local $p i32)
(local.set $p (call $alloc (i32.const 12)))
(i32.store (local.get $p) (i32.const 8))
(i32.store offset=4 (local.get $p) (i32.const 0))
(i32.store offset=8 (local.get $p) (global.get $NIL))
(local.get $p))
(func $ht_count (param $h i32) (result i32)
(i32.load offset=4 (local.get $h)))
(func $ht_alist (param $h i32) (result i32)
(i32.load offset=8 (local.get $h)))
(func $ht_set_alist (param $h i32) (param $a i32)
(i32.store offset=8 (local.get $h) (local.get $a)))
(func $ht_set_count (param $h i32) (param $n i32)
(i32.store offset=4 (local.get $h) (local.get $n)))
;; Find binding for key in hashtable, returns the (k.v) pair or FALSE.
(func $ht_find (param $h i32) (param $key i32) (result i32)
(local $cur i32)
(local $pair i32)
(local.set $cur (call $ht_alist (local.get $h)))
(block $done
(loop $l
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $pair (call $car (local.get $cur)))
(if (i32.eq (call $equal_p (call $car (local.get $pair)) (local.get $key)) (global.get $TRUE))
(then (return (local.get $pair))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l)))
(global.get $FALSE))
(func $ht_set (param $h i32) (param $key i32) (param $val i32)
(local $found i32)
(local.set $found (call $ht_find (local.get $h) (local.get $key)))
(if (i32.eq (local.get $found) (global.get $FALSE))
(then
(call $ht_set_alist (local.get $h)
(call $make_pair
(call $make_pair (local.get $key) (local.get $val))
(call $ht_alist (local.get $h))))
(call $ht_set_count (local.get $h)
(i32.add (call $ht_count (local.get $h)) (i32.const 1))))
(else
(call $set_cdr (local.get $found) (local.get $val)))))
;; Remove binding for key, returns 1 if removed, 0 if not present.
(func $ht_delete (param $h i32) (param $key i32) (result i32)
(local $cur i32)
(local $prev i32)
(local $pair i32)
(local.set $cur (call $ht_alist (local.get $h)))
(local.set $prev (global.get $NIL))
(block $done
(loop $l
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $pair (call $car (local.get $cur)))
(if (i32.eq (call $equal_p (call $car (local.get $pair)) (local.get $key)) (global.get $TRUE))
(then
(if (i32.eq (local.get $prev) (global.get $NIL))
(then (call $ht_set_alist (local.get $h) (call $cdr (local.get $cur))))
(else (call $set_cdr (local.get $prev) (call $cdr (local.get $cur)))))
(call $ht_set_count (local.get $h)
(i32.sub (call $ht_count (local.get $h)) (i32.const 1)))
(return (i32.const 1))))
(local.set $prev (local.get $cur))
(local.set $cur (call $cdr (local.get $cur)))
(br $l)))
(i32.const 0))
(func $char_code (param $v i32) (result i32)
(i32.load offset=4 (local.get $v)))
;; Allocate an empty string object of the given length, return pointer.
;; Bytes are uninitialized; caller must fill before use.
(func $make_string_raw (param $len i32) (result i32)
(local $p i32)
(local.set $p (call $alloc (i32.add (i32.const 8) (local.get $len))))
(i32.store (local.get $p) (i32.const 5))
(i32.store offset=4 (local.get $p) (local.get $len))
(local.get $p))
(func $string_len (param $s i32) (result i32)
(i32.load offset=4 (local.get $s)))
(func $string_byte (param $s i32) (param $i i32) (result i32)
(i32.load8_u (i32.add (i32.add (local.get $s) (i32.const 8)) (local.get $i))))
(func $string_set_byte (param $s i32) (param $i i32) (param $c i32)
(i32.store8 (i32.add (i32.add (local.get $s) (i32.const 8)) (local.get $i)) (local.get $c)))
;; ─── 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_char (local.get $v))
(then
(call $out_char (call $char_code (local.get $v)))
(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)))
(if (call $is_vector (local.get $v))
(then
(call $out_str (i32.const 0xF050) (i32.const 2)) ;; "#("
(call $print_vector_items (local.get $v))
(call $out_char (i32.const 41)) ;; )
(return)))
(if (call $is_hashtable (local.get $v))
(then
(call $out_str (i32.const 0xF060) (i32.const 12)) ;; "#<hashtable>"
(return)))
;; closure / primitive
(call $out_str (i32.const 0xF030) (i32.const 11))) ;; "<procedure>"
;; write_value — like print_value but quotes strings and #\-prefixes chars.
(func $write_value (param $v i32)
(local $bytes i32)
(local $len i32)
(if (call $is_string (local.get $v))
(then
(call $out_char (i32.const 34)) ;; "
(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))
(call $out_char (i32.const 34)) ;; "
(return)))
(if (call $is_char (local.get $v))
(then
(call $out_str (i32.const 0xF080) (i32.const 2)) ;; "#\\"
(call $out_char (call $char_code (local.get $v)))
(return)))
(if (call $is_pair (local.get $v))
(then
(call $out_char (i32.const 40))
(call $write_pair_items (local.get $v))
(call $out_char (i32.const 41))
(return)))
(call $print_value (local.get $v)))
(func $write_pair_items (param $p i32)
(block $done
(loop $loop
(br_if $done (i32.eqz (call $is_pair (local.get $p))))
(call $write_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))))
(br $loop)))
(if (i32.ne (local.get $p) (global.get $NIL))
(then
(call $out_str (i32.const 0xF040) (i32.const 3))
(call $write_value (local.get $p)))))
(func $print_vector_items (param $v i32)
(local $len i32)
(local $i i32)
(local.set $len (call $vector_len (local.get $v)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(call $print_value (call $vector_get (local.get $v) (local.get $i)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(if (i32.lt_u (local.get $i) (local.get $len))
(then (call $out_char (i32.const 32))))
(br $l))))
(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 #\char
(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)))
;; #\char — backslash then a char or named character (space, newline, tab)
(if (i32.eq (local.get $c) (i32.const 92)) ;; \
(then
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(return (call $read_char_literal))))
(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 char literal: #\X already consumed up through \. The next byte
;; may be a single char ("a"), or the start of a named char (space, newline, tab).
;; Named chars are detected by seeing a letter followed by more letters.
(func $read_char_literal (result i32)
(local $first i32)
(local $start i32)
(local $len i32)
(if (i32.ge_u (global.get $source_ptr) (global.get $source_end))
(then (return (call $make_char (i32.const 32)))))
(local.set $first (i32.load8_u (global.get $source_ptr)))
(local.set $start (global.get $source_ptr))
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
;; If first is a letter, scan further letters to detect named char.
(if (i32.and
(i32.ge_u (local.get $first) (i32.const 97)) ;; a
(i32.le_u (local.get $first) (i32.const 122))) ;; z
(then
(block $done
(loop $l
(br_if $done (i32.ge_u (global.get $source_ptr) (global.get $source_end)))
(br_if $done (i32.eqz (i32.and
(i32.ge_u (i32.load8_u (global.get $source_ptr)) (i32.const 97))
(i32.le_u (i32.load8_u (global.get $source_ptr)) (i32.const 122)))))
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(br $l)))
(local.set $len (i32.sub (global.get $source_ptr) (local.get $start)))
(if (i32.eq (local.get $len) (i32.const 1))
(then (return (call $make_char (local.get $first)))))
;; Named chars: space, newline, tab, return, null
(if (call $bytes_eq_s (local.get $start) (local.get $len) (i32.const 0xE2D0) (i32.const 5))
(then (return (call $make_char (i32.const 32))))) ;; space
(if (call $bytes_eq_s (local.get $start) (local.get $len) (i32.const 0xE2D8) (i32.const 7))
(then (return (call $make_char (i32.const 10))))) ;; newline
(if (call $bytes_eq_s (local.get $start) (local.get $len) (i32.const 0xE2E0) (i32.const 3))
(then (return (call $make_char (i32.const 9))))) ;; tab
(if (call $bytes_eq_s (local.get $start) (local.get $len) (i32.const 0xE2E4) (i32.const 6))
(then (return (call $make_char (i32.const 13))))) ;; return
(if (call $bytes_eq_s (local.get $start) (local.get $len) (i32.const 0xE2EC) (i32.const 4))
(then (return (call $make_char (i32.const 0))))) ;; null
;; Unknown name — return first letter
(return (call $make_char (local.get $first)))))
;; Single character (non-letter)
(call $make_char (local.get $first)))
;; Compare two byte regions for equality. Returns 1 if equal.
(func $bytes_eq_s (param $a i32) (param $alen i32) (param $b i32) (param $blen i32) (result i32)
(local $i i32)
(if (i32.ne (local.get $alen) (local.get $blen))
(then (return (i32.const 0))))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $alen)))
(if (i32.ne
(i32.load8_u (i32.add (local.get $a) (local.get $i)))
(i32.load8_u (i32.add (local.get $b) (local.get $i))))
(then (return (i32.const 0))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(i32.const 1))
;; 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, char, 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_char (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)))))
(if (i32.eq (local.get $head) (global.get $sym_letstar))
(then (return (call $eval_letstar (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_letrec))
(then (return (call $eval_letrec (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_when))
(then (return (call $eval_when (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_unless))
(then (return (call $eval_unless (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_case))
(then (return (call $eval_case (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 (also supports named let)
;; Named let: (let name ((x e) ...) body) -> a self-referential procedure.
(func $eval_let (param $rest i32) (param $env i32) (result i32)
(local $first i32)
(local $bindings i32)
(local $body i32)
(local $new_env i32)
(local $b i32)
(local $sym i32)
(local $val i32)
(local $name i32)
(local $params i32)
(local $args i32)
(local $closure i32)
(local.set $first (call $car (local.get $rest)))
;; Named let if first arg is a symbol.
(if (call $is_symbol (local.get $first))
(then
(local.set $name (local.get $first))
(local.set $bindings (call $car (call $cdr (local.get $rest))))
(local.set $body (call $cdr (call $cdr (local.get $rest))))
;; Build params list (the binding names) and args list (their inits).
(local.set $params (call $extract_let_params (local.get $bindings)))
(local.set $args (call $extract_let_inits (local.get $bindings) (local.get $env)))
;; Create closure capturing CURRENT env (so the body can refer to name).
(local.set $closure (call $make_closure (local.get $params) (local.get $body) (local.get $env)))
;; Bind the closure to name in a fresh local env and patch its env to include itself.
(local.set $new_env (call $env_define (local.get $env) (local.get $name) (local.get $closure)))
;; Patch closure.env to the new env so name resolves to it.
(i32.store offset=12 (local.get $closure) (local.get $new_env))
(return (call $apply (local.get $closure) (local.get $args)))))
(local.set $bindings (local.get $first))
(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)))
;; Helper: build params list from let bindings (a list of (sym init)).
(func $extract_let_params (param $bindings 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 $l
(br_if $done (i32.eq (local.get $bindings) (global.get $NIL)))
(local.set $new
(call $make_pair
(call $car (call $car (local.get $bindings)))
(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 $bindings (call $cdr (local.get $bindings)))
(br $l)))
(local.get $head))
;; Helper: evaluate each init expression and return the resulting list.
(func $extract_let_inits (param $bindings 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 $l
(br_if $done (i32.eq (local.get $bindings) (global.get $NIL)))
(local.set $new
(call $make_pair
(call $eval (call $car (call $cdr (call $car (local.get $bindings)))) (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 $bindings (call $cdr (local.get $bindings)))
(br $l)))
(local.get $head))
;; (let* ((x e1) (y e2)) body) — each binding sees previous bindings.
(func $eval_letstar (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 $new_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)))
;; (letrec ((f (lambda ...))) body) — each binding visible to all others.
;; First create the env with placeholder bindings, then evaluate inits in
;; the new env (so lambdas capture it), then patch values.
(func $eval_letrec (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 $cur i32)
(local $bind i32)
(local.set $bindings (call $car (local.get $rest)))
(local.set $body (call $cdr (local.get $rest)))
(local.set $new_env (local.get $env))
(local.set $cur (local.get $bindings))
;; Pass 1: bind every name to VOID in the new env.
(block $done1
(loop $l1
(br_if $done1 (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $b (call $car (local.get $cur)))
(local.set $sym (call $car (local.get $b)))
(local.set $new_env (call $env_define (local.get $new_env) (local.get $sym) (global.get $VOID)))
(local.set $cur (call $cdr (local.get $cur)))
(br $l1)))
;; Pass 2: evaluate each init in new_env (so lambdas see each other),
;; mutate the binding pair's cdr to the real value.
(local.set $cur (local.get $bindings))
(block $done2
(loop $l2
(br_if $done2 (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $b (call $car (local.get $cur)))
(local.set $sym (call $car (local.get $b)))
(local.set $val (call $eval (call $car (call $cdr (local.get $b))) (local.get $new_env)))
(call $env_set (local.get $new_env) (local.get $sym) (local.get $val))
(local.set $cur (call $cdr (local.get $cur)))
(br $l2)))
(call $eval_begin (local.get $body) (local.get $new_env)))
;; (when test body...) -> if test true, eval body, else void
(func $eval_when (param $rest i32) (param $env i32) (result i32)
(if (i32.ne (call $eval (call $car (local.get $rest)) (local.get $env)) (global.get $FALSE))
(then (return (call $eval_begin (call $cdr (local.get $rest)) (local.get $env)))))
(global.get $VOID))
;; (unless test body...) -> if test false, eval body, else void
(func $eval_unless (param $rest i32) (param $env i32) (result i32)
(if (i32.eq (call $eval (call $car (local.get $rest)) (local.get $env)) (global.get $FALSE))
(then (return (call $eval_begin (call $cdr (local.get $rest)) (local.get $env)))))
(global.get $VOID))
;; (case key ((1 2) "small") ((3 4) "med") (else "big"))
;; Each clause: (datum-list body) where datum-list is either a list of
;; literals to match via eqv?, or the symbol `else`.
(func $eval_case (param $rest i32) (param $env i32) (result i32)
(local $key i32)
(local $clauses i32)
(local $clause i32)
(local $data i32)
(local $body i32)
(local.set $key (call $eval (call $car (local.get $rest)) (local.get $env)))
(local.set $clauses (call $cdr (local.get $rest)))
(block $done
(loop $l
(br_if $done (i32.eq (local.get $clauses) (global.get $NIL)))
(local.set $clause (call $car (local.get $clauses)))
(local.set $data (call $car (local.get $clause)))
(local.set $body (call $cdr (local.get $clause)))
(if (i32.eq (local.get $data) (global.get $sym_else))
(then (return (call $eval_begin (local.get $body) (local.get $env)))))
;; data is a list of literal values; match via eqv?
(block $clausedone
(loop $datal
(br_if $clausedone (i32.eq (local.get $data) (global.get $NIL)))
(if (i32.eq (call $car (local.get $data)) (local.get $key))
(then (return (call $eval_begin (local.get $body) (local.get $env)))))
(local.set $data (call $cdr (local.get $data)))
(br $datal)))
(local.set $clauses (call $cdr (local.get $clauses)))
(br $l)))
(global.get $VOID))
(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))
;; ─── Equality helpers ──────────────────────────────────────────
;; Deep structural equality. Returns TRUE/FALSE immediate.
(func $equal_p (param $a i32) (param $b i32) (result i32)
(local $alen i32)
(local $blen i32)
(local $i i32)
(if (i32.eq (local.get $a) (local.get $b))
(then (return (global.get $TRUE))))
(if (call $is_pair (local.get $a))
(then
(if (i32.eqz (call $is_pair (local.get $b)))
(then (return (global.get $FALSE))))
(if (i32.eq (call $equal_p (call $car (local.get $a)) (call $car (local.get $b))) (global.get $FALSE))
(then (return (global.get $FALSE))))
(return (call $equal_p (call $cdr (local.get $a)) (call $cdr (local.get $b))))))
(if (call $is_string (local.get $a))
(then
(if (i32.eqz (call $is_string (local.get $b)))
(then (return (global.get $FALSE))))
(local.set $alen (i32.load offset=4 (local.get $a)))
(local.set $blen (i32.load offset=4 (local.get $b)))
(if (i32.ne (local.get $alen) (local.get $blen))
(then (return (global.get $FALSE))))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $alen)))
(if (i32.ne
(i32.load8_u (i32.add (i32.add (local.get $a) (i32.const 8)) (local.get $i)))
(i32.load8_u (i32.add (i32.add (local.get $b) (i32.const 8)) (local.get $i))))
(then (return (global.get $FALSE))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(return (global.get $TRUE))))
(if (call $is_char (local.get $a))
(then
(if (i32.eqz (call $is_char (local.get $b)))
(then (return (global.get $FALSE))))
(if (i32.eq (call $char_code (local.get $a)) (call $char_code (local.get $b)))
(then (return (global.get $TRUE))))
(return (global.get $FALSE))))
;; Fall through: not equal (different types / not pair)
(global.get $FALSE))
;; (append a b) returns a new list with b appended after a.
(func $append2 (param $a i32) (param $b i32) (result i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local $cur i32)
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(local.set $cur (local.get $a))
(block $done
(loop $l
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $new (call $make_pair (call $car (local.get $cur)) (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 $cur (call $cdr (local.get $cur)))
(br $l)))
(if (i32.eq (local.get $head) (global.get $NIL))
(then (return (local.get $b))))
(call $set_cdr (local.get $tail) (local.get $b))
(local.get $head))
;; (member key list) — use_equal=1 → equal?; else eq?
(func $member_eq (param $key i32) (param $list i32) (param $use_equal i32) (result i32)
(local $cur i32)
(local $match i32)
(local.set $cur (local.get $list))
(block $done
(loop $l
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(if (local.get $use_equal)
(then
(local.set $match
(i32.eq (call $equal_p (local.get $key) (call $car (local.get $cur))) (global.get $TRUE))))
(else
(local.set $match
(i32.eq (local.get $key) (call $car (local.get $cur))))))
(if (local.get $match)
(then (return (local.get $cur))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l)))
(global.get $FALSE))
;; (assoc key alist) — use_equal=1 → equal? on car; else eq?
(func $assoc_eq (param $key i32) (param $alist i32) (param $use_equal i32) (result i32)
(local $cur i32)
(local $pair i32)
(local $match i32)
(local.set $cur (local.get $alist))
(block $done
(loop $l
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $pair (call $car (local.get $cur)))
(if (call $is_pair (local.get $pair))
(then
(if (local.get $use_equal)
(then
(local.set $match
(i32.eq (call $equal_p (local.get $key) (call $car (local.get $pair))) (global.get $TRUE))))
(else
(local.set $match
(i32.eq (local.get $key) (call $car (local.get $pair))))))
(if (local.get $match)
(then (return (local.get $pair))))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l)))
(global.get $FALSE))
;; ─── String / char helpers ─────────────────────────────────────
(func $substring_op (param $s i32) (param $start i32) (param $end i32) (result i32)
(local $out i32)
(local $len i32)
(local $i i32)
(local.set $len (i32.sub (local.get $end) (local.get $start)))
(local.set $out (call $make_string_raw (local.get $len)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(call $string_set_byte (local.get $out) (local.get $i)
(call $string_byte (local.get $s) (i32.add (local.get $start) (local.get $i))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $out))
;; Append all string args together. Args = list of strings.
(func $string_append_op (param $args i32) (result i32)
(local $total i32)
(local $cur i32)
(local $s i32)
(local $slen i32)
(local $out i32)
(local $i i32)
(local $pos i32)
;; Pass 1: total length
(local.set $total (i32.const 0))
(local.set $cur (local.get $args))
(block $d1
(loop $l1
(br_if $d1 (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $s (call $car (local.get $cur)))
(if (call $is_string (local.get $s))
(then (local.set $total (i32.add (local.get $total) (call $string_len (local.get $s))))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l1)))
(local.set $out (call $make_string_raw (local.get $total)))
;; Pass 2: copy bytes
(local.set $pos (i32.const 0))
(local.set $cur (local.get $args))
(block $d2
(loop $l2
(br_if $d2 (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $s (call $car (local.get $cur)))
(if (call $is_string (local.get $s))
(then
(local.set $slen (call $string_len (local.get $s)))
(local.set $i (i32.const 0))
(block $d3
(loop $l3
(br_if $d3 (i32.ge_u (local.get $i) (local.get $slen)))
(call $string_set_byte (local.get $out) (i32.add (local.get $pos) (local.get $i))
(call $string_byte (local.get $s) (local.get $i)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l3)))
(local.set $pos (i32.add (local.get $pos) (local.get $slen)))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l2)))
(local.get $out))
(func $string_lt (param $a i32) (param $b i32) (result i32)
(local $alen i32)
(local $blen i32)
(local $i i32)
(local $minlen i32)
(local $ca i32)
(local $cb i32)
(local.set $alen (call $string_len (local.get $a)))
(local.set $blen (call $string_len (local.get $b)))
(local.set $minlen (local.get $alen))
(if (i32.lt_u (local.get $blen) (local.get $minlen))
(then (local.set $minlen (local.get $blen))))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $minlen)))
(local.set $ca (call $string_byte (local.get $a) (local.get $i)))
(local.set $cb (call $string_byte (local.get $b) (local.get $i)))
(if (i32.lt_u (local.get $ca) (local.get $cb))
(then (return (global.get $TRUE))))
(if (i32.gt_u (local.get $ca) (local.get $cb))
(then (return (global.get $FALSE))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(if (i32.lt_u (local.get $alen) (local.get $blen))
(then (return (global.get $TRUE))))
(global.get $FALSE))
;; upper=1 → upcase, upper=0 → downcase
(func $string_case_op (param $s i32) (param $upper i32) (result i32)
(local $len i32)
(local $out i32)
(local $i i32)
(local $c i32)
(local.set $len (call $string_len (local.get $s)))
(local.set $out (call $make_string_raw (local.get $len)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(local.set $c (call $string_byte (local.get $s) (local.get $i)))
(if (local.get $upper)
(then
(if (i32.and (i32.ge_u (local.get $c) (i32.const 97)) (i32.le_u (local.get $c) (i32.const 122)))
(then (local.set $c (i32.sub (local.get $c) (i32.const 32))))))
(else
(if (i32.and (i32.ge_u (local.get $c) (i32.const 65)) (i32.le_u (local.get $c) (i32.const 90)))
(then (local.set $c (i32.add (local.get $c) (i32.const 32)))))))
(call $string_set_byte (local.get $out) (local.get $i) (local.get $c))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $out))
(func $string_to_list (param $s i32) (result i32)
(local $len i32)
(local $i i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local.set $len (call $string_len (local.get $s)))
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(local.set $new
(call $make_pair
(call $make_char (call $string_byte (local.get $s) (local.get $i)))
(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 $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $head))
(func $list_to_string (param $list i32) (result i32)
(local $len i32)
(local $cur i32)
(local $out i32)
(local $i i32)
(local $ch i32)
;; count length
(local.set $len (i32.const 0))
(local.set $cur (local.get $list))
(block $d1
(loop $l1
(br_if $d1 (i32.eqz (call $is_pair (local.get $cur))))
(local.set $len (i32.add (local.get $len) (i32.const 1)))
(local.set $cur (call $cdr (local.get $cur)))
(br $l1)))
(local.set $out (call $make_string_raw (local.get $len)))
(local.set $cur (local.get $list))
(local.set $i (i32.const 0))
(block $d2
(loop $l2
(br_if $d2 (i32.eqz (call $is_pair (local.get $cur))))
(local.set $ch (call $car (local.get $cur)))
(if (call $is_char (local.get $ch))
(then (call $string_set_byte (local.get $out) (local.get $i) (call $char_code (local.get $ch))))
(else (call $string_set_byte (local.get $out) (local.get $i) (call $fixnum_val (local.get $ch)))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(local.set $cur (call $cdr (local.get $cur)))
(br $l2)))
(local.get $out))
(func $symbol_to_string (param $sym i32) (result i32)
(local $len i32)
(local $out i32)
(local $i i32)
(local.set $len (i32.load offset=4 (local.get $sym)))
(local.set $out (call $make_string_raw (local.get $len)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(call $string_set_byte (local.get $out) (local.get $i)
(i32.load8_u (i32.add (i32.add (local.get $sym) (i32.const 8)) (local.get $i))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $out))
(func $make_string_filled (param $n i32) (param $code i32) (result i32)
(local $out i32)
(local $i i32)
(local.set $out (call $make_string_raw (local.get $n)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $n)))
(call $string_set_byte (local.get $out) (local.get $i) (local.get $code))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $out))
;; Convert a signed i32 to a freshly-allocated string.
(func $number_to_string (param $n i32) (result i32)
(local $buf i32)
(local $neg i32)
(local $i i32)
(local $out i32)
(local $j i32)
(local.set $buf (i32.const 0x200)) ;; 32-byte scratch
(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) (local.get $i)) (i32.const 48))
(local.set $i (i32.const 1)))
(else
(block $done
(loop $l
(br_if $done (i32.eqz (local.get $n)))
(i32.store8 (i32.add (local.get $buf) (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 $l)))))
(local.set $out (call $make_string_raw
(i32.add (local.get $i)
(if (result i32) (local.get $neg) (then (i32.const 1)) (else (i32.const 0))))))
(local.set $j (i32.const 0))
(if (local.get $neg)
(then
(call $string_set_byte (local.get $out) (i32.const 0) (i32.const 45))
(local.set $j (i32.const 1))))
(block $done2
(loop $l2
(br_if $done2 (i32.eqz (local.get $i)))
(local.set $i (i32.sub (local.get $i) (i32.const 1)))
(call $string_set_byte (local.get $out) (local.get $j)
(i32.load8_u (i32.add (local.get $buf) (local.get $i))))
(local.set $j (i32.add (local.get $j) (i32.const 1)))
(br $l2)))
(local.get $out))
;; Parse a string as integer. Returns FALSE on parse failure.
(func $string_to_number (param $s i32) (result i32)
(local $len i32)
(local $i i32)
(local $start i32)
(local $neg i32)
(local $n i32)
(local $c i32)
(local.set $len (call $string_len (local.get $s)))
(if (i32.eqz (local.get $len)) (then (return (global.get $FALSE))))
(local.set $start (i32.const 0))
(local.set $neg (i32.const 0))
(local.set $c (call $string_byte (local.get $s) (i32.const 0)))
(if (i32.eq (local.get $c) (i32.const 45))
(then
(local.set $neg (i32.const 1))
(local.set $start (i32.const 1))))
(if (i32.eq (local.get $c) (i32.const 43))
(then (local.set $start (i32.const 1))))
(if (i32.ge_u (local.get $start) (local.get $len)) (then (return (global.get $FALSE))))
(local.set $n (i32.const 0))
(local.set $i (local.get $start))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(local.set $c (call $string_byte (local.get $s) (local.get $i)))
(if (i32.eqz (call $is_digit (local.get $c)))
(then (return (global.get $FALSE))))
(local.set $n (i32.add (i32.mul (local.get $n) (i32.const 10))
(i32.sub (local.get $c) (i32.const 48))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(if (local.get $neg)
(then (local.set $n (i32.sub (i32.const 0) (local.get $n)))))
(call $make_fixnum (local.get $n)))
;; Returns TRUE if needle is a substring of haystack, else FALSE.
(func $string_contains_p (param $hay i32) (param $needle i32) (result i32)
(local $hlen i32)
(local $nlen i32)
(local $i i32)
(local $j i32)
(local $matched i32)
(local.set $hlen (call $string_len (local.get $hay)))
(local.set $nlen (call $string_len (local.get $needle)))
(if (i32.eqz (local.get $nlen)) (then (return (global.get $TRUE))))
(if (i32.gt_u (local.get $nlen) (local.get $hlen)) (then (return (global.get $FALSE))))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.gt_u (i32.add (local.get $i) (local.get $nlen)) (local.get $hlen)))
(local.set $j (i32.const 0))
(local.set $matched (i32.const 1))
(block $inner
(loop $il
(br_if $inner (i32.ge_u (local.get $j) (local.get $nlen)))
(if (i32.ne
(call $string_byte (local.get $hay) (i32.add (local.get $i) (local.get $j)))
(call $string_byte (local.get $needle) (local.get $j)))
(then (local.set $matched (i32.const 0)) (br $inner)))
(local.set $j (i32.add (local.get $j) (i32.const 1)))
(br $il)))
(if (local.get $matched) (then (return (global.get $TRUE))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(global.get $FALSE))
;; (string-join '("a" "b" "c") "-") → "a-b-c"
(func $string_join_op (param $list i32) (param $sep i32) (result i32)
(local $cur i32)
(local $total i32)
(local $s i32)
(local $slen i32)
(local $seplen i32)
(local $out i32)
(local $pos i32)
(local $i i32)
(local $first i32)
(local.set $seplen (call $string_len (local.get $sep)))
(local.set $total (i32.const 0))
(local.set $cur (local.get $list))
(local.set $first (i32.const 1))
(block $d1
(loop $l1
(br_if $d1 (i32.eqz (call $is_pair (local.get $cur))))
(local.set $s (call $car (local.get $cur)))
(if (call $is_string (local.get $s))
(then
(if (i32.eqz (local.get $first))
(then (local.set $total (i32.add (local.get $total) (local.get $seplen)))))
(local.set $total (i32.add (local.get $total) (call $string_len (local.get $s))))
(local.set $first (i32.const 0))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l1)))
(local.set $out (call $make_string_raw (local.get $total)))
(local.set $pos (i32.const 0))
(local.set $first (i32.const 1))
(local.set $cur (local.get $list))
(block $d2
(loop $l2
(br_if $d2 (i32.eqz (call $is_pair (local.get $cur))))
(local.set $s (call $car (local.get $cur)))
(if (call $is_string (local.get $s))
(then
(if (i32.eqz (local.get $first))
(then
;; copy sep
(local.set $i (i32.const 0))
(block $d3
(loop $l3
(br_if $d3 (i32.ge_u (local.get $i) (local.get $seplen)))
(call $string_set_byte (local.get $out) (i32.add (local.get $pos) (local.get $i))
(call $string_byte (local.get $sep) (local.get $i)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l3)))
(local.set $pos (i32.add (local.get $pos) (local.get $seplen)))))
;; copy s
(local.set $slen (call $string_len (local.get $s)))
(local.set $i (i32.const 0))
(block $d4
(loop $l4
(br_if $d4 (i32.ge_u (local.get $i) (local.get $slen)))
(call $string_set_byte (local.get $out) (i32.add (local.get $pos) (local.get $i))
(call $string_byte (local.get $s) (local.get $i)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l4)))
(local.set $pos (i32.add (local.get $pos) (local.get $slen)))
(local.set $first (i32.const 0))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l2)))
(local.get $out))
;; ─── Vector / hashtable helpers ────────────────────────────────
(func $list_to_vector_op (param $list i32) (result i32)
(local $len i32)
(local $cur i32)
(local $v i32)
(local $i i32)
(local.set $len (i32.const 0))
(local.set $cur (local.get $list))
(block $d1
(loop $l1
(br_if $d1 (i32.eqz (call $is_pair (local.get $cur))))
(local.set $len (i32.add (local.get $len) (i32.const 1)))
(local.set $cur (call $cdr (local.get $cur)))
(br $l1)))
(local.set $v (call $make_vector_raw (local.get $len)))
(local.set $cur (local.get $list))
(local.set $i (i32.const 0))
(block $d2
(loop $l2
(br_if $d2 (i32.eqz (call $is_pair (local.get $cur))))
(call $vector_put (local.get $v) (local.get $i) (call $car (local.get $cur)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(local.set $cur (call $cdr (local.get $cur)))
(br $l2)))
(local.get $v))
(func $vector_to_list_op (param $v i32) (result i32)
(local $len i32)
(local $i i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local.set $len (call $vector_len (local.get $v)))
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(local.set $new (call $make_pair (call $vector_get (local.get $v) (local.get $i)) (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 $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $head))
(func $make_vector_filled (param $n i32) (param $init i32) (result i32)
(local $v i32)
(local $i i32)
(local.set $v (call $make_vector_raw (local.get $n)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $n)))
(call $vector_put (local.get $v) (local.get $i) (local.get $init))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $v))
(func $ht_keys_op (param $h i32) (result i32)
(local $cur i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local.set $cur (call $ht_alist (local.get $h)))
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(block $done
(loop $l
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $new (call $make_pair (call $car (call $car (local.get $cur))) (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 $cur (call $cdr (local.get $cur)))
(br $l)))
(local.get $head))
(func $ht_values_op (param $h i32) (result i32)
(local $cur i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local.set $cur (call $ht_alist (local.get $h)))
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(block $done
(loop $l
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $new (call $make_pair (call $cdr (call $car (local.get $cur))) (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 $cur (call $cdr (local.get $cur)))
(br $l)))
(local.get $head))
;; ─── Bend dispatch ─────────────────────────────────────────────
;; Send a payload string to the configured gpu-worker via host XHR.
;; Response is written into the scratch area at 0x40000 (64 KB), then
;; copied into a freshly-allocated lumbda string.
(func $bend_call_op (param $payload i32) (result i32)
(local $resp_buf i32)
(local $resp_len i32)
(local $payload_ptr i32)
(local $payload_len i32)
(local $out i32)
(local $i i32)
(if (i32.eqz (call $is_string (local.get $payload)))
(then (return (global.get $FALSE))))
(local.set $resp_buf (i32.const 0x40000))
(local.set $payload_ptr (i32.add (local.get $payload) (i32.const 8)))
(local.set $payload_len (call $string_len (local.get $payload)))
(local.set $resp_len
(call $js_bend_call (local.get $payload_ptr) (local.get $payload_len) (local.get $resp_buf)))
(local.set $out (call $make_string_raw (local.get $resp_len)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $resp_len)))
(call $string_set_byte (local.get $out) (local.get $i)
(i32.load8_u (i32.add (local.get $resp_buf) (local.get $i))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $out))
;; ─── Primitives ────────────────────────────────────────────────
(func $apply_primitive (param $id i32) (param $args i32) (result i32)
(local $a i32)
(local $b i32)
(local $sum i32)
(local $cur i32)
(local $vmin i32)
(local $vmax i32)
(local $base i32)
(local $exp_n i32)
(local $result i32)
(local $rev i32)
(local $idx i32)
(local $idxt 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))))))
;; quotient (25): integer truncating division
(if (i32.eq (local.get $id) (i32.const 25))
(then
(return (call $make_fixnum (i32.div_s (call $fixnum_val (local.get $a))
(call $fixnum_val (local.get $b)))))))
;; remainder (26): integer remainder (sign of dividend)
(if (i32.eq (local.get $id) (i32.const 26))
(then
(return (call $make_fixnum (i32.rem_s (call $fixnum_val (local.get $a))
(call $fixnum_val (local.get $b)))))))
;; min (27): variadic
(if (i32.eq (local.get $id) (i32.const 27))
(then
(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 $vmin (call $fixnum_val (call $car (local.get $cur))))
(if (i32.lt_s (local.get $vmin) (local.get $sum))
(then (local.set $sum (local.get $vmin))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(return (call $make_fixnum (local.get $sum)))))
;; max (28): variadic
(if (i32.eq (local.get $id) (i32.const 28))
(then
(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 $vmax (call $fixnum_val (call $car (local.get $cur))))
(if (i32.gt_s (local.get $vmax) (local.get $sum))
(then (local.set $sum (local.get $vmax))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(return (call $make_fixnum (local.get $sum)))))
;; expt (29): integer exponent (positive)
(if (i32.eq (local.get $id) (i32.const 29))
(then
(local.set $base (call $fixnum_val (local.get $a)))
(local.set $exp_n (call $fixnum_val (local.get $b)))
(local.set $result (i32.const 1))
(block $done
(loop $loop
(br_if $done (i32.le_s (local.get $exp_n) (i32.const 0)))
(local.set $result (i32.mul (local.get $result) (local.get $base)))
(local.set $exp_n (i32.sub (local.get $exp_n) (i32.const 1)))
(br $loop)))
(return (call $make_fixnum (local.get $result)))))
;; even? (30)
(if (i32.eq (local.get $id) (i32.const 30))
(then
(if (i32.eqz (i32.and (call $fixnum_val (local.get $a)) (i32.const 1)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; odd? (31)
(if (i32.eq (local.get $id) (i32.const 31))
(then
(if (i32.and (call $fixnum_val (local.get $a)) (i32.const 1))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; positive? (32)
(if (i32.eq (local.get $id) (i32.const 32))
(then
(if (i32.gt_s (call $fixnum_val (local.get $a)) (i32.const 0))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; negative? (33)
(if (i32.eq (local.get $id) (i32.const 33))
(then
(if (i32.lt_s (call $fixnum_val (local.get $a)) (i32.const 0))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; set-car! (34)
(if (i32.eq (local.get $id) (i32.const 34))
(then
(call $set_car (local.get $a) (local.get $b))
(return (global.get $VOID))))
;; set-cdr! (35)
(if (i32.eq (local.get $id) (i32.const 35))
(then
(call $set_cdr (local.get $a) (local.get $b))
(return (global.get $VOID))))
;; equal? (36): deep structural equality
(if (i32.eq (local.get $id) (i32.const 36))
(then (return (call $equal_p (local.get $a) (local.get $b)))))
;; eqv? (37): identity for our value types
(if (i32.eq (local.get $id) (i32.const 37))
(then
(if (i32.eq (local.get $a) (local.get $b))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; number? (38) — fixnums only in this tier
(if (i32.eq (local.get $id) (i32.const 38))
(then
(if (call $is_fixnum (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; integer? (39) — same as number? here
(if (i32.eq (local.get $id) (i32.const 39))
(then
(if (call $is_fixnum (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; symbol? (40)
(if (i32.eq (local.get $id) (i32.const 40))
(then
(if (call $is_symbol (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; string? (41)
(if (i32.eq (local.get $id) (i32.const 41))
(then
(if (call $is_string (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; procedure? (42) — closure or primitive
(if (i32.eq (local.get $id) (i32.const 42))
(then
(if (i32.or (call $is_closure (local.get $a)) (call $is_primitive (local.get $a)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; boolean? (43)
(if (i32.eq (local.get $id) (i32.const 43))
(then
(if (i32.or (i32.eq (local.get $a) (global.get $TRUE))
(i32.eq (local.get $a) (global.get $FALSE)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; caar (44)
(if (i32.eq (local.get $id) (i32.const 44))
(then (return (call $car (call $car (local.get $a))))))
;; cadr (45)
(if (i32.eq (local.get $id) (i32.const 45))
(then (return (call $car (call $cdr (local.get $a))))))
;; cdar (46)
(if (i32.eq (local.get $id) (i32.const 46))
(then (return (call $cdr (call $car (local.get $a))))))
;; cddr (47)
(if (i32.eq (local.get $id) (i32.const 47))
(then (return (call $cdr (call $cdr (local.get $a))))))
;; caddr (48)
(if (i32.eq (local.get $id) (i32.const 48))
(then (return (call $car (call $cdr (call $cdr (local.get $a)))))))
;; cadddr (49)
(if (i32.eq (local.get $id) (i32.const 49))
(then (return (call $car (call $cdr (call $cdr (call $cdr (local.get $a))))))))
;; reverse (50)
(if (i32.eq (local.get $id) (i32.const 50))
(then
(local.set $rev (global.get $NIL))
(local.set $cur (local.get $a))
(block $done
(loop $loop
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $rev (call $make_pair (call $car (local.get $cur)) (local.get $rev)))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(return (local.get $rev))))
;; append (51) — 2-arg
(if (i32.eq (local.get $id) (i32.const 51))
(then (return (call $append2 (local.get $a) (local.get $b)))))
;; apply (52) — (apply f args)
(if (i32.eq (local.get $id) (i32.const 52))
(then (return (call $apply (local.get $a) (local.get $b)))))
;; error (53) — emit message + raise (we just write to output for now)
(if (i32.eq (local.get $id) (i32.const 53))
(then
(call $out_str (i32.const 0xF030) (i32.const 6)) ;; "<error" — reuse procedure msg
(call $print_value (local.get $a))
(call $out_char (i32.const 10))
(return (global.get $VOID))))
;; member (54) — equal?-based
(if (i32.eq (local.get $id) (i32.const 54))
(then (return (call $member_eq (local.get $a) (local.get $b) (i32.const 1)))))
;; memq (55) — eq?-based
(if (i32.eq (local.get $id) (i32.const 55))
(then (return (call $member_eq (local.get $a) (local.get $b) (i32.const 0)))))
;; assoc (56) — equal? on car
(if (i32.eq (local.get $id) (i32.const 56))
(then (return (call $assoc_eq (local.get $a) (local.get $b) (i32.const 1)))))
;; assq (57) — eq? on car
(if (i32.eq (local.get $id) (i32.const 57))
(then (return (call $assoc_eq (local.get $a) (local.get $b) (i32.const 0)))))
;; list-ref (58)
(if (i32.eq (local.get $id) (i32.const 58))
(then
(local.set $idx (call $fixnum_val (local.get $b)))
(local.set $cur (local.get $a))
(block $done
(loop $loop
(br_if $done (i32.le_s (local.get $idx) (i32.const 0)))
(local.set $cur (call $cdr (local.get $cur)))
(local.set $idx (i32.sub (local.get $idx) (i32.const 1)))
(br $loop)))
(return (call $car (local.get $cur)))))
;; list-tail (59)
(if (i32.eq (local.get $id) (i32.const 59))
(then
(local.set $idxt (call $fixnum_val (local.get $b)))
(local.set $cur (local.get $a))
(block $done
(loop $loop
(br_if $done (i32.le_s (local.get $idxt) (i32.const 0)))
(local.set $cur (call $cdr (local.get $cur)))
(local.set $idxt (i32.sub (local.get $idxt) (i32.const 1)))
(br $loop)))
(return (local.get $cur))))
;; void (60)
(if (i32.eq (local.get $id) (i32.const 60))
(then (return (global.get $VOID))))
;; string-length (61)
(if (i32.eq (local.get $id) (i32.const 61))
(then (return (call $make_fixnum (call $string_len (local.get $a))))))
;; string-ref (62) — returns char
(if (i32.eq (local.get $id) (i32.const 62))
(then (return (call $make_char
(call $string_byte (local.get $a) (call $fixnum_val (local.get $b)))))))
;; substring (63) — (substring s start end)
(if (i32.eq (local.get $id) (i32.const 63))
(then (return (call $substring_op (local.get $a)
(call $fixnum_val (local.get $b))
(call $fixnum_val (call $car (call $cdr (call $cdr (local.get $args)))))))))
;; string-append (64) — variadic
(if (i32.eq (local.get $id) (i32.const 64))
(then (return (call $string_append_op (local.get $args)))))
;; string=? (65)
(if (i32.eq (local.get $id) (i32.const 65))
(then (return (call $equal_p (local.get $a) (local.get $b)))))
;; string<? (66)
(if (i32.eq (local.get $id) (i32.const 66))
(then (return (call $string_lt (local.get $a) (local.get $b)))))
;; string-upcase (67)
(if (i32.eq (local.get $id) (i32.const 67))
(then (return (call $string_case_op (local.get $a) (i32.const 1)))))
;; string-downcase (68)
(if (i32.eq (local.get $id) (i32.const 68))
(then (return (call $string_case_op (local.get $a) (i32.const 0)))))
;; string->list (69)
(if (i32.eq (local.get $id) (i32.const 69))
(then (return (call $string_to_list (local.get $a)))))
;; list->string (70)
(if (i32.eq (local.get $id) (i32.const 70))
(then (return (call $list_to_string (local.get $a)))))
;; string->symbol (71)
(if (i32.eq (local.get $id) (i32.const 71))
(then
(return (call $intern
(i32.add (local.get $a) (i32.const 8))
(call $string_len (local.get $a))))))
;; symbol->string (72) — copy symbol bytes into a fresh string
(if (i32.eq (local.get $id) (i32.const 72))
(then (return (call $symbol_to_string (local.get $a)))))
;; make-string (73) — (make-string n) or (make-string n char)
(if (i32.eq (local.get $id) (i32.const 73))
(then (return (call $make_string_filled
(call $fixnum_val (local.get $a))
(if (result i32) (call $is_char (local.get $b))
(then (call $char_code (local.get $b)))
(else (i32.const 32)))))))
;; char? (74)
(if (i32.eq (local.get $id) (i32.const 74))
(then
(if (call $is_char (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; char->integer (75)
(if (i32.eq (local.get $id) (i32.const 75))
(then (return (call $make_fixnum (call $char_code (local.get $a))))))
;; integer->char (76)
(if (i32.eq (local.get $id) (i32.const 76))
(then (return (call $make_char (call $fixnum_val (local.get $a))))))
;; char-alphabetic? (77)
(if (i32.eq (local.get $id) (i32.const 77))
(then
(local.set $sum (call $char_code (local.get $a)))
(if (i32.or
(i32.and (i32.ge_u (local.get $sum) (i32.const 65)) (i32.le_u (local.get $sum) (i32.const 90)))
(i32.and (i32.ge_u (local.get $sum) (i32.const 97)) (i32.le_u (local.get $sum) (i32.const 122))))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; char-numeric? (78)
(if (i32.eq (local.get $id) (i32.const 78))
(then
(local.set $sum (call $char_code (local.get $a)))
(if (i32.and (i32.ge_u (local.get $sum) (i32.const 48)) (i32.le_u (local.get $sum) (i32.const 57)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; char-whitespace? (79)
(if (i32.eq (local.get $id) (i32.const 79))
(then
(local.set $sum (call $char_code (local.get $a)))
(if (i32.or
(i32.or
(i32.eq (local.get $sum) (i32.const 32))
(i32.eq (local.get $sum) (i32.const 9)))
(i32.or
(i32.eq (local.get $sum) (i32.const 10))
(i32.eq (local.get $sum) (i32.const 13))))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; char-upcase (80)
(if (i32.eq (local.get $id) (i32.const 80))
(then
(local.set $sum (call $char_code (local.get $a)))
(if (i32.and (i32.ge_u (local.get $sum) (i32.const 97)) (i32.le_u (local.get $sum) (i32.const 122)))
(then (local.set $sum (i32.sub (local.get $sum) (i32.const 32)))))
(return (call $make_char (local.get $sum)))))
;; char-downcase (81)
(if (i32.eq (local.get $id) (i32.const 81))
(then
(local.set $sum (call $char_code (local.get $a)))
(if (i32.and (i32.ge_u (local.get $sum) (i32.const 65)) (i32.le_u (local.get $sum) (i32.const 90)))
(then (local.set $sum (i32.add (local.get $sum) (i32.const 32)))))
(return (call $make_char (local.get $sum)))))
;; char=? (82)
(if (i32.eq (local.get $id) (i32.const 82))
(then
(if (i32.eq (call $char_code (local.get $a)) (call $char_code (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; char<? (83)
(if (i32.eq (local.get $id) (i32.const 83))
(then
(if (i32.lt_u (call $char_code (local.get $a)) (call $char_code (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; number->string (84)
(if (i32.eq (local.get $id) (i32.const 84))
(then (return (call $number_to_string (call $fixnum_val (local.get $a))))))
;; string->number (85)
(if (i32.eq (local.get $id) (i32.const 85))
(then (return (call $string_to_number (local.get $a)))))
;; string-contains (86) — returns #t if substring present, else #f
(if (i32.eq (local.get $id) (i32.const 86))
(then (return (call $string_contains_p (local.get $a) (local.get $b)))))
;; string-join (87) — (string-join list-of-strings sep-string)
(if (i32.eq (local.get $id) (i32.const 87))
(then (return (call $string_join_op (local.get $a) (local.get $b)))))
;; vector (88) — (vector a b c ...) returns a vector with the args
(if (i32.eq (local.get $id) (i32.const 88))
(then (return (call $list_to_vector_op (local.get $args)))))
;; vector? (89)
(if (i32.eq (local.get $id) (i32.const 89))
(then
(if (call $is_vector (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; make-vector (90) — (make-vector n [init])
(if (i32.eq (local.get $id) (i32.const 90))
(then (return (call $make_vector_filled
(call $fixnum_val (local.get $a))
(local.get $b)))))
;; vector-length (91)
(if (i32.eq (local.get $id) (i32.const 91))
(then (return (call $make_fixnum (call $vector_len (local.get $a))))))
;; vector-ref (92)
(if (i32.eq (local.get $id) (i32.const 92))
(then (return (call $vector_get (local.get $a) (call $fixnum_val (local.get $b))))))
;; vector-set! (93) — (vector-set! v i val)
(if (i32.eq (local.get $id) (i32.const 93))
(then
(call $vector_put (local.get $a)
(call $fixnum_val (local.get $b))
(call $car (call $cdr (call $cdr (local.get $args)))))
(return (global.get $VOID))))
;; vector->list (94)
(if (i32.eq (local.get $id) (i32.const 94))
(then (return (call $vector_to_list_op (local.get $a)))))
;; list->vector (95)
(if (i32.eq (local.get $id) (i32.const 95))
(then (return (call $list_to_vector_op (local.get $a)))))
;; make-hash-table (96)
(if (i32.eq (local.get $id) (i32.const 96))
(then (return (call $make_hashtable))))
;; hash-table? (97)
(if (i32.eq (local.get $id) (i32.const 97))
(then
(if (call $is_hashtable (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; hash-table-set! (98) — (hash-table-set! h k v)
(if (i32.eq (local.get $id) (i32.const 98))
(then
(call $ht_set (local.get $a) (local.get $b)
(call $car (call $cdr (call $cdr (local.get $args)))))
(return (global.get $VOID))))
;; hash-table-ref (99) — (hash-table-ref h k) — returns value or FALSE
(if (i32.eq (local.get $id) (i32.const 99))
(then
(local.set $sum (call $ht_find (local.get $a) (local.get $b)))
(if (i32.eq (local.get $sum) (global.get $FALSE))
(then (return (global.get $FALSE))))
(return (call $cdr (local.get $sum)))))
;; hash-table-ref/default (100) — (hash-table-ref/default h k def)
(if (i32.eq (local.get $id) (i32.const 100))
(then
(local.set $sum (call $ht_find (local.get $a) (local.get $b)))
(if (i32.eq (local.get $sum) (global.get $FALSE))
(then (return (call $car (call $cdr (call $cdr (local.get $args)))))))
(return (call $cdr (local.get $sum)))))
;; hash-table-delete! (101)
(if (i32.eq (local.get $id) (i32.const 101))
(then
(drop (call $ht_delete (local.get $a) (local.get $b)))
(return (global.get $VOID))))
;; hash-table-exists? (102)
(if (i32.eq (local.get $id) (i32.const 102))
(then
(local.set $sum (call $ht_find (local.get $a) (local.get $b)))
(if (i32.eq (local.get $sum) (global.get $FALSE))
(then (return (global.get $FALSE))))
(return (global.get $TRUE))))
;; hash-table-size (103)
(if (i32.eq (local.get $id) (i32.const 103))
(then (return (call $make_fixnum (call $ht_count (local.get $a))))))
;; hash-table-keys (104) — fresh list of keys
(if (i32.eq (local.get $id) (i32.const 104))
(then (return (call $ht_keys_op (local.get $a)))))
;; hash-table-values (105) — fresh list of values
(if (i32.eq (local.get $id) (i32.const 105))
(then (return (call $ht_values_op (local.get $a)))))
;; hash-table->alist (106)
(if (i32.eq (local.get $id) (i32.const 106))
(then (return (call $ht_alist (local.get $a)))))
;; write (107) — like display but quotes strings and #\-chars
(if (i32.eq (local.get $id) (i32.const 107))
(then (call $write_value (local.get $a)) (return (global.get $VOID))))
;; write-string (108) — write a string without quoting
(if (i32.eq (local.get $id) (i32.const 108))
(then
(if (call $is_string (local.get $a))
(then
(call $out_str
(i32.add (local.get $a) (i32.const 8))
(call $string_len (local.get $a)))))
(return (global.get $VOID))))
;; bend!-call (109) — dispatch a payload string to the configured
;; gpu-worker URL via host JS sync XHR. Returns the response as a string.
(if (i32.eq (local.get $id) (i32.const 109))
(then (return (call $bend_call_op (local.get $a)))))
(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) " . ")
(data (i32.const 0xF050) "#(")
(data (i32.const 0xF060) "#<hashtable>")
(data (i32.const 0xF080) "#\\")
;; 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!")
(data (i32.const 0xE0B0) "let*")
(data (i32.const 0xE0B8) "letrec")
(data (i32.const 0xE0C0) "when")
(data (i32.const 0xE0C8) "unless")
(data (i32.const 0xE0D0) "case")
(data (i32.const 0xE0D8) "do")
;; 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?")
(data (i32.const 0xE188) "quotient")
(data (i32.const 0xE194) "remainder")
(data (i32.const 0xE1A0) "min")
(data (i32.const 0xE1A4) "max")
(data (i32.const 0xE1A8) "expt")
(data (i32.const 0xE1B0) "even?")
(data (i32.const 0xE1B8) "odd?")
(data (i32.const 0xE1C0) "positive?")
(data (i32.const 0xE1CC) "negative?")
(data (i32.const 0xE1D8) "set-car!")
(data (i32.const 0xE1E4) "set-cdr!")
(data (i32.const 0xE1F0) "equal?")
(data (i32.const 0xE1F8) "eqv?")
(data (i32.const 0xE200) "number?")
(data (i32.const 0xE208) "integer?")
(data (i32.const 0xE214) "symbol?")
(data (i32.const 0xE220) "string?")
(data (i32.const 0xE228) "procedure?")
(data (i32.const 0xE234) "boolean?")
(data (i32.const 0xE240) "caar")
(data (i32.const 0xE248) "cadr")
(data (i32.const 0xE250) "cdar")
(data (i32.const 0xE258) "cddr")
(data (i32.const 0xE260) "caddr")
(data (i32.const 0xE268) "cadddr")
(data (i32.const 0xE270) "reverse")
(data (i32.const 0xE278) "append")
(data (i32.const 0xE280) "apply")
(data (i32.const 0xE288) "error")
(data (i32.const 0xE290) "member")
(data (i32.const 0xE298) "memq")
(data (i32.const 0xE2A0) "assoc")
(data (i32.const 0xE2A8) "assq")
(data (i32.const 0xE2B0) "list-ref")
(data (i32.const 0xE2BC) "list-tail")
(data (i32.const 0xE2C8) "void")
;; Named character spellings.
(data (i32.const 0xE2D0) "space")
(data (i32.const 0xE2D8) "newline")
(data (i32.const 0xE2E0) "tab")
(data (i32.const 0xE2E4) "return")
(data (i32.const 0xE2EC) "null")
;; String + char primitive names.
(data (i32.const 0xE300) "string-length")
(data (i32.const 0xE310) "string-ref")
(data (i32.const 0xE31C) "substring")
(data (i32.const 0xE328) "string-append")
(data (i32.const 0xE338) "string=?")
(data (i32.const 0xE344) "string<?")
(data (i32.const 0xE350) "string-upcase")
(data (i32.const 0xE360) "string-downcase")
(data (i32.const 0xE374) "string->list")
(data (i32.const 0xE384) "list->string")
(data (i32.const 0xE394) "string->symbol")
(data (i32.const 0xE3A4) "symbol->string")
(data (i32.const 0xE3B4) "make-string")
(data (i32.const 0xE3C0) "char?")
(data (i32.const 0xE3C8) "char->integer")
(data (i32.const 0xE3D8) "integer->char")
(data (i32.const 0xE3E8) "char-alphabetic?")
(data (i32.const 0xE3FC) "char-numeric?")
(data (i32.const 0xE40C) "char-whitespace?")
(data (i32.const 0xE420) "char-upcase")
(data (i32.const 0xE42C) "char-downcase")
(data (i32.const 0xE43C) "char=?")
(data (i32.const 0xE444) "char<?")
(data (i32.const 0xE44C) "number->string")
(data (i32.const 0xE45C) "string->number")
(data (i32.const 0xE46C) "string-contains")
(data (i32.const 0xE47C) "string-join")
;; Vectors & hash tables.
(data (i32.const 0xE490) "vector")
(data (i32.const 0xE498) "vector?")
(data (i32.const 0xE4A0) "make-vector")
(data (i32.const 0xE4AC) "vector-length")
(data (i32.const 0xE4BC) "vector-ref")
(data (i32.const 0xE4C8) "vector-set!")
(data (i32.const 0xE4D4) "vector->list")
(data (i32.const 0xE4E4) "list->vector")
(data (i32.const 0xE4F4) "make-hash-table")
(data (i32.const 0xE504) "hash-table?")
(data (i32.const 0xE510) "hash-table-set!")
(data (i32.const 0xE520) "hash-table-ref")
(data (i32.const 0xE530) "hash-table-ref/default")
(data (i32.const 0xE548) "hash-table-delete!")
(data (i32.const 0xE55C) "hash-table-exists?")
(data (i32.const 0xE570) "hash-table-size")
(data (i32.const 0xE580) "hash-table-keys")
(data (i32.const 0xE590) "hash-table-values")
(data (i32.const 0xE5A4) "hash-table->alist")
(data (i32.const 0xE5B8) "write")
(data (i32.const 0xE5C0) "write-string")
(data (i32.const 0xE5D0) "bend!-call")
;; ── Embedded Lisp prelude. Evaluated at end of init. ─────────────
(data (i32.const 0x50000)
"(define (map f xs) (if (null? xs) (quote ()) (cons (f (car xs)) (map f (cdr xs)))))\n"
"(define (filter p xs) (cond ((null? xs) (quote ())) ((p (car xs)) (cons (car xs) (filter p (cdr xs)))) (else (filter p (cdr xs)))))\n"
"(define (fold-left f z xs) (if (null? xs) z (fold-left f (f z (car xs)) (cdr xs))))\n"
"(define (fold-right f z xs) (if (null? xs) z (f (car xs) (fold-right f z (cdr xs)))))\n"
"(define (for-each f xs) (cond ((null? xs) (void)) (else (f (car xs)) (for-each f (cdr xs)))))\n"
"(define (any p xs) (cond ((null? xs) #f) ((p (car xs)) #t) (else (any p (cdr xs)))))\n"
"(define (every p xs) (cond ((null? xs) #t) ((p (car xs)) (every p (cdr xs))) (else #f)))\n"
"(define (count p xs) (fold-left (lambda (acc x) (if (p x) (+ acc 1) acc)) 0 xs))\n"
"(define (find p xs) (cond ((null? xs) #f) ((p (car xs)) (car xs)) (else (find p (cdr xs)))))\n"
"(define (string-split s sep) (let loop ((i 0) (start 0) (acc (quote ()))) (cond ((>= i (string-length s)) (reverse (cons (substring s start i) acc))) ((char=? (string-ref s i) sep) (loop (+ i 1) (+ i 1) (cons (substring s start i) acc))) (else (loop (+ i 1) start acc)))))\n"
"(define (string-trim s) (let* ((len (string-length s)) (start (let loop ((i 0)) (cond ((>= i len) i) ((char-whitespace? (string-ref s i)) (loop (+ i 1))) (else i)))) (end (let loop ((i (- len 1))) (cond ((< i start) start) ((char-whitespace? (string-ref s i)) (loop (- i 1))) (else (+ i 1)))))) (substring s start end)))\n"
"(define (string->list s) (let loop ((i 0) (acc (quote ()))) (if (>= i (string-length s)) (reverse acc) (loop (+ i 1) (cons (string-ref s i) acc)))))\n"
"(define (random-state) (cons 12345 67890))\n"
"(define (vector-map f v) (let* ((n (vector-length v)) (r (make-vector n 0))) (let loop ((i 0)) (cond ((>= i n) r) (else (vector-set! r i (f (vector-ref v i))) (loop (+ i 1)))))))\n"
"(define (vector-for-each f v) (let ((n (vector-length v))) (let loop ((i 0)) (cond ((>= i n) (void)) (else (f (vector-ref v i)) (loop (+ i 1)))))))\n"
"(define (vector-fill! v x) (let ((n (vector-length v))) (let loop ((i 0)) (cond ((>= i n) (void)) (else (vector-set! v i x) (loop (+ i 1)))))))\n"
"(define (sort xs less?) (cond ((null? xs) (quote ())) ((null? (cdr xs)) xs) (else (let ((p (car xs)) (rest (cdr xs))) (append (sort (filter (lambda (x) (less? x p)) rest) less?) (cons p (sort (filter (lambda (x) (not (less? x p))) rest) less?)))))))\n"
"(define (assert-equal expected actual) (cond ((equal? expected actual) #t) (else (display \"FAIL expected=\") (display expected) (display \" actual=\") (display actual) (newline) #f)))\n"
"(define (assert-true v) (cond (v #t) (else (display \"FAIL expected truthy got=\") (display v) (newline) #f)))\n"
"(define (assert-false v) (cond ((not v) #t) (else (display \"FAIL expected #f got=\") (display v) (newline) #f)))\n"
)
(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)))))
;; Length of a NUL-terminated byte sequence (used for prelude embed).
(func $strlen_nul (param $p i32) (result i32)
(local $i i32)
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.eqz (i32.load8_u (i32.add (local.get $p) (local.get $i)))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $i))
;; Evaluate the embedded prelude. Source bounds restored by next lumbda_eval.
(func $eval_prelude
(local $val i32)
(global.set $prelude_len (call $strlen_nul (global.get $prelude_ptr)))
(global.set $source_ptr (global.get $prelude_ptr))
(global.set $source_end (i32.add (global.get $prelude_ptr) (global.get $prelude_len)))
(block $done
(loop $loop
(call $skip_ws)
(br_if $done (i32.ge_u (global.get $source_ptr) (global.get $source_end)))
(local.set $val (call $eval (call $read) (global.get $NIL)))
(br $loop))))
(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)))
(global.set $sym_letstar (call $intern (i32.const 0xE0B0) (i32.const 4)))
(global.set $sym_letrec (call $intern (i32.const 0xE0B8) (i32.const 6)))
(global.set $sym_when (call $intern (i32.const 0xE0C0) (i32.const 4)))
(global.set $sym_unless (call $intern (i32.const 0xE0C8) (i32.const 6)))
(global.set $sym_case (call $intern (i32.const 0xE0D0) (i32.const 4)))
(global.set $sym_do (call $intern (i32.const 0xE0D8) (i32.const 2)))
(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?
(call $bind_prim (i32.const 0xE188) (i32.const 8) (i32.const 25)) ;; quotient
(call $bind_prim (i32.const 0xE194) (i32.const 9) (i32.const 26)) ;; remainder
(call $bind_prim (i32.const 0xE1A0) (i32.const 3) (i32.const 27)) ;; min
(call $bind_prim (i32.const 0xE1A4) (i32.const 3) (i32.const 28)) ;; max
(call $bind_prim (i32.const 0xE1A8) (i32.const 4) (i32.const 29)) ;; expt
(call $bind_prim (i32.const 0xE1B0) (i32.const 5) (i32.const 30)) ;; even?
(call $bind_prim (i32.const 0xE1B8) (i32.const 4) (i32.const 31)) ;; odd?
(call $bind_prim (i32.const 0xE1C0) (i32.const 9) (i32.const 32)) ;; positive?
(call $bind_prim (i32.const 0xE1CC) (i32.const 9) (i32.const 33)) ;; negative?
(call $bind_prim (i32.const 0xE1D8) (i32.const 8) (i32.const 34)) ;; set-car!
(call $bind_prim (i32.const 0xE1E4) (i32.const 8) (i32.const 35)) ;; set-cdr!
(call $bind_prim (i32.const 0xE1F0) (i32.const 6) (i32.const 36)) ;; equal?
(call $bind_prim (i32.const 0xE1F8) (i32.const 4) (i32.const 37)) ;; eqv?
(call $bind_prim (i32.const 0xE200) (i32.const 7) (i32.const 38)) ;; number?
(call $bind_prim (i32.const 0xE208) (i32.const 8) (i32.const 39)) ;; integer?
(call $bind_prim (i32.const 0xE214) (i32.const 7) (i32.const 40)) ;; symbol?
(call $bind_prim (i32.const 0xE220) (i32.const 7) (i32.const 41)) ;; string?
(call $bind_prim (i32.const 0xE228) (i32.const 10) (i32.const 42)) ;; procedure?
(call $bind_prim (i32.const 0xE234) (i32.const 8) (i32.const 43)) ;; boolean?
(call $bind_prim (i32.const 0xE240) (i32.const 4) (i32.const 44)) ;; caar
(call $bind_prim (i32.const 0xE248) (i32.const 4) (i32.const 45)) ;; cadr
(call $bind_prim (i32.const 0xE250) (i32.const 4) (i32.const 46)) ;; cdar
(call $bind_prim (i32.const 0xE258) (i32.const 4) (i32.const 47)) ;; cddr
(call $bind_prim (i32.const 0xE260) (i32.const 5) (i32.const 48)) ;; caddr
(call $bind_prim (i32.const 0xE268) (i32.const 6) (i32.const 49)) ;; cadddr
(call $bind_prim (i32.const 0xE270) (i32.const 7) (i32.const 50)) ;; reverse
(call $bind_prim (i32.const 0xE278) (i32.const 6) (i32.const 51)) ;; append
(call $bind_prim (i32.const 0xE280) (i32.const 5) (i32.const 52)) ;; apply
(call $bind_prim (i32.const 0xE288) (i32.const 5) (i32.const 53)) ;; error
(call $bind_prim (i32.const 0xE290) (i32.const 6) (i32.const 54)) ;; member
(call $bind_prim (i32.const 0xE298) (i32.const 4) (i32.const 55)) ;; memq
(call $bind_prim (i32.const 0xE2A0) (i32.const 5) (i32.const 56)) ;; assoc
(call $bind_prim (i32.const 0xE2A8) (i32.const 4) (i32.const 57)) ;; assq
(call $bind_prim (i32.const 0xE2B0) (i32.const 8) (i32.const 58)) ;; list-ref
(call $bind_prim (i32.const 0xE2BC) (i32.const 9) (i32.const 59)) ;; list-tail
(call $bind_prim (i32.const 0xE2C8) (i32.const 4) (i32.const 60)) ;; void
(call $bind_prim (i32.const 0xE300) (i32.const 13) (i32.const 61)) ;; string-length
(call $bind_prim (i32.const 0xE310) (i32.const 10) (i32.const 62)) ;; string-ref
(call $bind_prim (i32.const 0xE31C) (i32.const 9) (i32.const 63)) ;; substring
(call $bind_prim (i32.const 0xE328) (i32.const 13) (i32.const 64)) ;; string-append
(call $bind_prim (i32.const 0xE338) (i32.const 8) (i32.const 65)) ;; string=?
(call $bind_prim (i32.const 0xE344) (i32.const 8) (i32.const 66)) ;; string<?
(call $bind_prim (i32.const 0xE350) (i32.const 13) (i32.const 67)) ;; string-upcase
(call $bind_prim (i32.const 0xE360) (i32.const 15) (i32.const 68)) ;; string-downcase
(call $bind_prim (i32.const 0xE374) (i32.const 12) (i32.const 69)) ;; string->list
(call $bind_prim (i32.const 0xE384) (i32.const 12) (i32.const 70)) ;; list->string
(call $bind_prim (i32.const 0xE394) (i32.const 14) (i32.const 71)) ;; string->symbol
(call $bind_prim (i32.const 0xE3A4) (i32.const 14) (i32.const 72)) ;; symbol->string
(call $bind_prim (i32.const 0xE3B4) (i32.const 11) (i32.const 73)) ;; make-string
(call $bind_prim (i32.const 0xE3C0) (i32.const 5) (i32.const 74)) ;; char?
(call $bind_prim (i32.const 0xE3C8) (i32.const 13) (i32.const 75)) ;; char->integer
(call $bind_prim (i32.const 0xE3D8) (i32.const 13) (i32.const 76)) ;; integer->char
(call $bind_prim (i32.const 0xE3E8) (i32.const 16) (i32.const 77)) ;; char-alphabetic?
(call $bind_prim (i32.const 0xE3FC) (i32.const 13) (i32.const 78)) ;; char-numeric?
(call $bind_prim (i32.const 0xE40C) (i32.const 16) (i32.const 79)) ;; char-whitespace?
(call $bind_prim (i32.const 0xE420) (i32.const 11) (i32.const 80)) ;; char-upcase
(call $bind_prim (i32.const 0xE42C) (i32.const 13) (i32.const 81)) ;; char-downcase
(call $bind_prim (i32.const 0xE43C) (i32.const 6) (i32.const 82)) ;; char=?
(call $bind_prim (i32.const 0xE444) (i32.const 6) (i32.const 83)) ;; char<?
(call $bind_prim (i32.const 0xE44C) (i32.const 14) (i32.const 84)) ;; number->string
(call $bind_prim (i32.const 0xE45C) (i32.const 14) (i32.const 85)) ;; string->number
(call $bind_prim (i32.const 0xE46C) (i32.const 15) (i32.const 86)) ;; string-contains
(call $bind_prim (i32.const 0xE47C) (i32.const 11) (i32.const 87)) ;; string-join
(call $bind_prim (i32.const 0xE490) (i32.const 6) (i32.const 88)) ;; vector
(call $bind_prim (i32.const 0xE498) (i32.const 7) (i32.const 89)) ;; vector?
(call $bind_prim (i32.const 0xE4A0) (i32.const 11) (i32.const 90)) ;; make-vector
(call $bind_prim (i32.const 0xE4AC) (i32.const 13) (i32.const 91)) ;; vector-length
(call $bind_prim (i32.const 0xE4BC) (i32.const 10) (i32.const 92)) ;; vector-ref
(call $bind_prim (i32.const 0xE4C8) (i32.const 11) (i32.const 93)) ;; vector-set!
(call $bind_prim (i32.const 0xE4D4) (i32.const 12) (i32.const 94)) ;; vector->list
(call $bind_prim (i32.const 0xE4E4) (i32.const 12) (i32.const 95)) ;; list->vector
(call $bind_prim (i32.const 0xE4F4) (i32.const 15) (i32.const 96)) ;; make-hash-table
(call $bind_prim (i32.const 0xE504) (i32.const 11) (i32.const 97)) ;; hash-table?
(call $bind_prim (i32.const 0xE510) (i32.const 15) (i32.const 98)) ;; hash-table-set!
(call $bind_prim (i32.const 0xE520) (i32.const 14) (i32.const 99)) ;; hash-table-ref
(call $bind_prim (i32.const 0xE530) (i32.const 22) (i32.const 100)) ;; hash-table-ref/default
(call $bind_prim (i32.const 0xE548) (i32.const 18) (i32.const 101)) ;; hash-table-delete!
(call $bind_prim (i32.const 0xE55C) (i32.const 18) (i32.const 102)) ;; hash-table-exists?
(call $bind_prim (i32.const 0xE570) (i32.const 15) (i32.const 103)) ;; hash-table-size
(call $bind_prim (i32.const 0xE580) (i32.const 15) (i32.const 104)) ;; hash-table-keys
(call $bind_prim (i32.const 0xE590) (i32.const 17) (i32.const 105)) ;; hash-table-values
(call $bind_prim (i32.const 0xE5A4) (i32.const 17) (i32.const 106)) ;; hash-table->alist
(call $bind_prim (i32.const 0xE5B8) (i32.const 5) (i32.const 107)) ;; write
(call $bind_prim (i32.const 0xE5C0) (i32.const 12) (i32.const 108)) ;; write-string
(call $bind_prim (i32.const 0xE5D0) (i32.const 10) (i32.const 109)) ;; bend!-call
(call $eval_prelude))
;; ─── 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