engineering/lumbda
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

wat iter-1: special forms + 35 primitives toward asm/lumbda.s parity

Browse source 
Special forms added:
  let*, letrec, when, unless, case, named-let

Primitives added (IDs 25-60):
  quotient, remainder, min, max, expt
  even?, odd?, positive?, negative?
  set-car!, set-cdr!, equal?, eqv?
  number?, integer?, symbol?, string?, procedure?, boolean?
  caar, cadr, cdar, cddr, caddr, cadddr
  reverse, append, apply, error
  member, memq, assoc, assq
  list-ref, list-tail, void

Plus helpers: equal_p (deep structural), append2, member_eq, assoc_eq.

39/39 wasm tests pass (20 unit + 8 integration + 11 functional).
Footer language softened — no more "minimal subset" disclaimer.
This commit is contained in:
russell@unturf.com 2026-06-14 12:30:01 -04:00
parent 1b7de2c9c6
commit 73dc042ea8
No known key found for this signature in database
5 changed files with 716 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

10
wasm/app/index.html
View file

@ -71,11 +71,11 @@
<footer>
<p>
<strong>asm tier note:</strong> the wat implementation ships a minimal lisp
subset (special forms, arithmetic, list ops, recursion) &mdash; enough for the
four demos above. symbol lookup is linear; would be moad-0001 at scale,
documented in <code>asm/lumbda.wat</code>.
see <a href="../">lumbda.</a>
same lisp source, three implementations &mdash; verify yourself by
eyeballing each tier's output, or by running
<code>make wasm-test</code> against the cross-tier suite.
asm tier (<code>asm/lumbda.wat</code>) is growing toward feature parity
with <code>asm/lumbda.s</code>; see <a href="../">lumbda.</a>
</p>
</footer>

60
wasm/app/repl.html Normal file
View file

@ -0,0 +1,60 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<title>lumbda repl — three tiers, one prompt</title>
<link rel="stylesheet" href="style.css">
<link rel="stylesheet" href="repl.css">
</head>
<body class="repl">
<header>
<a class="brand" href="../" aria-label="lumbda home">
<img class="logo" src="lumbda-logo-green.png" alt="" aria-hidden="true">
<h1 aria-label="lumbda.">lumbda<span class="period" aria-hidden="true">.</span></h1>
</a>
<p class="tagline">three tiers, one prompt</p>
<p class="lede">
interactive repl. type a lisp expression at the prompt below; each tier
keeps its own persistent state across evals. compare side by side,
measure tier-by-tier elapsed, share a link to the
<a href="../playground/">playground</a> for static demos.
</p>
</header>
<section class="repl-controls">
<fieldset class="tier">
<legend>send to</legend>
<label><input type="radio" name="tier" value="python"> python</label>
<label><input type="radio" name="tier" value="c"> c</label>
<label><input type="radio" name="tier" value="asm"> asm</label>
<label><input type="radio" name="tier" value="all" checked> all three</label>
</fieldset>
<button id="reset" class="secondary" title="clear tier state — next eval reboots each tier from scratch">reset state</button>
<button id="clear" class="secondary" title="clear the transcript">clear log</button>
<button id="cancel" class="secondary" disabled>cancel</button>
<span id="status" class="status"></span>
</section>
<main class="transcript-wrap">
<div id="transcript" class="transcript"></div>
</main>
<section class="prompt-bar">
<span class="prompt-sigil">λ&gt;</span>
<textarea id="input" rows="1" spellcheck="false"
placeholder="(+ 1 2) — enter to send, shift-enter for newline"></textarea>
<button id="send" class="primary">send</button>
</section>
<footer>
<p>
<strong>note:</strong> tier state is persistent within a session — defines stick
across evals. cancel terminates the worker; on the next send each tier
reboots from scratch. <a href="../">lumbda.</a>
</p>
</footer>
<script type="module" src="repl.js"></script>
</body>
</html>

649
wasm/asm/lumbda.wat
View file

@ -61,6 +61,12 @@
(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))
;; Constants (immediate value addresses)
(global $NIL i32 (i32.const 4))
@ -689,6 +695,21 @@
(if (i32.eq (local.get $head) (global.get $sym_or))
(then (return (call $eval_or (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_letstar))
(then (return (call $eval_letstar (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_letrec))
(then (return (call $eval_letrec (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_when))
(then (return (call $eval_when (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_unless))
(then (return (call $eval_unless (local.get $rest) (local.get $env)))))
(if (i32.eq (local.get $head) (global.get $sym_case))
(then (return (call $eval_case (local.get $rest) (local.get $env)))))
;; Function application
(return (call $apply
(call $eval (local.get $head) (local.get $env))
@ -752,8 +773,99 @@
(br $loop)))
(global.get $VOID))
;; (let ((x e) ...) body) — non-recursive form
;; (let ((x e) ...) body) — non-recursive form (also supports named let)
;; Named let: (let name ((x e) ...) body) -> a self-referential procedure.
(func $eval_let (param $rest i32) (param $env i32) (result i32)
(local $first i32)
(local $bindings i32)
(local $body i32)
(local $new_env i32)
(local $b i32)
(local $sym i32)
(local $val i32)
(local $name i32)
(local $params i32)
(local $args i32)
(local $closure i32)
(local.set $first (call $car (local.get $rest)))
;; Named let if first arg is a symbol.
(if (call $is_symbol (local.get $first))
(then
(local.set $name (local.get $first))
(local.set $bindings (call $car (call $cdr (local.get $rest))))
(local.set $body (call $cdr (call $cdr (local.get $rest))))
;; Build params list (the binding names) and args list (their inits).
(local.set $params (call $extract_let_params (local.get $bindings)))
(local.set $args (call $extract_let_inits (local.get $bindings) (local.get $env)))
;; Create closure capturing CURRENT env (so the body can refer to name).
(local.set $closure (call $make_closure (local.get $params) (local.get $body) (local.get $env)))
;; Bind the closure to name in a fresh local env and patch its env to include itself.
(local.set $new_env (call $env_define (local.get $env) (local.get $name) (local.get $closure)))
;; Patch closure.env to the new env so name resolves to it.
(i32.store offset=12 (local.get $closure) (local.get $new_env))
(return (call $apply (local.get $closure) (local.get $args)))))
(local.set $bindings (local.get $first))
(local.set $body (call $cdr (local.get $rest)))
(local.set $new_env (local.get $env))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $bindings) (global.get $NIL)))
(local.set $b (call $car (local.get $bindings)))
(local.set $sym (call $car (local.get $b)))
(local.set $val (call $eval (call $car (call $cdr (local.get $b))) (local.get $env)))
(local.set $new_env (call $env_define (local.get $new_env) (local.get $sym) (local.get $val)))
(local.set $bindings (call $cdr (local.get $bindings)))
(br $loop)))
(call $eval_begin (local.get $body) (local.get $new_env)))
;; Helper: build params list from let bindings (a list of (sym init)).
(func $extract_let_params (param $bindings i32) (result i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(block $done
(loop $l
(br_if $done (i32.eq (local.get $bindings) (global.get $NIL)))
(local.set $new
(call $make_pair
(call $car (call $car (local.get $bindings)))
(global.get $NIL)))
(if (i32.eq (local.get $head) (global.get $NIL))
(then (local.set $head (local.get $new))
(local.set $tail (local.get $new)))
(else (call $set_cdr (local.get $tail) (local.get $new))
(local.set $tail (local.get $new))))
(local.set $bindings (call $cdr (local.get $bindings)))
(br $l)))
(local.get $head))
;; Helper: evaluate each init expression and return the resulting list.
(func $extract_let_inits (param $bindings i32) (param $env i32) (result i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(block $done
(loop $l
(br_if $done (i32.eq (local.get $bindings) (global.get $NIL)))
(local.set $new
(call $make_pair
(call $eval (call $car (call $cdr (call $car (local.get $bindings)))) (local.get $env))
(global.get $NIL)))
(if (i32.eq (local.get $head) (global.get $NIL))
(then (local.set $head (local.get $new))
(local.set $tail (local.get $new)))
(else (call $set_cdr (local.get $tail) (local.get $new))
(local.set $tail (local.get $new))))
(local.set $bindings (call $cdr (local.get $bindings)))
(br $l)))
(local.get $head))
;; (let* ((x e1) (y e2)) body) — each binding sees previous bindings.
(func $eval_letstar (param $rest i32) (param $env i32) (result i32)
(local $bindings i32)
(local $body i32)
(local $new_env i32)
@ -768,12 +880,94 @@
(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 $val (call $eval (call $car (call $cdr (local.get $b))) (local.get $new_env)))
(local.set $new_env (call $env_define (local.get $new_env) (local.get $sym) (local.get $val)))
(local.set $bindings (call $cdr (local.get $bindings)))
(br $loop)))
(call $eval_begin (local.get $body) (local.get $new_env)))
;; (letrec ((f (lambda ...))) body) — each binding visible to all others.
;; First create the env with placeholder bindings, then evaluate inits in
;; the new env (so lambdas capture it), then patch values.
(func $eval_letrec (param $rest i32) (param $env i32) (result i32)
(local $bindings i32)
(local $body i32)
(local $new_env i32)
(local $b i32)
(local $sym i32)
(local $val i32)
(local $cur i32)
(local $bind i32)
(local.set $bindings (call $car (local.get $rest)))
(local.set $body (call $cdr (local.get $rest)))
(local.set $new_env (local.get $env))
(local.set $cur (local.get $bindings))
;; Pass 1: bind every name to VOID in the new env.
(block $done1
(loop $l1
(br_if $done1 (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $b (call $car (local.get $cur)))
(local.set $sym (call $car (local.get $b)))
(local.set $new_env (call $env_define (local.get $new_env) (local.get $sym) (global.get $VOID)))
(local.set $cur (call $cdr (local.get $cur)))
(br $l1)))
;; Pass 2: evaluate each init in new_env (so lambdas see each other),
;; mutate the binding pair's cdr to the real value.
(local.set $cur (local.get $bindings))
(block $done2
(loop $l2
(br_if $done2 (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $b (call $car (local.get $cur)))
(local.set $sym (call $car (local.get $b)))
(local.set $val (call $eval (call $car (call $cdr (local.get $b))) (local.get $new_env)))
(call $env_set (local.get $new_env) (local.get $sym) (local.get $val))
(local.set $cur (call $cdr (local.get $cur)))
(br $l2)))
(call $eval_begin (local.get $body) (local.get $new_env)))
;; (when test body...) -> if test true, eval body, else void
(func $eval_when (param $rest i32) (param $env i32) (result i32)
(if (i32.ne (call $eval (call $car (local.get $rest)) (local.get $env)) (global.get $FALSE))
(then (return (call $eval_begin (call $cdr (local.get $rest)) (local.get $env)))))
(global.get $VOID))
;; (unless test body...) -> if test false, eval body, else void
(func $eval_unless (param $rest i32) (param $env i32) (result i32)
(if (i32.eq (call $eval (call $car (local.get $rest)) (local.get $env)) (global.get $FALSE))
(then (return (call $eval_begin (call $cdr (local.get $rest)) (local.get $env)))))
(global.get $VOID))
;; (case key ((1 2) "small") ((3 4) "med") (else "big"))
;; Each clause: (datum-list body) where datum-list is either a list of
;; literals to match via eqv?, or the symbol `else`.
(func $eval_case (param $rest i32) (param $env i32) (result i32)
(local $key i32)
(local $clauses i32)
(local $clause i32)
(local $data i32)
(local $body i32)
(local.set $key (call $eval (call $car (local.get $rest)) (local.get $env)))
(local.set $clauses (call $cdr (local.get $rest)))
(block $done
(loop $l
(br_if $done (i32.eq (local.get $clauses) (global.get $NIL)))
(local.set $clause (call $car (local.get $clauses)))
(local.set $data (call $car (local.get $clause)))
(local.set $body (call $cdr (local.get $clause)))
(if (i32.eq (local.get $data) (global.get $sym_else))
(then (return (call $eval_begin (local.get $body) (local.get $env)))))
;; data is a list of literal values; match via eqv?
(block $clausedone
(loop $datal
(br_if $clausedone (i32.eq (local.get $data) (global.get $NIL)))
(if (i32.eq (call $car (local.get $data)) (local.get $key))
(then (return (call $eval_begin (local.get $body) (local.get $env)))))
(local.set $data (call $cdr (local.get $data)))
(br $datal)))
(local.set $clauses (call $cdr (local.get $clauses)))
(br $l)))
(global.get $VOID))
(func $eval_and (param $rest i32) (param $env i32) (result i32)
(local $val i32)
(local.set $val (global.get $TRUE))
@ -865,12 +1059,128 @@
(br $loop)))
(local.get $new))
;; ─── Equality helpers ──────────────────────────────────────────
;; Deep structural equality. Returns TRUE/FALSE immediate.
(func $equal_p (param $a i32) (param $b i32) (result i32)
(local $alen i32)
(local $blen i32)
(local $i i32)
(if (i32.eq (local.get $a) (local.get $b))
(then (return (global.get $TRUE))))
(if (call $is_pair (local.get $a))
(then
(if (i32.eqz (call $is_pair (local.get $b)))
(then (return (global.get $FALSE))))
(if (i32.eq (call $equal_p (call $car (local.get $a)) (call $car (local.get $b))) (global.get $FALSE))
(then (return (global.get $FALSE))))
(return (call $equal_p (call $cdr (local.get $a)) (call $cdr (local.get $b))))))
(if (call $is_string (local.get $a))
(then
(if (i32.eqz (call $is_string (local.get $b)))
(then (return (global.get $FALSE))))
(local.set $alen (i32.load offset=4 (local.get $a)))
(local.set $blen (i32.load offset=4 (local.get $b)))
(if (i32.ne (local.get $alen) (local.get $blen))
(then (return (global.get $FALSE))))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $alen)))
(if (i32.ne
(i32.load8_u (i32.add (i32.add (local.get $a) (i32.const 8)) (local.get $i)))
(i32.load8_u (i32.add (i32.add (local.get $b) (i32.const 8)) (local.get $i))))
(then (return (global.get $FALSE))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(return (global.get $TRUE))))
;; 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))
;; ─── Primitives ────────────────────────────────────────────────
(func $apply_primitive (param $id i32) (param $args i32) (result i32)
(local $a i32)
(local $b i32)
(local $sum i32)
(local $cur i32)
(local $vmin i32)
(local $vmax i32)
(local $base i32)
(local $exp_n i32)
(local $result i32)
(local $rev i32)
(local $idx i32)
(local $idxt i32)
;; Fetch first 2 args (most prims use 1 or 2). Defaults to fixnum 0.
(local.set $a (call $make_fixnum (i32.const 0)))
@ -1059,6 +1369,255 @@
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; quotient (25): integer truncating division
(if (i32.eq (local.get $id) (i32.const 25))
(then
(return (call $make_fixnum (i32.div_s (call $fixnum_val (local.get $a))
(call $fixnum_val (local.get $b)))))))
;; remainder (26): integer remainder (sign of dividend)
(if (i32.eq (local.get $id) (i32.const 26))
(then
(return (call $make_fixnum (i32.rem_s (call $fixnum_val (local.get $a))
(call $fixnum_val (local.get $b)))))))
;; min (27): variadic
(if (i32.eq (local.get $id) (i32.const 27))
(then
(local.set $sum (call $fixnum_val (local.get $a)))
(local.set $cur (call $cdr (local.get $args)))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $vmin (call $fixnum_val (call $car (local.get $cur))))
(if (i32.lt_s (local.get $vmin) (local.get $sum))
(then (local.set $sum (local.get $vmin))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(return (call $make_fixnum (local.get $sum)))))
;; max (28): variadic
(if (i32.eq (local.get $id) (i32.const 28))
(then
(local.set $sum (call $fixnum_val (local.get $a)))
(local.set $cur (call $cdr (local.get $args)))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $vmax (call $fixnum_val (call $car (local.get $cur))))
(if (i32.gt_s (local.get $vmax) (local.get $sum))
(then (local.set $sum (local.get $vmax))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(return (call $make_fixnum (local.get $sum)))))
;; expt (29): integer exponent (positive)
(if (i32.eq (local.get $id) (i32.const 29))
(then
(local.set $base (call $fixnum_val (local.get $a)))
(local.set $exp_n (call $fixnum_val (local.get $b)))
(local.set $result (i32.const 1))
(block $done
(loop $loop
(br_if $done (i32.le_s (local.get $exp_n) (i32.const 0)))
(local.set $result (i32.mul (local.get $result) (local.get $base)))
(local.set $exp_n (i32.sub (local.get $exp_n) (i32.const 1)))
(br $loop)))
(return (call $make_fixnum (local.get $result)))))
;; even? (30)
(if (i32.eq (local.get $id) (i32.const 30))
(then
(if (i32.eqz (i32.and (call $fixnum_val (local.get $a)) (i32.const 1)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; odd? (31)
(if (i32.eq (local.get $id) (i32.const 31))
(then
(if (i32.and (call $fixnum_val (local.get $a)) (i32.const 1))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; positive? (32)
(if (i32.eq (local.get $id) (i32.const 32))
(then
(if (i32.gt_s (call $fixnum_val (local.get $a)) (i32.const 0))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; negative? (33)
(if (i32.eq (local.get $id) (i32.const 33))
(then
(if (i32.lt_s (call $fixnum_val (local.get $a)) (i32.const 0))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; set-car! (34)
(if (i32.eq (local.get $id) (i32.const 34))
(then
(call $set_car (local.get $a) (local.get $b))
(return (global.get $VOID))))
;; set-cdr! (35)
(if (i32.eq (local.get $id) (i32.const 35))
(then
(call $set_cdr (local.get $a) (local.get $b))
(return (global.get $VOID))))
;; equal? (36): deep structural equality
(if (i32.eq (local.get $id) (i32.const 36))
(then (return (call $equal_p (local.get $a) (local.get $b)))))
;; eqv? (37): identity for our value types
(if (i32.eq (local.get $id) (i32.const 37))
(then
(if (i32.eq (local.get $a) (local.get $b))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; number? (38) — fixnums only in this tier
(if (i32.eq (local.get $id) (i32.const 38))
(then
(if (call $is_fixnum (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; integer? (39) — same as number? here
(if (i32.eq (local.get $id) (i32.const 39))
(then
(if (call $is_fixnum (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; symbol? (40)
(if (i32.eq (local.get $id) (i32.const 40))
(then
(if (call $is_symbol (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; string? (41)
(if (i32.eq (local.get $id) (i32.const 41))
(then
(if (call $is_string (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; procedure? (42) — closure or primitive
(if (i32.eq (local.get $id) (i32.const 42))
(then
(if (i32.or (call $is_closure (local.get $a)) (call $is_primitive (local.get $a)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; boolean? (43)
(if (i32.eq (local.get $id) (i32.const 43))
(then
(if (i32.or (i32.eq (local.get $a) (global.get $TRUE))
(i32.eq (local.get $a) (global.get $FALSE)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; caar (44)
(if (i32.eq (local.get $id) (i32.const 44))
(then (return (call $car (call $car (local.get $a))))))
;; cadr (45)
(if (i32.eq (local.get $id) (i32.const 45))
(then (return (call $car (call $cdr (local.get $a))))))
;; cdar (46)
(if (i32.eq (local.get $id) (i32.const 46))
(then (return (call $cdr (call $car (local.get $a))))))
;; cddr (47)
(if (i32.eq (local.get $id) (i32.const 47))
(then (return (call $cdr (call $cdr (local.get $a))))))
;; caddr (48)
(if (i32.eq (local.get $id) (i32.const 48))
(then (return (call $car (call $cdr (call $cdr (local.get $a)))))))
;; cadddr (49)
(if (i32.eq (local.get $id) (i32.const 49))
(then (return (call $car (call $cdr (call $cdr (call $cdr (local.get $a))))))))
;; reverse (50)
(if (i32.eq (local.get $id) (i32.const 50))
(then
(local.set $rev (global.get $NIL))
(local.set $cur (local.get $a))
(block $done
(loop $loop
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $rev (call $make_pair (call $car (local.get $cur)) (local.get $rev)))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(return (local.get $rev))))
;; append (51) — 2-arg
(if (i32.eq (local.get $id) (i32.const 51))
(then (return (call $append2 (local.get $a) (local.get $b)))))
;; apply (52) — (apply f args)
(if (i32.eq (local.get $id) (i32.const 52))
(then (return (call $apply (local.get $a) (local.get $b)))))
;; error (53) — emit message + raise (we just write to output for now)
(if (i32.eq (local.get $id) (i32.const 53))
(then
(call $out_str (i32.const 0xF030) (i32.const 6)) ;; "<error" — reuse procedure msg
(call $print_value (local.get $a))
(call $out_char (i32.const 10))
(return (global.get $VOID))))
;; member (54) — equal?-based
(if (i32.eq (local.get $id) (i32.const 54))
(then (return (call $member_eq (local.get $a) (local.get $b) (i32.const 1)))))
;; memq (55) — eq?-based
(if (i32.eq (local.get $id) (i32.const 55))
(then (return (call $member_eq (local.get $a) (local.get $b) (i32.const 0)))))
;; assoc (56) — equal? on car
(if (i32.eq (local.get $id) (i32.const 56))
(then (return (call $assoc_eq (local.get $a) (local.get $b) (i32.const 1)))))
;; assq (57) — eq? on car
(if (i32.eq (local.get $id) (i32.const 57))
(then (return (call $assoc_eq (local.get $a) (local.get $b) (i32.const 0)))))
;; list-ref (58)
(if (i32.eq (local.get $id) (i32.const 58))
(then
(local.set $idx (call $fixnum_val (local.get $b)))
(local.set $cur (local.get $a))
(block $done
(loop $loop
(br_if $done (i32.le_s (local.get $idx) (i32.const 0)))
(local.set $cur (call $cdr (local.get $cur)))
(local.set $idx (i32.sub (local.get $idx) (i32.const 1)))
(br $loop)))
(return (call $car (local.get $cur)))))
;; list-tail (59)
(if (i32.eq (local.get $id) (i32.const 59))
(then
(local.set $idxt (call $fixnum_val (local.get $b)))
(local.set $cur (local.get $a))
(block $done
(loop $loop
(br_if $done (i32.le_s (local.get $idxt) (i32.const 0)))
(local.set $cur (call $cdr (local.get $cur)))
(local.set $idxt (i32.sub (local.get $idxt) (i32.const 1)))
(br $loop)))
(return (local.get $cur))))
;; void (60)
(if (i32.eq (local.get $id) (i32.const 60))
(then (return (global.get $VOID))))
(global.get $VOID))
;; ─── Init ──────────────────────────────────────────────────────
@ -1085,6 +1644,12 @@
(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) "+")
@ -1111,6 +1676,42 @@
(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")
(func $bind_prim (param $name_ptr i32) (param $name_len i32) (param $id i32)
(local $sym i32)
@ -1136,6 +1737,12 @@
(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)) ;; -
@ -1160,7 +1767,43 @@
(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 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
;; ─── Public eval entry ─────────────────────────────────────────
;; JS writes UTF-8 source into 0x20000 and calls lumbda_eval(len).

BIN
www/playground/asm/lumbda-asm.wasm
View file

Binary file not shown.

10
www/playground/index.html
View file

@ -71,11 +71,11 @@
<footer>
<p>
<strong>asm tier note:</strong> the wat implementation ships a minimal lisp
subset (special forms, arithmetic, list ops, recursion) &mdash; enough for the
four demos above. symbol lookup is linear; would be moad-0001 at scale,
documented in <code>asm/lumbda.wat</code>.
see <a href="../">lumbda.</a>
same lisp source, three implementations &mdash; verify yourself by
eyeballing each tier's output, or by running
<code>make wasm-test</code> against the cross-tier suite.
asm tier (<code>asm/lumbda.wat</code>) is growing toward feature parity
with <code>asm/lumbda.s</code>; see <a href="../">lumbda.</a>
</p>
</footer>