allow phase 1+ references to not-yet-defined bindings

For example,

 (define-for-syntax (f x) (g x))
 (define-for-syntax (g y) y)

is now allowed. The unbound-variable check for phase 1
and up is delayed until after the module body is partially expanded.

collects/scribblings/reference/syntax.scrbl

@@ -1314,10 +1314,18 @@ x
 
 @defform[(#%top . id)]{
 
-Refers to a top-level definition that could bind @racket[id], even if
+Refers to a module-level or top-level definition that could bind
-@racket[id] has a local binding in its context. Such references are
+@racket[id], even if @racket[id] has a local binding in its context.
-disallowed anywhere within a @racket[module] form.  See also
+
-@secref["expand-steps"] for information on how the expander
+Within a @racket[module] form, @racket[(#%top . id)] expands to just
+@racket[id]---with the obligation that @racket[id] is defined within
+the module. At @tech{phase level} 0, @racket[(#%top . id)] is an
+immediate syntax error if @racket[id] is not bound. At @tech{phase
+level} 1 and higher, a syntax error is reported if @racket[id] is not
+defined at the corresponding phase by the end of @racket[module]-body
+@tech{partial expansion}.
+
+See also @secref["expand-steps"] for information on how the expander
 introduces @racketidfont{#%top} identifiers.
 
 @examples[

collects/tests/racket/stx.rktl

@@ -1558,6 +1558,29 @@
 (syntax-test #'(evil-via-shadower (m)))
 (syntax-test #'(evil-via-delta-introducer (m)))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check that a for-syntax reference can precede a
+;;  for-syntax definition
+
+(module pre-definition-reference racket/base
+  (require (for-syntax racket/base))
+  (provide (for-syntax f g))
+  (define-for-syntax (f x) (g (+ x 1)))
+  (define-for-syntax (g y) (+ y 2)))
+
+(require 'pre-definition-reference)
+(test 3 'use (let-syntax ([m (lambda (stx) (datum->syntax stx (f 0)))])
+               m))
+
+(syntax-test #'(module unbound-reference racket/base
+                 (require (for-syntax racket/base))
+                 (define-for-syntax (f x) nonesuch)))
+(syntax-test #'(module unbound-reference racket/base
+                 (require (for-syntax racket/base))
+                 (#%expression
+                  (let-syntax ([g (lambda (stx) nonesuch)])
+                    10))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

src/racket/src/compenv.c

@@ -637,6 +637,25 @@ Scheme_Object *scheme_register_toplevel_in_prefix(Scheme_Object *var, Scheme_Com
   return o;
 }
 
+void scheme_register_unbound_toplevel(Scheme_Comp_Env *env, Scheme_Object *id)
+{
+  Comp_Prefix *cp = env->prefix;
+
+  if (!cp->unbound) cp->unbound = scheme_null;
+
+  id = scheme_make_pair(id, cp->unbound);
+  cp->unbound = id;
+}
+
+void scheme_merge_undefineds(Scheme_Comp_Env *exp_env, Scheme_Comp_Env *env)
+{
+  if (exp_env->prefix->unbound) {
+    /* adding a list to env->prefix->unbound indicates a
+       phase-1 shift for the identifiers in the list: */
+    scheme_register_unbound_toplevel(env, exp_env->prefix->unbound);
+  }
+}
+
 Scheme_Object *scheme_toplevel_to_flagged_toplevel(Scheme_Object *_tl, int flags)
 {
   Scheme_Toplevel *tl = (Scheme_Toplevel *)_tl;
@@ -1840,7 +1859,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
     genv = env->genv;
     modname = NULL;
 
-    if (genv->module && genv->disallow_unbound) {
+    if (genv->module && (genv->disallow_unbound > 0)) {
       /* Free identifier. Maybe don't continue. */
       if (flags & (SCHEME_SETTING | SCHEME_REFERENCING)) {
         scheme_wrong_syntax(((flags & SCHEME_SETTING) 
@@ -1906,7 +1925,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
   }
 
   if (!modname && (flags & (SCHEME_SETTING | SCHEME_REFERENCING)) 
-      && (genv->module && genv->disallow_unbound)) {
+      && (genv->module && (genv->disallow_unbound > 0))) {
     /* Check for set! of unbound identifier: */    
     if (!scheme_lookup_in_table(genv->toplevel, (const char *)find_global_id)) {
       scheme_wrong_syntax(((flags & SCHEME_SETTING) 

src/racket/src/compile.c

@@ -3280,6 +3280,8 @@ do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env,
 
   vec->type = (for_stx ? scheme_define_for_syntax_type : scheme_define_syntaxes_type);
 
+  scheme_merge_undefineds(exp_env, env);
+
   return vec;
 }
 
@@ -3545,6 +3547,8 @@ void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object
   }
   *_pos = i;
 
+  scheme_merge_undefineds(eenv, rhs_env);
+
   SCHEME_EXPAND_OBSERVE_EXIT_BIND(rec[drec].observer);
 }
 
@@ -5049,7 +5053,58 @@ datum_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Expand_Info
                                 0, 2);
 }
 
-static Scheme_Object *check_top(const char *when, Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
+int scheme_check_top_identifier_bound(Scheme_Object *c, Scheme_Env *genv, int disallow_unbound)
+{
+  Scheme_Object *symbol = c;
+  Scheme_Object *modidx, *tl_id;
+  int bad;
+  
+  tl_id = scheme_tl_id_sym(genv, symbol, NULL, 0, NULL, NULL);
+  if (NOT_SAME_OBJ(tl_id, SCHEME_STX_SYM(symbol))) {
+    /* Since the module has a rename for this id, it's certainly defined. */
+    bad = 0;
+  } else {
+    modidx = scheme_stx_module_name(NULL, &symbol, scheme_make_integer(genv->phase), NULL, NULL, NULL, 
+                                    NULL, NULL, NULL, NULL, NULL);
+    if (modidx) {
+      /* If it's an access path, resolve it: */
+      if (genv->module
+          && SAME_OBJ(scheme_module_resolve(modidx, 1), genv->module->modname))
+        bad = 0;
+      else
+        bad = 1;
+    } else
+      bad = 1;
+
+    if (disallow_unbound) {
+      if (bad || !scheme_lookup_in_table(genv->toplevel, (const char *)SCHEME_STX_SYM(c))) {
+        GC_CAN_IGNORE const char *reason;
+        if (genv->phase == 1) {
+          reason = "unbound identifier in module (in phase 1, transformer environment)";
+          /* Check in the run-time environment */
+          if (scheme_lookup_in_table(genv->template_env->toplevel, (const char *)SCHEME_STX_SYM(c))) {
+            reason = ("unbound identifier in module (in the transformer environment, which does"
+                      " not include the run-time definition)");
+          } else if (genv->template_env->syntax
+                     && scheme_lookup_in_table(genv->template_env->syntax, (const char *)SCHEME_STX_SYM(c))) {
+            reason = ("unbound identifier in module (in the transformer environment, which does"
+                      " not include the macro definition that is visible to run-time expressions)");
+          }
+        } else if (genv->phase == 0)
+          reason = "unbound identifier in module";
+        else
+          reason = "unbound identifier in module (in phase %d)";
+        scheme_wrong_syntax(scheme_expand_stx_string, NULL, c, reason, genv->phase);
+      }
+    }
+  }
+
+  return !bad;
+}
+
+static Scheme_Object *check_top(Scheme_Object *orig_form, 
+                                Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec,
+                                int *_need_bound_check)
 {
   Scheme_Object *c, *form;
 
@@ -5065,47 +5120,10 @@ static Scheme_Object *check_top(const char *when, Scheme_Object *orig_form, Sche
     scheme_wrong_syntax(NULL, NULL, form, NULL);
 
   if (env->genv->module) {
-    Scheme_Object *modidx, *symbol = c, *tl_id;
     int bad;
-
+    bad = !scheme_check_top_identifier_bound(c, env->genv, env->genv->disallow_unbound > 0);
-    tl_id = scheme_tl_id_sym(env->genv, symbol, NULL, 0, NULL, NULL);
+    if (_need_bound_check)
-    if (NOT_SAME_OBJ(tl_id, SCHEME_STX_SYM(symbol))) {
+      *_need_bound_check = bad;
-      /* Since the module has a rename for this id, it's certainly defined. */
-    } else {
-      modidx = scheme_stx_module_name(NULL, &symbol, scheme_make_integer(env->genv->phase), NULL, NULL, NULL, 
-                                      NULL, NULL, NULL, NULL, NULL);
-      if (modidx) {
-	/* If it's an access path, resolve it: */
-	if (env->genv->module
-	    && SAME_OBJ(scheme_module_resolve(modidx, 1), env->genv->module->modname))
-	  bad = 0;
-	else
-	  bad = 1;
-      } else
-	bad = 1;
-
-      if (env->genv->disallow_unbound) {
-	if (bad || !scheme_lookup_in_table(env->genv->toplevel, (const char *)SCHEME_STX_SYM(c))) {
-          GC_CAN_IGNORE const char *reason;
-          if (env->genv->phase == 1) {
-            reason = "unbound identifier in module (in phase 1, transformer environment)";
-            /* Check in the run-time environment */
-            if (scheme_lookup_in_table(env->genv->template_env->toplevel, (const char *)SCHEME_STX_SYM(c))) {
-              reason = ("unbound identifier in module (in the transformer environment, which does"
-                        " not include the run-time definition)");
-            } else if (env->genv->template_env->syntax
-                       && scheme_lookup_in_table(env->genv->template_env->syntax, (const char *)SCHEME_STX_SYM(c))) {
-              reason = ("unbound identifier in module (in the transformer environment, which does"
-                        " not include the macro definition that is visible to run-time expressions)");
-            }
-          } else if (env->genv->phase == 0)
-            reason = "unbound identifier in module";
-          else
-            reason = "unbound identifier in module (in phase %d)";
-	  scheme_wrong_syntax(when, NULL, c, reason, env->genv->phase);
-	}
-      }
-    }
   }
 
   return c;
@@ -5115,8 +5133,12 @@ static Scheme_Object *
 top_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
 {
   Scheme_Object *c;
+  int need_bound_check = 0;
 
-  c = check_top(scheme_compile_stx_string, form, env, rec, drec);
+  c = check_top(form, env, rec, drec, &need_bound_check);
+
+  if (need_bound_check)
+    scheme_register_unbound_toplevel(env, c);
 
   c = scheme_tl_id_sym(env->genv, c, NULL, 0, NULL, NULL);
 
@@ -5137,8 +5159,15 @@ top_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
 static Scheme_Object *
 top_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec)
 {
+  Scheme_Object *c;
+  int need_bound_check = 0;
+
   SCHEME_EXPAND_OBSERVE_PRIM_TOP(erec[drec].observer);
-  check_top(scheme_expand_stx_string, form, env, erec, drec);
+  c = check_top(form, env, erec, drec, &need_bound_check);
+
+  if (need_bound_check)
+    return c; /* strip `#%top' prefix */
+
   return form;
 }
 

src/racket/src/env.c

@@ -892,7 +892,7 @@ void scheme_prepare_exp_env(Scheme_Env *env)
     eenv->rename_set = env->rename_set;
 
     if (env->disallow_unbound)
-      eenv->disallow_unbound = 1;
+      eenv->disallow_unbound = env->disallow_unbound;
   }
 }
 
@@ -932,7 +932,7 @@ void scheme_prepare_template_env(Scheme_Env *env)
     eenv->label_env = env->label_env;
 
     if (env->disallow_unbound)
-      eenv->disallow_unbound = 1;
+      eenv->disallow_unbound = env->disallow_unbound;
   }
 }
 

src/racket/src/error.c

@@ -1973,16 +1973,23 @@ void scheme_unbound_global(Scheme_Bucket *b)
 
   if (home && home->module) {
     const char *errmsg;
-    char *phase, phase_buf[20];
+    char *phase, phase_buf[20], *phase_note = "";
     
     if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC)))
-      errmsg = "reference to an identifier before its definition: %S in module: %D%s";
+      errmsg = "reference to an identifier before its definition: %S in module: %D%s%s";
     else
-      errmsg = "reference to an identifier before its definition: %S%_%s";
+      errmsg = "reference to an identifier before its definition: %S%_%s%s";
 
     if (home->phase) {
       sprintf(phase_buf, " phase: %" PRIdPTR "", home->phase);
       phase = phase_buf;
+      if ((home->phase == 1) && (home->template_env)) {
+        if (scheme_lookup_in_table(home->template_env->toplevel, (const char *)name))
+          phase_note = " (which cannot access the run-time definition)";
+        else if (home->template_env->syntax
+                 && scheme_lookup_in_table(home->template_env->syntax, (const char *)name))
+          phase_note = " (which cannot access the syntax binding for run-time expressions)";
+      }
     } else
       phase = "";
 
@@ -1991,7 +1998,8 @@ void scheme_unbound_global(Scheme_Bucket *b)
 		     errmsg,
 		     name,
 		     home->module->modsrc,
-                     phase);
+                     phase,
+                     phase_note);
   } else {
     scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE,
 		     name,

src/racket/src/module.c

@@ -5591,6 +5591,12 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
 
   scheme_prepare_exp_env(menv);
 
+  /* Allow phase-1 references to unbound identifiers; we check
+     at the end of body expansion to make sure that all referenced
+     identifiers were eventually bound. Meanwhile, 
+     reference-before-definition errors are possible. */
+  menv->exp_env->disallow_unbound = -1;
+  
   /* For each provide in iim, add a module rename to fm */
   saw_mb = add_simple_require_renames(NULL, rn_set, NULL, iim, iidx, scheme_make_integer(0), NULL, 1);
 
@@ -6080,7 +6086,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
   Scheme_Object *lift_data;
   Scheme_Object **exis, **et_exis, **exsis;
   Scheme_Object *lift_ctx;
-  Scheme_Object *lifted_reqs = scheme_null, *req_data;
+  Scheme_Object *lifted_reqs = scheme_null, *req_data, *unbounds = scheme_null;
   int exicount, et_exicount, exsicount;
   char *exps, *et_exps;
   int *all_simple_renames;
@@ -6531,6 +6537,9 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
 	  SCHEME_VEC_ELS(vec)[4] = (for_stx ? scheme_true : scheme_false);
 	  exp_body = scheme_make_pair(vec, exp_body);
 
+          if (eenv->prefix->unbound)
+            unbounds = scheme_make_pair(eenv->prefix->unbound, unbounds);
+	
           m = scheme_sfs(m, NULL, max_let_depth);
 	  if (scheme_resolve_info_use_jit(ri))
 	    m = scheme_jit_expr(m);
@@ -6615,6 +6624,50 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env
   }
   scheme_seal_module_rename_set(post_ex_rn_set, STX_SEAL_BOUND);
 
+  /* Check that all bindings used in phase-N expressions (for N >= 1) 
+     were defined by now: */
+  while (!SCHEME_NULLP(unbounds)) {
+    Scheme_Object *stack = scheme_null, *lst;
+    Scheme_Env *uenv = env->genv->exp_env;
+
+    lst = SCHEME_CAR(unbounds);
+    while(1) {
+      while (!SCHEME_NULLP(lst)) {
+        p = SCHEME_CAR(lst);
+        if (SCHEME_PAIRP(p)) {
+          if (!uenv->exp_env)
+            scheme_signal_error("internal error: no such environment to check unbounds");
+          else {
+            /* switch to nested list, push current list onto stack: */
+            stack = scheme_make_pair(scheme_make_pair(SCHEME_CDR(lst), (Scheme_Object *)uenv),
+                                     stack);
+            uenv = uenv->exp_env;
+            lst = SCHEME_CAR(lst);
+          }
+        } else {
+          (void)scheme_check_top_identifier_bound(p, uenv, 1);
+          lst = SCHEME_CDR(lst);
+        }
+      }
+      if (!SCHEME_NULLP(stack)) {
+        lst = SCHEME_CAR(stack);
+        stack = SCHEME_CDR(stack);
+        uenv = (Scheme_Env *)SCHEME_CDR(lst);
+        lst = SCHEME_CAR(lst);
+      } else
+        break;
+    }
+    unbounds = SCHEME_CDR(unbounds);
+  }
+  /* Disallow unbound variables from now on: */
+  {
+    Scheme_Env *uenv = env->genv->exp_env;
+    while (uenv) {
+      uenv->disallow_unbound = 1;
+      uenv = uenv->exp_env;
+    }
+  }
+
   /* Pass 2 */
   SCHEME_EXPAND_OBSERVE_NEXT_GROUP(observer);
   

src/racket/src/mzmark_type.inc

@@ -2381,6 +2381,7 @@ static int comp_prefix_val_SIZE(void *p, struct NewGC *gc) {
 static int comp_prefix_val_MARK(void *p, struct NewGC *gc) {
   Comp_Prefix *cp = (Comp_Prefix *)p;
   gcMARK2(cp->toplevels, gc);
+  gcMARK2(cp->unbound, gc);
   gcMARK2(cp->stxes, gc);
   gcMARK2(cp->uses_unsafe, gc);
 
@@ -2391,6 +2392,7 @@ static int comp_prefix_val_MARK(void *p, struct NewGC *gc) {
 static int comp_prefix_val_FIXUP(void *p, struct NewGC *gc) {
   Comp_Prefix *cp = (Comp_Prefix *)p;
   gcFIXUP2(cp->toplevels, gc);
+  gcFIXUP2(cp->unbound, gc);
   gcFIXUP2(cp->stxes, gc);
   gcFIXUP2(cp->uses_unsafe, gc);
 

src/racket/src/mzmarksrc.c

@@ -954,6 +954,7 @@ comp_prefix_val {
  mark:
   Comp_Prefix *cp = (Comp_Prefix *)p;
   gcMARK2(cp->toplevels, gc);
+  gcMARK2(cp->unbound, gc);
   gcMARK2(cp->stxes, gc);
   gcMARK2(cp->uses_unsafe, gc);
 

src/racket/src/schpriv.h

@@ -2143,6 +2143,7 @@ typedef struct Comp_Prefix
   MZTAG_IF_REQUIRED
   int num_toplevels, num_stxes;
   Scheme_Hash_Table *toplevels; /* buckets for toplevel/module variables */
+  Scheme_Object *unbound; /* identifiers (and lists of phase-1 shifted unbounds) that were unbound at compile */
   Scheme_Hash_Table *stxes;     /* syntax objects */
   Scheme_Object *uses_unsafe;   /* NULL, inspector, or hashtree of inspectors */
 } Comp_Prefix;
@@ -2506,14 +2507,18 @@ void scheme_delay_load_closure(Scheme_Closure_Data *data);
 
 Scheme_Object *scheme_compiled_void(void);
 
+int scheme_check_top_identifier_bound(Scheme_Object *symbol, Scheme_Env *genv, int disallow_unbound);
+
 Scheme_Object *scheme_register_toplevel_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env,
 						  Scheme_Compile_Info *rec, int drec,
                                                   int imported);
+void scheme_register_unbound_toplevel(Scheme_Comp_Env *env, Scheme_Object *id);
 Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env,
 					     Scheme_Compile_Info *rec, int drec);
 void scheme_register_unsafe_in_prefix(Scheme_Comp_Env *env,
                                       Scheme_Compile_Info *rec, int drec,
                                       Scheme_Env *menv);
+void scheme_merge_undefineds(Scheme_Comp_Env *exp_env, Scheme_Comp_Env *env);
 
 void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object *a, 
                           Scheme_Env *exp_env, Scheme_Object *insp,