From 4ff341f83715255b750530bacbded677929f2c50 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 22 Jun 2005 21:37:07 +0000
Subject: [PATCH] fixed context for id in lifted defn

svn: r233
---
 src/mzscheme/src/env.c     |  2 +-
 src/mzscheme/src/eval.c    | 12 ++++++------
 src/mzscheme/src/module.c  | 11 +++++++----
 src/mzscheme/src/schpriv.h |  4 ++--
 4 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c
index 99471861c3..4a1ed62ed7 100644
--- a/src/mzscheme/src/env.c
+++ b/src/mzscheme/src/env.c
@@ -3289,7 +3289,7 @@ local_lift_expr(int argc, Scheme_Object *argv[])
 
   expr = scheme_stx_activate_certs(expr);
 
-  expr = cp(data, id, expr, orig_env);
+  expr = cp(data, &id, expr, orig_env);
 
   expr = scheme_make_pair(expr, SCHEME_VEC_ELS(vec)[0]);
   SCHEME_VEC_ELS(vec)[0] = expr;
diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c
index b62e9c88e3..1355efc43d 100644
--- a/src/mzscheme/src/eval.c
+++ b/src/mzscheme/src/eval.c
@@ -2564,7 +2564,7 @@ Scheme_Object *scheme_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
   return scheme_compile_expand_expr(form, env, erec, drec, 0);
 }
 
-static Scheme_Object *pair_lifted(Scheme_Object *_ip, Scheme_Object *id, Scheme_Object *expr, Scheme_Comp_Env *env)
+static Scheme_Object *pair_lifted(Scheme_Object *_ip, Scheme_Object **_id, Scheme_Object *expr, Scheme_Comp_Env *env)
 {
   Scheme_Comp_Env **ip = (Scheme_Comp_Env **)_ip, *naya;
 
@@ -2572,9 +2572,9 @@ static Scheme_Object *pair_lifted(Scheme_Object *_ip, Scheme_Object *id, Scheme_
   (*ip)->next = naya;
   *ip = naya;
 
-  scheme_add_compilation_binding(0, id, naya);
+  scheme_add_compilation_binding(0, *_id, naya);
 
-  return icons(id, icons(expr, scheme_null));
+  return icons(*_id, icons(expr, scheme_null));
 }
 
 static Scheme_Object *compile_expand_expr_lift_to_let_k(void);
@@ -4757,15 +4757,15 @@ Scheme_Object *scheme_get_stop_expander(void)
 }
 
 Scheme_Object *
-scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object *id, Scheme_Object *expr, Scheme_Comp_Env *env)
+scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object **_id, Scheme_Object *expr, Scheme_Comp_Env *env)
 {
   Scheme_Object *l;
 
   /* Registers marked id: */
-  scheme_tl_id_sym(env->genv, id, 2);
+  scheme_tl_id_sym(env->genv, *_id, 2);
 
   l = icons(scheme_datum_to_syntax(define_values_symbol, scheme_false, sys_wraps, 0, 0), 
-	    icons(scheme_make_immutable_pair(id, scheme_null),
+	    icons(scheme_make_immutable_pair(*_id, scheme_null),
 		  icons(expr,
 			scheme_null)));
 
diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c
index 294399ee86..0b75c6333e 100644
--- a/src/mzscheme/src/module.c
+++ b/src/mzscheme/src/module.c
@@ -3449,16 +3449,16 @@ static Scheme_Object *add_req(Scheme_Object *imods, Scheme_Object *requires)
   return requires;
 }
 
-static Scheme_Object *add_lifted_defn(Scheme_Object *data, Scheme_Object *id, Scheme_Object *expr, Scheme_Comp_Env *_env)
+static Scheme_Object *add_lifted_defn(Scheme_Object *data, Scheme_Object **_id, Scheme_Object *expr, Scheme_Comp_Env *_env)
 {
   Scheme_Comp_Env *env;
-  Scheme_Object *self_modidx, *rn, *name;
+  Scheme_Object *self_modidx, *rn, *name, *id;
 
   env = (Scheme_Comp_Env *)SCHEME_VEC_ELS(data)[0];
   self_modidx = SCHEME_VEC_ELS(data)[1];
   rn = SCHEME_VEC_ELS(data)[2];
   
-  name = scheme_tl_id_sym(env->genv, id, 2);
+  name = scheme_tl_id_sym(env->genv, *_id, 2);
 
   /* Create the bucket, indicating that the name will be defined: */
   scheme_add_global_symbol(name, scheme_undefined, env->genv);
@@ -3466,7 +3466,10 @@ static Scheme_Object *add_lifted_defn(Scheme_Object *data, Scheme_Object *id, Sc
   /* Add a renaming: */
   scheme_extend_module_rename(rn, self_modidx, name, name, self_modidx, name, 0);
 
-  return scheme_make_lifted_defn(scheme_sys_wraps(env), id, expr, _env);
+  id = scheme_add_rename(*_id, rn);
+  *_id = id;
+
+  return scheme_make_lifted_defn(scheme_sys_wraps(env), _id, expr, _env);
 }
 
 static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, 
diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h
index 426226c914..dded46d4ae 100644
--- a/src/mzscheme/src/schpriv.h
+++ b/src/mzscheme/src/schpriv.h
@@ -1546,7 +1546,7 @@ Scheme_Object *scheme_add_env_renames(Scheme_Object *stx, Scheme_Comp_Env *env,
 				      Scheme_Comp_Env *upto);
 
 
-typedef Scheme_Object *(*Scheme_Lift_Capture_Proc)(Scheme_Object *, Scheme_Object *, Scheme_Object *, Scheme_Comp_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 *scheme_frame_get_lifts(Scheme_Comp_Env *env);
 
@@ -1785,7 +1785,7 @@ void scheme_ill_formed(Mz_CPort *port);
 extern Scheme_Object *scheme_inferred_name_symbol;
 Scheme_Object *scheme_check_name_property(Scheme_Object *stx, Scheme_Object *current_name);
 
-Scheme_Object *scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object *id, Scheme_Object *expr, Scheme_Comp_Env *env);
+Scheme_Object *scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object **id, Scheme_Object *expr, Scheme_Comp_Env *env);
 
 /*========================================================================*/
 /*                         namespaces and modules                         */