engineering/lumbda
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
lumbda/wasm/asm/lumbda.wat
russell@unturf.com 7ea65dba21
parity probe: cross-tier corpus + fix python remainder + asm modulo 
New: wasm/tests/parity-cross-tier.mjs runs the parity-corpus.mjs (216
test cases tagged by whitepaper section / R7RS concept) against three
tiers — native python (reference), c-wasm, asm-wasm — and fails on any
unknown divergence. Known gaps live in KNOWN_DIVERGE so the table stays
green while the bignum / call/cc / etc. work proceeds.

Wired into `make wasm-test` so a regression against any spec claim gets
caught before merge.

Bugs caught and fixed:
  - python remainder: was `signed_a % signed_b * sign(a)`, which double-
    applied the sign of a (python's % floors) — gave -3 for (-17, 5)
    instead of the R7RS-correct -2. Now uses abs() on both sides.
  - asm-wasm modulo: was i32.rem_s (truncated, remainder semantics)
    where R7RS modulo wants sign of divisor. Added the "if rem and
    divisor disagree on sign, add divisor" branch.

Cross-tier numbers after fix:
  216 passing
    3 known diverge: expt-2-100, expt-3-50, big-arith — all asm-wasm
      (no bignums on the asm tier yet; whitepaper §2.1 claim still open)
    0 fail

REPL layout: body is now the scroll container, prompt-bar is
position:fixed at the viewport bottom so it doesn't get pushed off
screen by a long transcript. Empty space above the prompt on a fresh
session reads like a terminal.

All other tests still pass: 20 unit, 8 integration, 11 functional.
2026-06-14 15:21:19 -04:00

3437 lines
151 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))
;; Scratch space for to_rat: the WAT one-result calling convention is
;; awkward for "return two values", so to_rat sets these globals and
;; rat_*_ops read them. Single-threaded execution makes this safe.
(global $rat_tmp_n (mut i32) (i32.const 0))
(global $rat_tmp_d (mut i32) (i32.const 1))
;; 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))
;; ─── Rationals (tag=9) ─────────────────────────────────────────
;; Layout: [tag=9, num: i32, den: i32]. num/den are 31-bit signed.
;; Real bignums would lift the overflow ceiling — TODO when the WAT
;; tier grows arbitrary-precision integers.
(func $is_rational (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 9)))))))
(func $is_number (param $v i32) (result i32)
(if (result i32) (call $is_fixnum (local.get $v))
(then (i32.const 1))
(else (call $is_rational (local.get $v)))))
(func $rat_num (param $v i32) (result i32)
(i32.load offset=4 (local.get $v)))
(func $rat_den (param $v i32) (result i32)
(i32.load offset=8 (local.get $v)))
;; Euclidean gcd on signed i32. Returns a positive result.
(func $gcd_i32 (param $a i32) (param $b i32) (result i32)
(local $t i32)
(if (i32.lt_s (local.get $a) (i32.const 0))
(then (local.set $a (i32.sub (i32.const 0) (local.get $a)))))
(if (i32.lt_s (local.get $b) (i32.const 0))
(then (local.set $b (i32.sub (i32.const 0) (local.get $b)))))
(block $done
(loop $l
(br_if $done (i32.eqz (local.get $b)))
(local.set $t (i32.rem_s (local.get $a) (local.get $b)))
(local.set $a (local.get $b))
(local.set $b (local.get $t))
(br $l)))
(local.get $a))
;; Build a rational from i32 num/den. Normalizes via gcd, returns a
;; fixnum if the denominator reduces to 1.
(func $make_rational (param $num i32) (param $den i32) (result i32)
(local $g i32)
(local $p i32)
(if (i32.eqz (local.get $den))
(then
;; div-by-zero: leave as raw num/0 so caller can handle as error
(local.set $p (call $alloc (i32.const 12)))
(i32.store (local.get $p) (i32.const 9))
(i32.store offset=4 (local.get $p) (local.get $num))
(i32.store offset=8 (local.get $p) (i32.const 0))
(return (local.get $p))))
;; Move sign to numerator: keep den positive.
(if (i32.lt_s (local.get $den) (i32.const 0))
(then
(local.set $num (i32.sub (i32.const 0) (local.get $num)))
(local.set $den (i32.sub (i32.const 0) (local.get $den)))))
(local.set $g (call $gcd_i32 (local.get $num) (local.get $den)))
(if (i32.gt_s (local.get $g) (i32.const 1))
(then
(local.set $num (i32.div_s (local.get $num) (local.get $g)))
(local.set $den (i32.div_s (local.get $den) (local.get $g)))))
;; den == 1 collapses to a fixnum.
(if (i32.eq (local.get $den) (i32.const 1))
(then (return (call $make_fixnum (local.get $num)))))
(local.set $p (call $alloc (i32.const 12)))
(i32.store (local.get $p) (i32.const 9))
(i32.store offset=4 (local.get $p) (local.get $num))
(i32.store offset=8 (local.get $p) (local.get $den))
(local.get $p))
;; Convert a number Value to (num,den) returned via globals (numerator
;; in $rat_tmp_n, denominator in $rat_tmp_d). Fixnum → (n, 1).
(func $to_rat (param $v i32)
(if (call $is_fixnum (local.get $v))
(then
(global.set $rat_tmp_n (call $fixnum_val (local.get $v)))
(global.set $rat_tmp_d (i32.const 1))
(return)))
(if (call $is_rational (local.get $v))
(then
(global.set $rat_tmp_n (call $rat_num (local.get $v)))
(global.set $rat_tmp_d (call $rat_den (local.get $v)))
(return)))
;; Anything else falls back to 0/1.
(global.set $rat_tmp_n (i32.const 0))
(global.set $rat_tmp_d (i32.const 1)))
(func $rat_add (param $a i32) (param $b i32) (result i32)
(local $an i32) (local $ad i32) (local $bn i32) (local $bd i32)
(call $to_rat (local.get $a))
(local.set $an (global.get $rat_tmp_n)) (local.set $ad (global.get $rat_tmp_d))
(call $to_rat (local.get $b))
(local.set $bn (global.get $rat_tmp_n)) (local.set $bd (global.get $rat_tmp_d))
(call $make_rational
(i32.add (i32.mul (local.get $an) (local.get $bd))
(i32.mul (local.get $bn) (local.get $ad)))
(i32.mul (local.get $ad) (local.get $bd))))
(func $rat_sub (param $a i32) (param $b i32) (result i32)
(local $an i32) (local $ad i32) (local $bn i32) (local $bd i32)
(call $to_rat (local.get $a))
(local.set $an (global.get $rat_tmp_n)) (local.set $ad (global.get $rat_tmp_d))
(call $to_rat (local.get $b))
(local.set $bn (global.get $rat_tmp_n)) (local.set $bd (global.get $rat_tmp_d))
(call $make_rational
(i32.sub (i32.mul (local.get $an) (local.get $bd))
(i32.mul (local.get $bn) (local.get $ad)))
(i32.mul (local.get $ad) (local.get $bd))))
(func $rat_mul (param $a i32) (param $b i32) (result i32)
(local $an i32) (local $ad i32) (local $bn i32) (local $bd i32)
(call $to_rat (local.get $a))
(local.set $an (global.get $rat_tmp_n)) (local.set $ad (global.get $rat_tmp_d))
(call $to_rat (local.get $b))
(local.set $bn (global.get $rat_tmp_n)) (local.set $bd (global.get $rat_tmp_d))
(call $make_rational
(i32.mul (local.get $an) (local.get $bn))
(i32.mul (local.get $ad) (local.get $bd))))
(func $rat_div (param $a i32) (param $b i32) (result i32)
(local $an i32) (local $ad i32) (local $bn i32) (local $bd i32)
(call $to_rat (local.get $a))
(local.set $an (global.get $rat_tmp_n)) (local.set $ad (global.get $rat_tmp_d))
(call $to_rat (local.get $b))
(local.set $bn (global.get $rat_tmp_n)) (local.set $bd (global.get $rat_tmp_d))
(call $make_rational
(i32.mul (local.get $an) (local.get $bd))
(i32.mul (local.get $ad) (local.get $bn))))
;; Returns 1 if a == b as rationals, else 0.
(func $rat_eq (param $a i32) (param $b i32) (result i32)
(local $an i32) (local $ad i32) (local $bn i32) (local $bd i32)
(call $to_rat (local.get $a))
(local.set $an (global.get $rat_tmp_n)) (local.set $ad (global.get $rat_tmp_d))
(call $to_rat (local.get $b))
(local.set $bn (global.get $rat_tmp_n)) (local.set $bd (global.get $rat_tmp_d))
(i32.eq (i32.mul (local.get $an) (local.get $bd))
(i32.mul (local.get $bn) (local.get $ad))))
;; Returns 1 if a < b as rationals, else 0. Denominators always positive.
(func $rat_lt (param $a i32) (param $b i32) (result i32)
(local $an i32) (local $ad i32) (local $bn i32) (local $bd i32)
(call $to_rat (local.get $a))
(local.set $an (global.get $rat_tmp_n)) (local.set $ad (global.get $rat_tmp_d))
(call $to_rat (local.get $b))
(local.set $bn (global.get $rat_tmp_n)) (local.set $bd (global.get $rat_tmp_d))
(i32.lt_s (i32.mul (local.get $an) (local.get $bd))
(i32.mul (local.get $bn) (local.get $ad))))
;; ─── 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 (call $is_rational (local.get $v))
(then
(call $out_int (call $rat_num (local.get $v)))
(call $out_char (i32.const 47)) ;; /
(call $out_int (call $rat_den (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)
(local $den i32)
(local $den_start 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))))
;; ) — stray close paren. Advance past it so the top-level eval loop
;; doesn't spin reading the same byte forever. Returns VOID so the
;; caller skips this token.
(if (i32.eq (local.get $c) (i32.const 41))
(then
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(return (global.get $VOID))))
;; ' — 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)))))
;; Try rational form: numerator '/' denominator (e.g. 67/7).
(if (i32.and
(i32.lt_u (local.get $i) (local.get $len))
(i32.eq (i32.load8_u (i32.add (local.get $start) (local.get $i))) (i32.const 47)))
(then
(local.set $den (i32.const 0))
(local.set $i (i32.add (local.get $i) (i32.const 1))) ;; skip /
(local.set $den_start (local.get $i))
(block $den_done
(loop $den_loop
(br_if $den_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 $den_done (i32.eqz (call $is_digit (local.get $byte))))
(local.set $den (i32.add (i32.mul (local.get $den) (i32.const 10))
(i32.sub (local.get $byte) (i32.const 48))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $den_loop)))
;; Require: consumed all bytes AND denominator had at least 1 digit.
(if (i32.and
(i32.eq (local.get $i) (local.get $len))
(i32.gt_s (local.get $i) (local.get $den_start)))
(then
(if (local.get $neg)
(then (local.set $n (i32.sub (i32.const 0) (local.get $n)))))
(return (call $make_rational (local.get $n) (local.get $den)))))))))
;; 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 $c0 i32)
(local $c1 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)))
(local.set $c0 (i32.load8_u (global.get $source_ptr)))
(if (i32.eq (local.get $c0) (i32.const 41)) ;; )
(then
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(br $done)))
;; Dotted-pair notation: a lone "." between elements means the
;; next expression becomes the cdr of the last pair (not cons'd).
(if (i32.eq (local.get $c0) (i32.const 46)) ;; .
(then
;; Lookahead: confirm the next byte is whitespace or `(`.
(if (i32.lt_u
(i32.add (global.get $source_ptr) (i32.const 1))
(global.get $source_end))
(then
(local.set $c1 (i32.load8_u
(i32.add (global.get $source_ptr) (i32.const 1))))
(if (i32.or
(i32.or
(i32.eq (local.get $c1) (i32.const 32))
(i32.eq (local.get $c1) (i32.const 9)))
(i32.or
(i32.eq (local.get $c1) (i32.const 10))
(i32.eq (local.get $c1) (i32.const 13))))
(then
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(call $skip_ws)
(local.set $item (call $read))
(if (i32.ne (local.get $tail) (global.get $NIL))
(then (call $set_cdr (local.get $tail) (local.get $item))))
;; Consume the closing )
(call $skip_ws)
(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, rational, immediate, string, char, closure, primitive
(if (call $is_fixnum (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_rational (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 — apply is the tail call.
(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)))
;; Last expression in a begin is the tail position — TCO it.
(if (i32.eq (call $cdr (local.get $rest)) (global.get $NIL))
(then (return_call $eval (call $car (local.get $rest)) (local.get $env))))
(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)))
(return_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)))
(return_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)))
(return_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)))
;; Last clause is the tail position — TCO.
(if (i32.eq (call $cdr (local.get $rest)) (global.get $NIL))
(then (return_call $eval (call $car (local.get $rest)) (local.get $env))))
(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)))
;; Last clause is the tail position — TCO.
(if (i32.eq (call $cdr (local.get $rest)) (global.get $NIL))
(then (return_call $eval (call $car (local.get $rest)) (local.get $env))))
(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.
;; Guards against non-pair tails so dotted argument lists (e.g. when a
;; user mistakenly passes (a . body) as a call) don't dereference into
;; garbage memory.
(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.eqz (call $is_pair (local.get $args))))
(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))))
;; Numeric values compare by value (1/2 == 1/2, fixnum 3 == 6/2).
(if (i32.and (call $is_number (local.get $a)) (call $is_number (local.get $b)))
(then
(if (call $rat_eq (local.get $a) (local.get $b))
(then (return (global.get $TRUE))))
(return (global.get $FALSE))))
(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)
(local $any_rat i32)
(local $any_rat2 i32)
(local $any_rat3 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))))))))
;; + — variadic; promotes to rational if any arg is rational.
(if (i32.eq (local.get $id) (i32.const 1))
(then
(local.set $sum (i32.const 0))
(local.set $a (call $make_fixnum (i32.const 0)))
(local.set $cur (local.get $args))
(local.set $any_rat (i32.const 0))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $b (call $car (local.get $cur)))
(if (i32.and (call $is_rational (local.get $b)) (i32.eqz (local.get $any_rat)))
(then
;; First rational encountered: lift the fixnum sum into a.
(local.set $a (call $make_fixnum (local.get $sum)))
(local.set $any_rat (i32.const 1))))
(if (local.get $any_rat)
(then (local.set $a (call $rat_add (local.get $a) (local.get $b))))
(else (local.set $sum (i32.add (local.get $sum) (call $fixnum_val (local.get $b))))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(if (local.get $any_rat)
(then (return (local.get $a))))
(return (call $make_fixnum (local.get $sum)))))
;; -
(if (i32.eq (local.get $id) (i32.const 2))
(then
;; Unary case: negate.
(if (i32.eq (call $cdr (local.get $args)) (global.get $NIL))
(then
(if (call $is_rational (local.get $a))
(then (return (call $make_rational
(i32.sub (i32.const 0) (call $rat_num (local.get $a)))
(call $rat_den (local.get $a))))))
(return (call $make_fixnum (i32.sub (i32.const 0) (call $fixnum_val (local.get $a)))))))
;; Variadic difference. Scan rest looking for any rational.
(local.set $any_rat2 (call $is_rational (local.get $a)))
(local.set $cur (call $cdr (local.get $args)))
(block $rscan
(loop $rl
(br_if $rscan (i32.eq (local.get $cur) (global.get $NIL)))
(if (call $is_rational (call $car (local.get $cur)))
(then (local.set $any_rat2 (i32.const 1))))
(local.set $cur (call $cdr (local.get $cur)))
(br $rl)))
(if (local.get $any_rat2)
(then
(local.set $cur (call $cdr (local.get $args)))
(block $rdone
(loop $rsub
(br_if $rdone (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $a (call $rat_sub (local.get $a) (call $car (local.get $cur))))
(local.set $cur (call $cdr (local.get $cur)))
(br $rsub)))
(return (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 $a (call $make_fixnum (i32.const 1)))
(local.set $cur (local.get $args))
(local.set $any_rat3 (i32.const 0))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $b (call $car (local.get $cur)))
(if (i32.and (call $is_rational (local.get $b)) (i32.eqz (local.get $any_rat3)))
(then
(local.set $a (call $make_fixnum (local.get $sum)))
(local.set $any_rat3 (i32.const 1))))
(if (local.get $any_rat3)
(then (local.set $a (call $rat_mul (local.get $a) (local.get $b))))
(else (local.set $sum (i32.mul (local.get $sum) (call $fixnum_val (local.get $b))))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(if (local.get $any_rat3)
(then (return (local.get $a))))
(return (call $make_fixnum (local.get $sum)))))
;; / — promotes int/int to rational when the result isn't integral
;; (matches python lumbda and the C tier's recent fix).
(if (i32.eq (local.get $id) (i32.const 4))
(then
(if (i32.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then (return (call $rat_div (local.get $a) (local.get $b)))))
(return (call $make_rational (call $fixnum_val (local.get $a))
(call $fixnum_val (local.get $b))))))
;; =
(if (i32.eq (local.get $id) (i32.const 5))
(then
(if (i32.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then
(if (call $rat_eq (local.get $a) (local.get $b))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
(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.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then
(if (call $rat_lt (local.get $a) (local.get $b))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
(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.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then
(if (call $rat_lt (local.get $b) (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
(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.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then
(if (i32.or (call $rat_lt (local.get $a) (local.get $b))
(call $rat_eq (local.get $a) (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
(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.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then
(if (i32.or (call $rat_lt (local.get $b) (local.get $a))
(call $rat_eq (local.get $a) (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
(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 — R7RS: result has the sign of the divisor.
;; i32.rem_s by itself gives remainder semantics (sign of dividend);
;; we add the divisor if the rem and divisor disagree on sign.
(if (i32.eq (local.get $id) (i32.const 23))
(then
(local.set $sum (i32.rem_s (call $fixnum_val (local.get $a))
(call $fixnum_val (local.get $b))))
(if (i32.and
(i32.ne (local.get $sum) (i32.const 0))
(i32.lt_s (i32.mul (local.get $sum) (call $fixnum_val (local.get $b)))
(i32.const 0)))
(then (local.set $sum (i32.add (local.get $sum) (call $fixnum_val (local.get $b))))))
(return (call $make_fixnum (local.get $sum)))))
;; 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) — fixnum or rational
(if (i32.eq (local.get $id) (i32.const 38))
(then
(if (call $is_number (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; integer? (39) — fixnum only (a normalized rational with den=1
;; collapses to fixnum, so this implicitly handles 14/2 → 7).
(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