syntax-local-lift-require

svn: r13075

collects/scribblings/reference/stx-trans.scrbl

@@ -340,6 +340,24 @@ eventually expanded in an expression context.
 @transform-time[]}
 
 
+@defproc[(syntax-local-lift-require [quoted-raw-require-spec any/c][stx syntax?])
+         syntax?]{
+
+Lifts a @scheme[#%require] form corresponding to
+@scheme[quoted-raw-require-spec] to the top-level or to the top of the
+module currently being expanded, wrapping it with @scheme[for-meta] if
+the current expansion context is not @tech{phase level} 0.
+
+The resulting syntax object is the same as @scheme[stx], except that a
+fresh @tech{syntax mark} is added. The same @tech{syntax mark} is
+added to the lifted @scheme[#%require] form, so that the
+@scheme[#%require] form can bind uses of imported identifiers in the
+resulting syntax object (assuming that the lexical information of
+@scheme[stx] includes the binding environment into which the
+@scheme[#%require] is lifted).
+
+@transform-time[]}
+
 @defproc[(syntax-local-name) (or/c symbol? #f)]{
 
 Returns an inferred name for the expression position being

collects/scribblings/reference/syntax.scrbl

@@ -606,7 +606,7 @@ export name, though the same binding can be specified with the
 multiple symbolic names.}
 
 
-@defform[(for-meta require-spec ...)]{See @scheme[require] and @scheme[provide].}
+@defform[(for-meta phase-level require-spec ...)]{See @scheme[require] and @scheme[provide].}
 @defform[(for-syntax require-spec ...)]{See @scheme[require] and @scheme[provide].}
 @defform[(for-template require-spec ...)]{See @scheme[require] and @scheme[provide].}
 @defform[(for-label require-spec ...)]{See @scheme[require] and @scheme[provide].}

collects/sirmail/readr.ss

@@ -1018,7 +1018,7 @@
 	    (lambda (w e) 
 	      (purge-marked/update-headers)))
       (send global-keymap add-function "gc"
-	    (lambda (w e) (collect-garbage) (collect-garbage)))
+	    (lambda (w e) (collect-garbage) (collect-garbage) (dump-memory-stats)))
       (send global-keymap add-function "show-memory-graph"
 	    (lambda (w e) (show-memory-graph)))
       

doc/release-notes/mzscheme/HISTORY.txt

@@ -1,6 +1,5 @@
-Somewhere in there:
+Version 4.1.3.10
- function contracts now preserve tail recursion in many cases; the
+Added syntax-local-lift-require
- 'any' contract is no longer special.
 
 Version 4.1.3.8
 Added procedure-rename
@@ -15,6 +14,7 @@ Version 4.1.3.6
 Memory accounting changed to bias charges to parent instead of children
 
 Version 4.1.3.3
+Function contracts preserve tail recursion in many cases
 Added compile-context-preservation-enabled
 Added exception-backtrace support for x86_84+JIT
 Added scheme/package, scheme/splicing

src/mred/wxme/wx_mline.cxx

@@ -321,7 +321,7 @@ void wxMediaLine::Delete(wxMediaLine **root)
   else
     x = v->right;
 
-  x->parent = v->parent;
+  x->parent = v->parent; /* x could be NIL; fixup at end */
 
   if (PTREQ(v->parent, NIL))
     *root = x;
@@ -448,6 +448,11 @@ void wxMediaLine::Delete(wxMediaLine **root)
     SET_BLACK(x);
   }
 
+  if (PTRNE(NIL->parent, NIL)) {
+    /* fixup: we set NIL's parent above */
+    NIL->parent = NIL;
+  }
+
   right = left = NIL;
   DELETE_OBJ this;
 }
@@ -594,7 +599,8 @@ wxMediaParagraph *wxMediaLine::GetParagraphStyle(Bool *first)
     } else {                                 \
       node = node->parent;                   \
     }                                        \
-  }                                          \
+  }
+
 
 void wxMediaLine::SetLength(long len)
 {

src/mzscheme/src/env.c

@@ -110,6 +110,7 @@ static Scheme_Object *local_module_expanding_provides(int argc, Scheme_Object *a
 static Scheme_Object *local_lift_expr(int argc, Scheme_Object *argv[]);
 static Scheme_Object *local_lift_context(int argc, Scheme_Object *argv[]);
 static Scheme_Object *local_lift_end_statement(int argc, Scheme_Object *argv[]);
+static Scheme_Object *local_lift_require(int argc, Scheme_Object *argv[]);
 static Scheme_Object *make_introducer(int argc, Scheme_Object *argv[]);
 static Scheme_Object *local_make_delta_introduce(int argc, Scheme_Object *argv[]);
 static Scheme_Object *make_set_transformer(int argc, Scheme_Object *argv[]);
@@ -550,6 +551,7 @@ static void make_kernel_env(void)
   GLOBAL_PRIM_W_ARITY("syntax-local-lift-expression", local_lift_expr, 1, 1, env);
   GLOBAL_PRIM_W_ARITY("syntax-local-lift-context", local_lift_context, 0, 0, env);
   GLOBAL_PRIM_W_ARITY("syntax-local-lift-module-end-declaration", local_lift_end_statement, 1, 1, env);
+  GLOBAL_PRIM_W_ARITY("syntax-local-lift-require", local_lift_require, 2, 2, env);
 
   {
     Scheme_Object *sym;
@@ -1366,7 +1368,7 @@ scheme_add_compilation_binding(int index, Scheme_Object *val, Scheme_Comp_Env *f
 }
 
 void scheme_frame_captures_lifts(Scheme_Comp_Env *env, Scheme_Lift_Capture_Proc cp, Scheme_Object *data, 
-                                 Scheme_Object *end_stmts, Scheme_Object *context_key)
+                                 Scheme_Object *end_stmts, Scheme_Object *context_key, Scheme_Object *requires)
 {
   Scheme_Lift_Capture_Proc *pp;
   Scheme_Object *vec;
@@ -1374,16 +1376,45 @@ void scheme_frame_captures_lifts(Scheme_Comp_Env *env, Scheme_Lift_Capture_Proc
   pp = (Scheme_Lift_Capture_Proc *)scheme_malloc_atomic(sizeof(Scheme_Lift_Capture_Proc));
   *pp = cp;
 
-  vec = scheme_make_vector(5, NULL);
+  vec = scheme_make_vector(7, NULL);
   SCHEME_VEC_ELS(vec)[0] = scheme_null;
   SCHEME_VEC_ELS(vec)[1] = (Scheme_Object *)pp;
   SCHEME_VEC_ELS(vec)[2] = data;
   SCHEME_VEC_ELS(vec)[3] = end_stmts;
   SCHEME_VEC_ELS(vec)[4] = context_key;
+  SCHEME_VEC_ELS(vec)[5] = (requires ? requires : scheme_false);
+  SCHEME_VEC_ELS(vec)[6] = scheme_null; /* accumulated requires */
 
   COMPILE_DATA(env)->lifts = vec;
 }
 
+void scheme_propagate_require_lift_capture(Scheme_Comp_Env *orig_env, Scheme_Comp_Env *env)
+{
+  while (orig_env) {
+    if ((COMPILE_DATA(orig_env)->lifts)
+        && SCHEME_TRUEP(SCHEME_VEC_ELS(COMPILE_DATA(orig_env)->lifts)[5]))
+      break;
+    orig_env = orig_env->next;
+  }
+  
+  if (orig_env) {
+    Scheme_Object *vec, *p;
+
+    p = scheme_make_raw_pair(NULL, (Scheme_Object *)orig_env);
+
+    vec = scheme_make_vector(7, NULL);
+    SCHEME_VEC_ELS(vec)[0] = scheme_false;
+    SCHEME_VEC_ELS(vec)[1] = scheme_void;
+    SCHEME_VEC_ELS(vec)[2] = scheme_void;
+    SCHEME_VEC_ELS(vec)[3] = scheme_false;
+    SCHEME_VEC_ELS(vec)[4] = scheme_false;
+    SCHEME_VEC_ELS(vec)[5] = p; /* (rcons NULL env) => continue with env */
+    SCHEME_VEC_ELS(vec)[6] = scheme_null;
+
+    COMPILE_DATA(env)->lifts = vec;
+  }
+}
+
 Scheme_Object *scheme_frame_get_lifts(Scheme_Comp_Env *env)
 {
   return SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[0];
@@ -1394,6 +1425,11 @@ Scheme_Object *scheme_frame_get_end_statement_lifts(Scheme_Comp_Env *env)
   return SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[3];
 }
 
+Scheme_Object *scheme_frame_get_require_lifts(Scheme_Comp_Env *env)
+{
+  return SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[6];
+}
+
 void scheme_add_local_syntax(int cnt, Scheme_Comp_Env *env)
 {
   Scheme_Object **ns, **vs;
@@ -4748,6 +4784,10 @@ local_lift_expr(int argc, Scheme_Object *argv[])
     env = env->next;
   }
 
+  if (env)
+    if (SCHEME_FALSEP(SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[0]))
+      env = NULL;
+
   if (!env)
     scheme_raise_exn(MZEXN_FAIL_CONTRACT, 
 		     "syntax-local-lift-expression: no lift target");
@@ -4851,6 +4891,61 @@ local_lift_end_statement(int argc, Scheme_Object *argv[])
   return scheme_void;
 }
 
+static Scheme_Object *local_lift_require(int argc, Scheme_Object *argv[])
+{
+  Scheme_Comp_Env *env;
+  Scheme_Object *local_mark, *mark, *data, *pr, *form;
+  long phase;
+
+  if (!SCHEME_STXP(argv[1]))
+    scheme_wrong_type("syntax-local-lift-require", "syntax", 1, argc, argv);
+
+  env = scheme_current_thread->current_local_env;
+  local_mark = scheme_current_thread->current_local_mark;
+  phase = env->genv->phase;
+
+  if (!env)
+    scheme_raise_exn(MZEXN_FAIL_CONTRACT, 
+		     "syntax-local-lift-require: not currently transforming");
+
+  data = NULL;
+
+  while (env) {
+    if (COMPILE_DATA(env)->lifts
+        && SCHEME_TRUEP(SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[5])) {
+      data = SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[5];
+      if (SCHEME_RPAIRP(data)
+          && !SCHEME_CAR(data)) {
+        env = (Scheme_Comp_Env *)SCHEME_CDR(data);
+      } else
+        break;
+    } else
+      env = env->next;
+  }
+
+  if (!env)
+    scheme_raise_exn(MZEXN_FAIL_CONTRACT, 
+		     "syntax-local-lift-requires: could not find target context");
+
+  
+  mark = scheme_new_mark();
+
+  if (SCHEME_RPAIRP(data))
+    form = scheme_parse_lifted_require(argv[0], phase, mark, SCHEME_CAR(data));
+  else
+    form = scheme_toplevel_require_for_expand(argv[0], phase, env, mark);
+  
+  pr = scheme_make_pair(form, SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[6]);
+  SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[6] = pr;
+
+  form = argv[1];
+  form = scheme_add_remove_mark(form, local_mark);
+  form = scheme_add_remove_mark(form, mark);
+  form = scheme_add_remove_mark(form, local_mark);
+
+  return form;
+}
+
 static Scheme_Object *
 make_set_transformer(int argc, Scheme_Object *argv[])
 {

src/mzscheme/src/error.c

@@ -1218,7 +1218,7 @@ char *scheme_make_arity_expect_string(Scheme_Object *proc,
     name = scheme_get_proc_name((Scheme_Object *)proc, &namelen, 1);
 #endif
   } else if (SCHEME_STRUCTP(proc)) {
-    name = proc;
+    name = (const char *)proc;
     mina = -1;
     maxa = 0;
   } else {

src/mzscheme/src/eval.c

@@ -4911,7 +4911,7 @@ static void *compile_k(void)
   int writeable, for_eval, rename, enforce_consts, comp_flags;
   Scheme_Env *genv;
   Scheme_Compile_Info rec, rec2;
-  Scheme_Object *o, *tl_queue;
+  Scheme_Object *o, *rl, *tl_queue;
   Scheme_Compilation_Top *top;
   Resolve_Prefix *rp;
   Resolve_Info *ri;
@@ -4973,7 +4973,8 @@ static void *compile_k(void)
 	 find one, break it up to eval first expression
 	 before the rest. */
       while (1) {
-	scheme_frame_captures_lifts(cenv, scheme_make_lifted_defn, scheme_sys_wraps(cenv), scheme_false, scheme_false);
+	scheme_frame_captures_lifts(cenv, scheme_make_lifted_defn, scheme_sys_wraps(cenv), 
+                                    scheme_false, scheme_false, scheme_null);
 	form = scheme_check_immediate_macro(form, 
 					    cenv, &rec, 0,
 					    0, &gval, NULL, NULL);
@@ -4989,10 +4990,13 @@ static void *compile_k(void)
 	  } else
 	    break;
 	} else {
+	  rl = scheme_frame_get_require_lifts(cenv);
 	  o = scheme_frame_get_lifts(cenv);
-	  if (!SCHEME_NULLP(o)) {
+	  if (!SCHEME_NULLP(o)
+              || !SCHEME_NULLP(rl)) {
 	    tl_queue = scheme_make_pair(form, tl_queue);
 	    tl_queue = scheme_append(o, tl_queue);
+	    tl_queue = scheme_append(rl, tl_queue);
 	    form = SCHEME_CAR(tl_queue);
 	    tl_queue = SCHEME_CDR(tl_queue);
 	  }
@@ -5010,7 +5014,8 @@ static void *compile_k(void)
       Scheme_Object *l, *prev_o = NULL;
 
       while (1) {
-	scheme_frame_captures_lifts(cenv, scheme_make_lifted_defn, scheme_sys_wraps(cenv), scheme_false, scheme_false);
+	scheme_frame_captures_lifts(cenv, scheme_make_lifted_defn, scheme_sys_wraps(cenv), 
+                                    scheme_false, scheme_false, scheme_null);
 
 	scheme_init_compile_recs(&rec, 0, &rec2, 1);
 
@@ -5031,10 +5036,13 @@ static void *compile_k(void)
 	/* If any definitions were lifted in the process of compiling o,
 	   we need to fold them in. */
 	l = scheme_frame_get_lifts(cenv);
-	if (!SCHEME_NULLP(l)) {
+	rl = scheme_frame_get_require_lifts(cenv);
-	  l = icons(scheme_datum_to_syntax(begin_symbol, scheme_false, scheme_sys_wraps(cenv), 0, 0),
+	if (!SCHEME_NULLP(l)
-		    l);
+            || !SCHEME_NULLP(rl)) {
-	  form = scheme_datum_to_syntax(l, scheme_false, scheme_false, 0, 0);
+          l = scheme_append(rl, l);
+          rl = icons(scheme_datum_to_syntax(begin_symbol, scheme_false, scheme_sys_wraps(cenv), 0, 0),
+                     rl);
+          form = scheme_datum_to_syntax(rl, scheme_false, scheme_false, 0, 0);
 	  prev_o = o;
 	} else 
 	  break;
@@ -6213,7 +6221,7 @@ compile_expand_expr_lift_to_let(Scheme_Object *form, Scheme_Comp_Env *env,
 
   context_key = scheme_generate_lifts_key();
   
-  scheme_frame_captures_lifts(inserted, pair_lifted, (Scheme_Object *)ip, scheme_false, context_key);
+  scheme_frame_captures_lifts(inserted, pair_lifted, (Scheme_Object *)ip, scheme_false, context_key, NULL);
 
   if (rec[drec].comp) {
     scheme_init_compile_recs(rec, drec, recs, 2);
@@ -8877,7 +8885,9 @@ static void *expand_k(void)
     erec1.comp_flags = comp_flags;
 
     if (catch_lifts_key)
-      scheme_frame_captures_lifts(env, scheme_make_lifted_defn, scheme_sys_wraps(env), scheme_false, catch_lifts_key);
+      scheme_frame_captures_lifts(env, scheme_make_lifted_defn, scheme_sys_wraps(env), 
+                                  scheme_false, catch_lifts_key, 
+                                  (!as_local && catch_lifts_key) ? scheme_null : NULL);
   
     if (just_to_top) {
       Scheme_Object *gval;
@@ -8886,9 +8896,12 @@ static void *expand_k(void)
       obj = scheme_expand_expr(obj, env, &erec1, 0);
 
     if (catch_lifts_key) {
-      Scheme_Object *l;
+      Scheme_Object *l, *rl;
       l = scheme_frame_get_lifts(env);
-      if (SCHEME_PAIRP(l)) {
+      rl = scheme_frame_get_require_lifts(env);
+      if (SCHEME_PAIRP(l)
+          || SCHEME_PAIRP(rl)) {
+        l = scheme_append(rl, l);
         obj = add_lifts_as_begin(obj, l, env);
         SCHEME_EXPAND_OBSERVE_LIFT_LOOP(erec1.observer,obj);
 	if ((depth >= 0) || as_local)
@@ -9189,6 +9202,7 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
   if (for_stx) {
     scheme_prepare_exp_env(env->genv);
     env = scheme_new_comp_env(env->genv->exp_env, env->insp, 0);
+    scheme_propagate_require_lift_capture(orig_env, env);
   }
 
   if (for_expr)
@@ -9322,7 +9336,7 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
 
     if (catch_lifts_key)
       scheme_frame_captures_lifts(env, scheme_make_lifted_defn, scheme_sys_wraps(env), scheme_false, 
-                                  catch_lifts_key);
+                                  catch_lifts_key, NULL);
 
     memset(drec, 0, sizeof(drec));
     drec[0].value_name = scheme_false; /* or scheme_current_thread->current_local_name ? */

src/mzscheme/src/module.c

@@ -5749,6 +5749,76 @@ static Scheme_Object *add_lifted_defn(Scheme_Object *data, Scheme_Object **_id,
   return scheme_make_lifted_defn(scheme_sys_wraps(env), _id, expr, _env);
 }
 
+static Scheme_Object *make_require_form(Scheme_Object *module_path, long phase, Scheme_Object *mark)
+{
+  Scheme_Object *e = module_path;
+
+  if (phase != 0) {
+    e = scheme_make_pair(for_meta_symbol,
+                         scheme_make_pair(scheme_make_integer(phase),
+                                          scheme_make_pair(e,
+                                                           scheme_null)));
+  }
+  e = scheme_make_pair(require_stx, scheme_make_pair(e, scheme_null));
+  e = scheme_datum_to_syntax(e, scheme_false, scheme_false, 0, 0);
+
+  e = scheme_add_remove_mark(e, mark);
+
+  return e;
+}
+
+Scheme_Object *scheme_parse_lifted_require(Scheme_Object *module_path,
+                                           long phase,
+                                           Scheme_Object *mark,
+                                           void *data)
+{
+  Scheme_Object *e;
+  Scheme_Object *base_modidx = (Scheme_Object *)((void **)data)[1];
+  Scheme_Env *env = (Scheme_Env *)((void **)data)[2];
+  Scheme_Module *for_m = (Scheme_Module *)((void **)data)[3];
+  Scheme_Object *rns = (Scheme_Object *)((void **)data)[4];
+  Scheme_Object *post_ex_rns = (Scheme_Object *)((void **)data)[5];
+  void *tables = ((void **)data)[6];
+  Scheme_Object *redef_modname = (Scheme_Object *)((void **)data)[7];
+  int *all_simple = (int *)((void **)data)[8];
+
+  e = make_require_form(module_path, phase, mark);
+
+  parse_requires(e, base_modidx, env, for_m,
+                 rns, post_ex_rns,
+                 check_require_name, tables,
+                 redef_modname, 
+                 0, 0, 1, 0,
+                 all_simple);
+
+  return e;
+}
+
+static Scheme_Object *package_require_data(Scheme_Object *base_modidx,
+                                           Scheme_Env *env,
+                                           Scheme_Module *for_m,
+                                           Scheme_Object *rns, Scheme_Object *post_ex_rns,
+                                           void *data,
+                                           Scheme_Object *redef_modname,
+                                           int *all_simple)
+{
+  void **vals;
+
+  vals = MALLOC_N(void*, 9);
+  vals[0] = NULL; /* this slot is available */
+  vals[1] = base_modidx;
+  vals[2] = env;
+  vals[3] = for_m;
+  vals[4] = rns;
+  vals[5] = post_ex_rns;
+  vals[6] = data;
+  vals[7] = redef_modname;
+  vals[8] = all_simple;
+
+  return scheme_make_raw_pair((Scheme_Object *)vals, NULL);
+}
+
+
 static void flush_definitions(Scheme_Env *genv)
 {
   if (genv->syntax) {
@@ -5786,9 +5856,10 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
   Scheme_Object *exclude_hint = scheme_false, *lift_data;
   Scheme_Object **exis, **et_exis, **exsis;
   Scheme_Object *lift_ctx;
+  Scheme_Object *lifted_reqs = scheme_null, *req_data;
   int exicount, et_exicount, exsicount;
   char *exps, *et_exps;
-  int all_simple_renames = 1;
+  int *all_simple_renames;
   int maybe_has_lifts = 0;
   int reprovide_kernel;
   Scheme_Object *redef_modname;
@@ -5931,6 +6002,15 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
   maybe_has_lifts = 0;
   lift_ctx = scheme_generate_lifts_key();
 
+  all_simple_renames = (int *)scheme_malloc_atomic(sizeof(int));
+  *all_simple_renames = 1;
+
+  req_data = package_require_data(self_modidx, env->genv, env->genv->module,
+                                  rn_set, post_ex_rn_set,
+                                  tables,
+                                  redef_modname, 
+                                  all_simple_renames);
+
   /* Pass 1 */
 
   /* Partially expand all expressions, and process definitions, requires,
@@ -5949,7 +6029,8 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
       p = (maybe_has_lifts 
            ? scheme_frame_get_end_statement_lifts(xenv) 
            : scheme_null);
-      scheme_frame_captures_lifts(xenv, scheme_make_lifted_defn, scheme_sys_wraps(xenv), p, lift_ctx);
+      scheme_frame_captures_lifts(xenv, scheme_make_lifted_defn, scheme_sys_wraps(xenv), 
+                                  p, lift_ctx, req_data);
       maybe_has_lifts = 1;
 
       {
@@ -5966,11 +6047,13 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
 	e = scheme_expand_expr(e, xenv, &erec1, 0);	
       }
 
+      lifted_reqs = scheme_append(scheme_frame_get_require_lifts(xenv), lifted_reqs);
+
       fst = scheme_frame_get_lifts(xenv);
       if (!SCHEME_NULLP(fst)) {
 	/* Expansion lifted expressions, so add them to
 	   the front and try again. */
-        all_simple_renames = 0;
+        *all_simple_renames = 0;
 	fm = SCHEME_STX_CDR(fm);
         e = scheme_add_rename(e, post_ex_rn_set);
         fm = scheme_named_map_1(NULL, add_a_rename, fm, post_ex_rn_set);
@@ -6066,7 +6149,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
 	    /* Add a renaming: */
 	    if (!SAME_OBJ(SCHEME_STX_VAL(orig_name), name)) {
 	      scheme_extend_module_rename(post_ex_rn, self_modidx, name, name, self_modidx, name, 0, NULL, NULL, 0);
-              all_simple_renames = 0;
+              *all_simple_renames = 0;
 	    } else
 	      scheme_extend_module_rename(rn, self_modidx, name, name, self_modidx, name, 0, NULL, NULL, 0);
 
@@ -6102,6 +6185,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
 	  
 	  scheme_prepare_exp_env(env->genv);
 	  eenv = scheme_new_comp_env(env->genv->exp_env, env->insp, 0);
+          scheme_frame_captures_lifts(eenv, NULL, NULL, scheme_false, scheme_false, req_data);
 
 	  oenv = (for_stx ? eenv : env);
 	  
@@ -6148,7 +6232,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
 	    if (!SAME_OBJ(SCHEME_STX_VAL(orig_name), name)) {
 	      scheme_extend_module_rename(for_stx ? post_ex_et_rn : post_ex_rn, self_modidx, name, name, self_modidx, name,
 					  for_stx ? 1 : 0, NULL, NULL, 0);
-              all_simple_renames = 0;
+              *all_simple_renames = 0;
 	    } else
 	      scheme_extend_module_rename(for_stx ? et_rn : rn, self_modidx, name, name, self_modidx, name,
 					  for_stx ? 1 : 0, NULL, NULL, 0);
@@ -6186,6 +6270,8 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
 	  }
 	  m = scheme_compile_expr_lift_to_let(code, eenv, &mrec, 0);
 
+          lifted_reqs = scheme_append(scheme_frame_get_require_lifts(eenv), lifted_reqs);
+
 	  oi = scheme_optimize_info_create();
           oi->context = (Scheme_Object *)env->genv->module;
           if (!(rec[drec].comp_flags & COMP_CAN_INLINE))
@@ -6243,7 +6329,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
                          check_require_name, tables,
                          redef_modname, 
                          0, 0, 1, 0,
-                         &all_simple_renames);
+                         all_simple_renames);
 
 	  if (rec[drec].comp)
 	    e = NULL;
@@ -6361,7 +6447,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
       l = (maybe_has_lifts 
            ? scheme_frame_get_end_statement_lifts(cenv) 
            : scheme_null);
-      scheme_frame_captures_lifts(cenv, add_lifted_defn, lift_data, l, lift_ctx);
+      scheme_frame_captures_lifts(cenv, add_lifted_defn, lift_data, l, lift_ctx, req_data);
       maybe_has_lifts = 1;
 
       if (kind == 2)
@@ -6381,6 +6467,8 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
 	e = scheme_expand_expr(e, nenv, &erec1, 0);
       }
 
+      lifted_reqs = scheme_append(scheme_frame_get_require_lifts(xenv), lifted_reqs);
+      
       l = scheme_frame_get_lifts(cenv);
       if (SCHEME_NULLP(l)) {
 	/* No lifts - continue normally */
@@ -6389,7 +6477,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
 	p = SCHEME_CDR(p);
       } else {
 	/* Lifts - insert them and try again */
-        all_simple_renames = 0;
+        *all_simple_renames = 0;
         SCHEME_EXPAND_OBSERVE_MODULE_LIFT_LOOP(observer, scheme_copy_list(l));
 	e = scheme_make_pair(e, scheme_make_integer(0)); /* don't re-compile/-expand */
 	SCHEME_CAR(p) = e;
@@ -6632,7 +6720,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
     env->genv->module->indirect_provides = exis;
     env->genv->module->num_indirect_provides = exicount;
 
-    if (all_simple_renames) {
+    if (*all_simple_renames) {
       env->genv->module->indirect_syntax_provides = exsis;
       env->genv->module->num_indirect_syntax_provides = exsicount;
     } else {
@@ -6645,7 +6733,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
 
     env->genv->module->comp_prefix = cenv->prefix;
 
-    if (all_simple_renames) {
+    if (*all_simple_renames) {
       env->genv->module->rn_stx = scheme_true;
     }
 
@@ -6659,6 +6747,13 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
     }
 
     p = SCHEME_STX_CAR(form);
+
+    /* Add lifted requires */
+    if (!SCHEME_NULLP(lifted_reqs)) {
+      lifted_reqs = scheme_reverse(lifted_reqs);
+      first = scheme_append(lifted_reqs, first);
+    }
+
     return scheme_datum_to_syntax(cons(p, first), form, form, 0, 2);
   }
 }
@@ -9045,7 +9140,7 @@ static Scheme_Object *do_require(Scheme_Object *form, Scheme_Comp_Env *env,
                  0, 0, 0, 0,
                  NULL);
 
-  if (rec[drec].comp) {
+  if (rec && rec[drec].comp) {
     /* Dummy lets us access a top-level environment: */
     dummy = scheme_make_environment_dummy(env);
     
@@ -9071,6 +9166,20 @@ require_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *er
   return do_require(form, env, erec, drec);
 }
 
+Scheme_Object *scheme_toplevel_require_for_expand(Scheme_Object *module_path, 
+                                                  long phase,
+                                                  Scheme_Comp_Env *cenv,
+                                                  Scheme_Object *mark)
+{
+  Scheme_Object *form;
+
+  form = make_require_form(module_path, phase, mark);
+
+  do_require(form, cenv, NULL, 0);
+
+  return form;
+}
+
 /**********************************************************************/
 /*                            dummy forms                             */
 /**********************************************************************/

src/mzscheme/src/schminc.h

@@ -11,9 +11,9 @@
    EXPECTED_PRIM_COUNT to the new value, and then USE_COMPILED_STARTUP
    can be set to 1 again. */
 
-#define USE_COMPILED_STARTUP 1
+#define USE_COMPILED_STARTUP 0
 
-#define EXPECTED_PRIM_COUNT 945
+#define EXPECTED_PRIM_COUNT 946
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP

src/mzscheme/src/schpriv.h

@@ -2065,11 +2065,22 @@ Scheme_Object *scheme_env_frame_uid(Scheme_Comp_Env *env);
 
 typedef Scheme_Object *(*Scheme_Lift_Capture_Proc)(Scheme_Object *, Scheme_Object **, Scheme_Object *, Scheme_Comp_Env *);
 void scheme_frame_captures_lifts(Scheme_Comp_Env *env, Scheme_Lift_Capture_Proc cp, Scheme_Object *data, 
-                                 Scheme_Object *end_stmts, Scheme_Object *context_key);
+                                 Scheme_Object *end_stmts, Scheme_Object *context_key, Scheme_Object *require_lifts);
+void scheme_propagate_require_lift_capture(Scheme_Comp_Env *orig_env, Scheme_Comp_Env *env);
 Scheme_Object *scheme_frame_get_lifts(Scheme_Comp_Env *env);
 Scheme_Object *scheme_frame_get_end_statement_lifts(Scheme_Comp_Env *env);
+Scheme_Object *scheme_frame_get_require_lifts(Scheme_Comp_Env *env);
 Scheme_Object *scheme_generate_lifts_key(void);
 
+Scheme_Object *scheme_toplevel_require_for_expand(Scheme_Object *module_path, 
+                                                  long phase,
+                                                  Scheme_Comp_Env *cenv,
+                                                  Scheme_Object *mark);
+Scheme_Object *scheme_parse_lifted_require(Scheme_Object *module_path,
+                                           long phase,
+                                           Scheme_Object *mark,
+                                           void *data);
+
 void scheme_add_local_syntax(int cnt, Scheme_Comp_Env *env);
 void scheme_set_local_syntax(int pos, Scheme_Object *name, Scheme_Object *val,
 			     Scheme_Comp_Env *env);

src/mzscheme/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "4.1.3.9"
+#define MZSCHEME_VERSION "4.1.3.10"
 
 #define MZSCHEME_VERSION_X 4
 #define MZSCHEME_VERSION_Y 1
 #define MZSCHEME_VERSION_Z 3
-#define MZSCHEME_VERSION_W 9
+#define MZSCHEME_VERSION_W 10
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)