From 84a416942895e4d03521328d5665bdb237b50500 Mon Sep 17 00:00:00 2001
From: Timothy Sample <samplet@ngyro.com>
Date: Thu, 31 Mar 2022 17:55:06 -0600
Subject: [PATCH] core: Fix internal define bug.

* src/eval-apply.c (eval_apply): When evaluating 'define', recompute
the 'global_p' and 'local_p' flags; when evaluating a local
definition, set the closure directly instead of using 'set_x'.
* tests/base.test: Add a test.
---
 src/eval-apply.c | 15 ++++++++++++++-
 tests/base.test  | 11 +++++++++++
 2 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/src/eval-apply.c b/src/eval-apply.c
index 744037e2..f3e51d11 100644
--- a/src/eval-apply.c
+++ b/src/eval-apply.c
@@ -688,6 +688,15 @@ eval:
                     goto eval;
                   }
               eval_define:
+                /* These may have been clobbered by an inline define
+                   during evaluation, so they must be recomputed. */
+                global_p = 0;
+                if (R0->car->car != cell_closure)
+                  global_p = 1;
+                macro_p = 0;
+                if (R2->car == cell_symbol_define_macro)
+                  macro_p = 1;
+
                 name = R2->cdr->car;
                 aa = R2->cdr->car;
                 if (aa->type == TPAIR)
@@ -706,9 +715,13 @@ eval:
                   {
                     entry = cons (name, R1);
                     aa = cons (entry, cell_nil);
+                    /* Push the definition onto the current lexical
+                       environment, but keep the first element (named
+                       '*closure*') pointing to the rest of the
+                       environment. */
                     set_cdr_x (aa, cdr (R0));
                     set_cdr_x (R0, aa);
-                    set_x (cell_closure, aa);
+                    set_cdr_x (car (R0), aa);
                   }
                 R1 = cell_unspecified;
                 goto vm_return;
diff --git a/tests/base.test b/tests/base.test
index b7cee5f6..5cbdfda1 100755
--- a/tests/base.test
+++ b/tests/base.test
@@ -94,6 +94,17 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
 (let () (define *top-let-define-a* '*top-let-define-a*) #t)
 (pass-if-not "top let define " (defined? '*top-let-define-a*))
 
+(define (lookup-toplevel name)
+  (if guile?
+      (module-variable (current-module) name)
+      (hashq-ref (initial-module) name)))
+
+(define (nested-define-value) (define x 12) x)
+(define *top-nested-define* (nested-define-value))
+(pass-if "top nested define"
+  (let ((v (lookup-toplevel '*top-nested-define*)))
+    (and v (equal? (variable-ref v) 12))))
+
 (pass-if "apply" (sequal? (apply list '(1)) '(1)))
 (pass-if "apply 2" (sequal? (apply list 1 '(2)) '(1 2)))
 (pass-if "apply 3" (sequal? (apply list 1 2 '(3)) '(1 2 3)))