commit ced3120781606b6d585f0df7557e18e3ca789d8f
parent 2f405ec325e240ba84f9da532deac96ae709b572
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sat, 25 Apr 2026 16:57:57 -0700
scheme1: forbid internal define; eval_body rejects with clear error
Internal `define` (inside any lambda/let/letrec/cond-clause/begin body)
is cut from the language -- letrec covers every valid use case, and the
ban keeps eval_body to a single walk. Top-level define is unchanged.
Detection lives in eval_body, the chokepoint for every internal body
context. One tagof + one symbol compare per form catches every case
including 0-arg lambda calls (which would otherwise have env=NIL and
look indistinguishable from top-level).
Diffstat:
5 files changed, 40 insertions(+), 5 deletions(-)
diff --git a/docs/LISP.md b/docs/LISP.md
@@ -56,10 +56,11 @@ continuations, multiple values, exceptions.
- `(define name value)` and `(define (name arg ...) body ...)`, including
variadic tails: `(define (f . rest) …)` and `(define (f a b . rest) …)`.
- Top-level `define`s may forward-reference each other — mutual
- recursion at module scope is supported. Inside a `lambda`/`let`
- body, `define`s behave like `letrec*` (sequential, visible to
- later forms).
+ **Top-level only.** Top-level `define`s may forward-reference each
+ other — mutual recursion at module scope is supported. Internal
+ `define` (inside a `lambda`/`let`/`begin` body) is **not** in the
+ language — use `letrec` instead. Cut to keep the body interpreter
+ one walk.
- `(lambda (arg ...) body ...)` with the same `.`-tail syntax.
A `lambda` evaluates to a closure: a first-class procedure value that
captures its enclosing lexical environment by reference. `set!` on a
@@ -197,6 +198,7 @@ Kept explicit so additions are deliberate.
| `define-library`, `import`, `export` | files are files for v1 |
| `include`, `cond-expand` | — |
| `case-lambda` | no arity overloading |
+| Internal `define` (in lambda/let/begin) | use `letrec`; keeps the body interpreter one walk |
| `#o…` `#b…` `#;` `#\| \|#` | keeps the lexer small (`#\…` is kept) |
| `eqv?` | `eq?` + `equal?` are enough |
diff --git a/scheme1/scheme1.P1pp b/scheme1/scheme1.P1pp
@@ -1736,7 +1736,9 @@
# (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.
+# Internal `define` is rejected by eval_body before this entry is reached
+# (every internal body context routes through eval_body); see the check
+# at the head of eval_body's loop.
#
# Frame: 16 bytes
# +0 rest
@@ -2376,6 +2378,11 @@
# Evaluates each non-last form for effect; tail-evaluates the last so
# that closures used in tail position do not grow the host stack.
#
+# Internal `define` is rejected here (this is the single chokepoint for
+# every body context: closure body via apply, let / letrec / named-let
+# bodies, cond clause bodies, begin's body). Per-form check is one
+# tagof + one symbol compare, regardless of body length.
+#
# Frame: 16 bytes
# +0 body
# +8 env
@@ -2384,12 +2391,26 @@
%st(a0, sp, 0)
%st(a1, sp, 8)
+ # Reject internal `define`. Detect (define ...) at the head of any
+ # form before dispatching it to eval.
+ %car(t0, a0) ; form
+ %tagof(t1, t0)
+ %li(t2, %TAG.PAIR)
+ %bne(t1, t2, &::not_define)
+ %car(t1, t0) ; head sym
+ %la(t2, &sym_define)
+ %ld(t2, t2, 0)
+ %beq(t1, t2, &::internal_define)
+
+ ::not_define
# If cdr(body) is NIL, body's car is the last form.
+ %ld(a0, sp, 0)
%cdr(t0, a0)
%if_nil(t1, t0, &::last)
# Non-last form: eval and discard, advance.
%car(a0, a0)
+ %ld(a1, sp, 8)
%call(&eval)
%ld(a0, sp, 0)
%cdr(a0, a0)
@@ -2401,6 +2422,9 @@
%car(a0, a0)
%ld(a1, sp, 8)
%tail(&eval)
+
+ ::internal_define
+ %die(msg_internal_define)
})
# =========================================================================
@@ -4818,6 +4842,7 @@
:msg_bad_char "scheme1: bad #\\ character literal" '0a' '00'
:msg_bad_number "scheme1: bad number literal" '0a' '00'
:msg_bad_ident "scheme1: bad identifier" '0a' '00'
+:msg_internal_define "scheme1: internal define is not supported (use letrec)" '0a' '00'
:name_ch_tab "tab"
:name_ch_null "null"
diff --git a/tests/scheme1/85-internal-define-error.expected b/tests/scheme1/85-internal-define-error.expected
@@ -0,0 +1 @@
+scheme1: internal define is not supported (use letrec)
diff --git a/tests/scheme1/85-internal-define-error.expected-exit b/tests/scheme1/85-internal-define-error.expected-exit
@@ -0,0 +1 @@
+1
diff --git a/tests/scheme1/85-internal-define-error.scm b/tests/scheme1/85-internal-define-error.scm
@@ -0,0 +1,6 @@
+; Internal `define` -- inside any non-empty lexical env (lambda body,
+; let body, letrec body) -- is forbidden in this Scheme. eval_define
+; rejects with a clear message and exits 1 via runtime_error. Use
+; letrec for local recursive bindings.
+((lambda () (define x 1) x))
+(sys-exit 0)
