commit 37f3b7510b05967ff92516f2ba46c7e9a5d70bf1
parent 0da31f6ffbb178470961fc0de5a9cfe634c508e3
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sat, 25 Apr 2026 08:14:31 -0700
Add scheme1 top-level define and read-eval loop
p1_main now iterates skip_ws + parse_one + eval until EOF, so multi-form
scripts work. eval_define handles both `(define name value)` and the
`(define (f a b) body...)` lambda-sugar by building (params . body) and
delegating to eval_lambda. The new value or closure is stored in the
symbol's global slot via sym_set_global; the form returns UNSPEC.
Diffstat:
7 files changed, 101 insertions(+), 5 deletions(-)
diff --git a/scheme1/scheme1.P1pp b/scheme1/scheme1.P1pp
@@ -185,15 +185,21 @@
%ld(a0, a1, 8)
%call(&load_source)
- # parse_one returns one s-expression in a0.
+ # Top-level read-eval loop. Each iteration: skip ws+comments, stop
+ # at EOF, otherwise parse one form and eval it under NIL.
+ ::repl
+ %call(&skip_ws)
+ %la(t0, &readbuf_pos)
+ %ld(t0, t0, 0)
+ %la(t1, &readbuf_len)
+ %ld(t1, t1, 0)
+ %beq(t0, t1, &::done)
%call(&parse_one)
-
- # eval(expr, NIL).
%li(a1, %imm_val(%IMM.NIL))
%call(&eval)
+ %b(&::repl)
- # If the form did not sys-exit (e.g. evaluated to a fixnum), drop
- # cleanly with status 0. Useful while wiring up more of the runtime.
+ ::done
%li(a0, 0)
%eret
@@ -744,6 +750,9 @@
%la(t1, &sym_lambda)
%ld(t1, t1, 0)
%beq(t0, t1, &::do_lambda)
+ %la(t1, &sym_define)
+ %ld(t1, t1, 0)
+ %beq(t0, t1, &::do_define)
# head = eval(car(expr), env)
%ld(a0, sp, 0)
@@ -781,6 +790,12 @@
%cdr(a0, a0)
%ld(a1, sp, 8)
%tail(&eval_lambda)
+
+ ::do_define
+ %ld(a0, sp, 0)
+ %cdr(a0, a0)
+ %ld(a1, sp, 8)
+ %tail(&eval_define)
})
# eval_args(args=a0, env=a1) -> evaluated args list (cons-built).
@@ -887,6 +902,12 @@
%call(&intern)
%la(t0, &sym_lambda)
%st(a0, t0, 0)
+
+ %la(a0, &name_define)
+ %li(a1, 6)
+ %call(&intern)
+ %la(t0, &sym_define)
+ %st(a0, t0, 0)
})
# eval_if(rest=a0, env=a1) -> value (a0). `rest` is (test then else).
@@ -958,6 +979,63 @@
%ld(a0, sp, 16)
})
+# eval_define(rest=a0, env=a1) -> UNSPEC (a0).
+# Top-level only. Two surface forms:
+# (define <sym> <expr>) ; head of rest is a SYM
+# (define (<sym> . <params>) . body) ; head of rest is a PAIR; sugar for
+# (define <sym> (lambda <params> . body))
+# Inner `define` is the responsibility of eval_body and never reaches here.
+#
+# Frame: 16 bytes
+# +0 rest
+# +8 env
+%fn(eval_define, 16, {
+ %st(a0, sp, 0)
+ %st(a1, sp, 8)
+
+ # If car(rest) is a pair, this is the lambda-sugar form.
+ %car(t0, a0)
+ %tagof(t1, t0)
+ %li(t2, %TAG.PAIR)
+ %beq(t1, t2, &::sugar)
+
+ # Plain define: value = eval(car(cdr(rest)), env)
+ %ld(t0, sp, 0)
+ %cdr(a0, t0)
+ %car(a0, a0)
+ %ld(a1, sp, 8)
+ %call(&eval)
+
+ %ld(t0, sp, 0)
+ %car(t0, t0)
+ %untag_sym(t0, t0)
+ %mov(a1, a0)
+ %mov(a0, t0)
+ %call(&sym_set_global)
+ %li(a0, %imm_val(%IMM.UNSPEC))
+ %eret
+
+ ::sugar
+ # rest = ((name . params) . body); build (params . body) for eval_lambda.
+ %ld(t0, sp, 0)
+ %car(t0, t0)
+ %cdr(a0, t0) ; params
+ %ld(t0, sp, 0)
+ %cdr(a1, t0) ; body
+ %call(&cons)
+ %ld(a1, sp, 8)
+ %call(&eval_lambda)
+
+ %ld(t0, sp, 0)
+ %car(t0, t0)
+ %car(t0, t0) ; name
+ %untag_sym(t0, t0)
+ %mov(a1, a0)
+ %mov(a0, t0)
+ %call(&sym_set_global)
+ %li(a0, %imm_val(%IMM.UNSPEC))
+})
+
# 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.
@@ -1089,6 +1167,7 @@
:name_quote "quote"
:name_if "if"
:name_lambda "lambda"
+:name_define "define"
:name_sys_exit "sys-exit"
:msg_usage "scheme1: usage: scheme1 SOURCE.scm" '0a' '00'
@@ -1132,6 +1211,7 @@
:sym_quote $(0)
:sym_if $(0)
:sym_lambda $(0)
+:sym_define $(0)
# Pointer slots for the past-:ELF_end arenas.
:readbuf_buf_ptr $(0)
diff --git a/tests/scheme1/09-define-value.expected-exit b/tests/scheme1/09-define-value.expected-exit
@@ -0,0 +1 @@
+42
diff --git a/tests/scheme1/09-define-value.scm b/tests/scheme1/09-define-value.scm
@@ -0,0 +1,3 @@
+; Plain define: (define name value).
+(define x 42)
+(sys-exit x)
diff --git a/tests/scheme1/10-define-fn.expected-exit b/tests/scheme1/10-define-fn.expected-exit
@@ -0,0 +1 @@
+55
diff --git a/tests/scheme1/10-define-fn.scm b/tests/scheme1/10-define-fn.scm
@@ -0,0 +1,4 @@
+; define-fn sugar: (define (f x y) body).
+(define (id x) x)
+(define (k x y) x)
+(sys-exit (id (k 55 99)))
diff --git a/tests/scheme1/11-define-mutual.expected-exit b/tests/scheme1/11-define-mutual.expected-exit
@@ -0,0 +1 @@
+31
diff --git a/tests/scheme1/11-define-mutual.scm b/tests/scheme1/11-define-mutual.scm
@@ -0,0 +1,6 @@
+; Forward references at top level: `a` calls `b` defined later. Works
+; because env lookup falls through to symtab[idx].global_val at call
+; time, not closure-creation time.
+(define (a x) (b x))
+(define (b x) x)
+(sys-exit (a 31))
