From cad726031f1abada81b698d29127cd711ae9cda0 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 29 Sep 2008 12:19:38 +0000
Subject: [PATCH] fix two macro-expansion bugs, one related to the top level,
 and one related to internal-definition positions

svn: r11900
---
 src/mzscheme/src/env.c    | 17 +++++++++++++----
 src/mzscheme/src/eval.c   |  4 ++++
 src/mzscheme/src/syntax.c | 26 +++++++++++++++-----------
 3 files changed, 32 insertions(+), 15 deletions(-)

diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c
index e3c2fe7757..e49d9bb5f4 100644
--- a/src/mzscheme/src/env.c
+++ b/src/mzscheme/src/env.c
@@ -2513,10 +2513,19 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
 
   /* Used out of context? */
   if (SAME_OBJ(modidx, scheme_undefined)) {
-    if (!(flags & SCHEME_OUT_OF_CONTEXT_OK))
-      scheme_wrong_syntax(scheme_compile_stx_string, NULL, find_id,
-			  "identifier used out of context");
-    return NULL;
+    if (!env->genv->module && SCHEME_STXP(find_id)) {
+      /* Looks like lexically bound, but double-check that it's not bound via a tl_id: */
+      find_global_id = scheme_tl_id_sym(env->genv, find_id, NULL, 0, NULL);
+      if (!SAME_OBJ(find_global_id, SCHEME_STX_VAL(find_id)))
+        modidx = NULL; /* yes, it is bound */
+    }
+    
+    if (modidx) {
+      if (!(flags & SCHEME_OUT_OF_CONTEXT_OK))
+        scheme_wrong_syntax(scheme_compile_stx_string, NULL, find_id,
+                            "identifier used out of context");
+      return NULL;
+    }
   }
 
   if (modidx) {
diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c
index 9b2fe75ef1..e9270db361 100644
--- a/src/mzscheme/src/eval.c
+++ b/src/mzscheme/src/eval.c
@@ -6399,6 +6399,9 @@ scheme_compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env,
           result = scheme_make_pair(result, scheme_null);
           SCHEME_EXPAND_OBSERVE_BLOCK_TO_LETREC(rec[drec].observer, result);
           return scheme_expand_list(result, env, rec, drec);
+        } else {
+          result = scheme_make_pair(result, scheme_null);
+          return scheme_datum_to_syntax(result, forms, forms, 0, 0);
         }
       }
     }
@@ -6420,6 +6423,7 @@ scheme_compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env,
     rest = scheme_datum_to_syntax(rest, forms, forms, 0, 0);
 
     first = scheme_compile_expr(first, env, recs, 0);
+
 #if EMBEDDED_DEFINES_START_ANYWHERE
     forms = scheme_compile_expand_block(rest, env, recs, 1);
 #else
diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c
index 4cd2a3bbbd..e095659f65 100644
--- a/src/mzscheme/src/syntax.c
+++ b/src/mzscheme/src/syntax.c
@@ -4464,6 +4464,9 @@ Scheme_Object *scheme_compile_sequence(Scheme_Object *forms,
 				       Scheme_Comp_Env *env, 
 				       Scheme_Compile_Info *rec, int drec)
 {
+#if 0
+  /* This attempt at a shortcut is wrong, because the sole expression might expand
+     to a `begin' that needs to be spliced into an internal-definition context. */
  try_again:
 
   if (SCHEME_STX_PAIRP(forms) && SCHEME_STX_NULLP(SCHEME_STX_CDR(forms))) {
@@ -4471,7 +4474,7 @@ Scheme_Object *scheme_compile_sequence(Scheme_Object *forms,
     Scheme_Object *first, *val;
 
     first = SCHEME_STX_CAR(forms);
-    first = scheme_check_immediate_macro(first, env, rec, drec, 0, &val, NULL, NULL);
+    first = scheme_check_immediate_macro(first, env, rec, drec, 1, &val, NULL, NULL);
 
     if (SAME_OBJ(val, scheme_begin_syntax) && SCHEME_STX_PAIRP(first)) {      
       /* Flatten begin: */
@@ -4485,17 +4488,18 @@ Scheme_Object *scheme_compile_sequence(Scheme_Object *forms,
     }
 
     return scheme_compile_expr(first, env, rec, drec);
+  }
+#endif
+
+  if (scheme_stx_proper_list_length(forms) < 0) {
+    scheme_wrong_syntax(scheme_begin_stx_string, NULL, 
+                        scheme_datum_to_syntax(cons(begin_symbol, forms), forms, forms, 0, 0),
+                        "bad syntax (" IMPROPER_LIST_FORM ")");
+    return NULL;
   } else {
-    if (scheme_stx_proper_list_length(forms) < 0) {
-      scheme_wrong_syntax(scheme_begin_stx_string, NULL, 
-			  scheme_datum_to_syntax(cons(begin_symbol, forms), forms, forms, 0, 0),
-			  "bad syntax (" IMPROPER_LIST_FORM ")");
-      return NULL;
-    } else {
-      Scheme_Object *body;
-      body = scheme_compile_block(forms, env, rec, drec);
-      return scheme_make_sequence_compilation(body, 1);
-    }
+    Scheme_Object *body;
+    body = scheme_compile_block(forms, env, rec, drec);
+    return scheme_make_sequence_compilation(body, 1);
   }
 }