commit 60313fcd116e77f3f0016bb3cafe27c8c5c9cdb9
parent cf5f560c7bb3255588cc29a42027e9c9b4bfaa05
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sat, 25 Apr 2026 06:48:39 -0700
Add scheme1 lambda, closures, and alist environments
eval's ::sym path now walks an alist env -- ((sym . val) . rest) -- and
falls through to sym_global only on a NIL chain, so lambda parameters
resolve before global bindings. The new `lambda` special form allocates
a 32-byte CLOSURE [hdr][params][body][env] and captures the current
env pointer directly (no free-var analysis). apply gains an
HDR.CLOSURE arm that spills body, runs bind_params to prepend
(param . arg) pairs onto the captured env, and tail-jumps eval_body.
eval_body evaluates body forms left-to-right with the final form in
tail position, so closure-tail-calls inherit the %tail invariant.
bind_params is fixed-arity only; the `.`-tail variadic case is a
follow-up. Tests cover single-param, multi-param env-walk, and a
nested closure that captures the outer binding.
Diffstat:
7 files changed, 173 insertions(+), 2 deletions(-)
diff --git a/scheme1/scheme1.P1pp b/scheme1/scheme1.P1pp
@@ -47,6 +47,7 @@
%struct PAIR { car cdr } # .SIZE = 16
%struct SYMENT { name_ptr name_len global_val pad } # .SIZE = 32
%struct PRIM { hdr entry_w } # .SIZE = 16
+%struct CLOSURE { hdr params body env } # .SIZE = 32
# BSS arena offsets from :ELF_end. Each arena is 64 KiB; the three are
# packed back-to-back below ELF_end + 192 KiB. p1_main's startup loop
@@ -633,6 +634,23 @@
%eret
::sym
+ # Walk the env alist. Each cell is ((sym . val) . rest). On hit,
+ # return cdr(binding); on NIL, fall back to the symbol's global slot.
+ # a0 still holds the tagged sym; a1 still holds env.
+ ::env_walk
+ %li(t0, %imm_val(%IMM.NIL))
+ %beq(a1, t0, &::env_miss)
+ %car(t1, a1) ; t1 = (sym . val)
+ %car(t2, t1) ; t2 = sym in binding
+ %beq(t2, a0, &::env_hit)
+ %cdr(a1, a1)
+ %b(&::env_walk)
+
+ ::env_hit
+ %cdr(a0, t1)
+ %eret
+
+ ::env_miss
%untag_sym(a0, a0)
%call(&sym_global)
%li(t0, %imm_val(%IMM.UNBOUND))
@@ -651,6 +669,9 @@
%la(t1, &sym_if)
%ld(t1, t1, 0)
%beq(t0, t1, &::do_if)
+ %la(t1, &sym_lambda)
+ %ld(t1, t1, 0)
+ %beq(t0, t1, &::do_lambda)
# head = eval(car(expr), env)
%ld(a0, sp, 0)
@@ -675,6 +696,12 @@
%cdr(a0, a0)
%ld(a1, sp, 8)
%tail(&eval_if)
+
+ ::do_lambda
+ %ld(a0, sp, 0)
+ %cdr(a0, a0)
+ %ld(a1, sp, 8)
+ %tail(&eval_lambda)
})
# eval_args(args=a0, env=a1) -> evaluated args list (cons-built).
@@ -711,11 +738,11 @@
#
# Frame: 16 bytes
# +0 args
+# +8 body (saved across bind_params for the closure path)
%fn(apply, 16, {
%st(a1, sp, 0)
- # Only HEAP-tagged values can be applicable. PRIM is the only header
- # type wired up here.
+ # Only HEAP-tagged values can be applicable.
%tagof(t0, a0)
%li(t1, %TAG.HEAP)
%bne(t0, t1, &::not_proc)
@@ -723,6 +750,8 @@
%hdr_type(t0, a0)
%li(t1, %HDR.PRIM)
%beq(t0, t1, &::prim)
+ %li(t1, %HDR.CLOSURE)
+ %beq(t0, t1, &::closure)
::not_proc
%die(msg_not_proc, 8)
@@ -731,6 +760,24 @@
%ld(t0, a0, 5) ; t0 = entry word (offset = -3 + 8)
%ld(a0, sp, 0) ; args list -> a0
%tailr(t0)
+
+ ::closure
+ # Closure layout (HEAP-tagged): [hdr][params][body][env]
+ # field offsets from tagged ptr: params=5, body=13, env=21.
+ %ld(t1, a0, 13) ; body (must survive bind_params)
+ %st(t1, sp, 8)
+ %ld(t2, a0, 21) ; captured env
+ %ld(t0, a0, 5) ; params
+
+ %mov(a0, t0) ; bind_params(params, args, env)
+ %ld(a1, sp, 0)
+ %mov(a2, t2)
+ %call(&bind_params)
+
+ # eval_body(body, new_env) -- tail call
+ %mov(a1, a0)
+ %ld(a0, sp, 8)
+ %tail(&eval_body)
})
# =========================================================================
@@ -749,6 +796,12 @@
%call(&intern)
%la(t0, &sym_if)
%st(a0, t0, 0)
+
+ %la(a0, &name_lambda)
+ %li(a1, 6)
+ %call(&intern)
+ %la(t0, &sym_lambda)
+ %st(a0, t0, 0)
})
# eval_if(rest=a0, env=a1) -> value (a0). `rest` is (test then else).
@@ -785,6 +838,116 @@
%tail(&eval)
})
+# eval_lambda(rest=a0, env=a1) -> closure (a0).
+# rest is (params . body). Allocates a 32-byte CLOSURE on the heap
+# and stores params, body, and the captured env directly.
+#
+# Frame: 24 bytes
+# +0 rest
+# +8 env
+# +16 closure ptr (HEAP-tagged)
+%fn(eval_lambda, 24, {
+ %st(a0, sp, 0)
+ %st(a1, sp, 8)
+
+ %li(a0, 32)
+ %li(a1, %HDR.CLOSURE)
+ %call(&alloc_hdr)
+ %st(a0, sp, 16)
+
+ # closure[params] = car(rest)
+ %ld(t0, sp, 0)
+ %car(t1, t0)
+ %ld(t0, sp, 16)
+ %st(t1, t0, 5)
+
+ # closure[body] = cdr(rest)
+ %ld(t1, sp, 0)
+ %cdr(t1, t1)
+ %st(t1, t0, 13)
+
+ # closure[env] = captured env
+ %ld(t1, sp, 8)
+ %st(t1, t0, 21)
+
+ %ld(a0, sp, 16)
+})
+
+# bind_params(params=a0, args=a1, env=a2) -> extended env (a0).
+# Walks params and args in lockstep, prepending (param . arg) to env.
+# Fixed-arity only for now; variadic `.`-tail is a follow-up.
+#
+# Frame: 24 bytes
+# +0 params (advanced each iteration)
+# +8 args (advanced each iteration)
+# +16 env (extended each iteration)
+%fn(bind_params, 24, {
+ %st(a0, sp, 0)
+ %st(a1, sp, 8)
+ %st(a2, sp, 16)
+
+ ::loop
+ %ld(t0, sp, 0)
+ %li(t1, %imm_val(%IMM.NIL))
+ %beq(t0, t1, &::done)
+
+ # binding = cons(car(params), car(args))
+ %ld(t0, sp, 0)
+ %car(a0, t0)
+ %ld(t0, sp, 8)
+ %car(a1, t0)
+ %call(&cons)
+
+ # env = cons(binding, env)
+ %ld(a1, sp, 16)
+ %call(&cons)
+ %st(a0, sp, 16)
+
+ # advance params and args
+ %ld(t0, sp, 0)
+ %cdr(t0, t0)
+ %st(t0, sp, 0)
+ %ld(t0, sp, 8)
+ %cdr(t0, t0)
+ %st(t0, sp, 8)
+ %b(&::loop)
+
+ ::done
+ %ld(a0, sp, 16)
+})
+
+# eval_body(body=a0, env=a1) -> value of last form (a0).
+# Evaluates each non-last form for effect; tail-evaluates the last so
+# that closures used in tail position do not grow the host stack.
+#
+# Frame: 16 bytes
+# +0 body
+# +8 env
+%fn(eval_body, 16, {
+ ::loop
+ %st(a0, sp, 0)
+ %st(a1, sp, 8)
+
+ # If cdr(body) is NIL, body's car is the last form.
+ %cdr(t0, a0)
+ %li(t1, %imm_val(%IMM.NIL))
+ %beq(t0, t1, &::last)
+
+ # Non-last form: eval and discard, advance.
+ %car(a0, a0)
+ %call(&eval)
+ %ld(a0, sp, 0)
+ %cdr(a0, a0)
+ %ld(a1, sp, 8)
+ %b(&::loop)
+
+ ::last
+ %ld(a0, sp, 0)
+ %car(a0, a0)
+ %ld(a1, sp, 8)
+ %tail(&eval)
+})
+
# =========================================================================
# Primitives
# =========================================================================
@@ -839,6 +1002,7 @@
# because intern takes (ptr, len). Aligned padding via "\0" bytes is
# fine -- M0 emits ASCII verbatim.
:name_if "if"
+:name_lambda "lambda"
:name_sys_exit "sys-exit"
:msg_usage "scheme1: usage: scheme1 SOURCE.scm" '0a' '00'
@@ -880,6 +1044,7 @@
# Cached tagged-symbol values for special forms (filled by
# intern_special_forms at startup).
:sym_if $(0)
+:sym_lambda $(0)
# Pointer slots for the past-:ELF_end arenas.
:readbuf_buf_ptr $(0)
diff --git a/tests/scheme1/03-lambda-call.expected-exit b/tests/scheme1/03-lambda-call.expected-exit
@@ -0,0 +1 @@
+42
diff --git a/tests/scheme1/03-lambda-call.scm b/tests/scheme1/03-lambda-call.scm
@@ -0,0 +1 @@
+((lambda (x) (sys-exit x)) 42)
diff --git a/tests/scheme1/04-lambda-multi.expected-exit b/tests/scheme1/04-lambda-multi.expected-exit
@@ -0,0 +1 @@
+42
diff --git a/tests/scheme1/04-lambda-multi.scm b/tests/scheme1/04-lambda-multi.scm
@@ -0,0 +1 @@
+((lambda (a b) (sys-exit b)) 1 42)
diff --git a/tests/scheme1/05-lambda-capture.expected-exit b/tests/scheme1/05-lambda-capture.expected-exit
@@ -0,0 +1 @@
+42
diff --git a/tests/scheme1/05-lambda-capture.scm b/tests/scheme1/05-lambda-capture.scm
@@ -0,0 +1 @@
+((lambda (x) ((lambda (y) (sys-exit x)) 99)) 42)
