fix missing expansion context for prop:rename-transformer proc

When calling a procedure that is attached as a
`prop:rename-transformer` property value, make sure that
any available expansion context is accessible as reflected by
`(syntax-transforming?)`.

Syntax parameters as rename transformers particularly rely on that
information for local expansion.

Thanks to Jay for the "stxparam.rktl" test.

Closes #1479

pkgs/racket-test-core/tests/racket/macro.rktl

@@ -1665,6 +1665,38 @@
 
 (test '(1 2 3) dynamic-require ''uses-local-lift-values-at-expansion-time 'l)
 
+;; ----------------------------------------
+;; Check that a `prop:rename-transformer` procedure is called in a
+;; `syntax-transforming?` mode when used as an expression
+
+(let ([x 'one]
+      [bad 'bad])
+  (let-syntax ([also-x (let ()
+                         (struct ax ()
+                                 #:property
+                                 prop:rename-transformer
+                                 (lambda (an-ax)
+                                   (make-will-executor)
+                                   (if (syntax-transforming?)
+                                       #'x
+                                       #'bad)))
+                         (ax))])
+    (test 'one values also-x)))
+
+(let ([x 'two]
+      [bad 'bad])
+  (let-syntax ([also-x (let ()
+                         (struct ax ()
+                                 #:property
+                                 prop:rename-transformer
+                                 (lambda (an-ax)
+                                   (make-will-executor)
+                                   (if (syntax-transforming?)
+                                       (syntax-property #'x 'not-free-identifier=? #t)
+                                       #'bad)))
+                         (ax))])
+    (test 'two values also-x)))
+
 ;; ----------------------------------------
 
 (report-errs)

pkgs/racket-test-core/tests/racket/stxparam.rktl

@@ -175,6 +175,36 @@
         (with-handlers ([exn:fail? (λ (x) (exn-message x))])
           (eval #'(syntax-parameterize ([x (make-rename-transformer #'f)]) 1)))))
 
+;; ----------------------------------------
+;; Check rename-transformer stx-param when used as an expression,
+;; which involves calling the `prop:rename-transformer` is a
+;; `syntax-transforming?` mode
+
+(begin
+  (define-syntax (slv stx)
+    (syntax-case stx ()
+      [(_ t)
+       #`'#,(object-name (syntax-local-value #'t))]))
+
+  (define-syntax one (procedure-rename (λ (stx) #'1) 'one))
+  (define-syntax two (procedure-rename (λ (stx) #'2) 'two))
+
+  (define-syntax-parameter normal
+    (make-rename-transformer #'one))
+  (test #f eq? (slv normal) 'one)
+  (test #t = normal 1)
+  (syntax-parameterize ([normal (make-rename-transformer #'two)])
+    (test #f eq? (slv normal) 'two)
+    (test #t = normal 2))
+
+  (define-rename-transformer-parameter rt
+    (make-rename-transformer #'one))
+  (test #t eq? (slv rt) 'one)
+  (test #t = rt 1)
+  (syntax-parameterize ([rt (make-rename-transformer #'two)])
+    (test #t eq? (slv rt) 'two)
+    (test #t = rt 2)))
+
 ;; ----------------------------------------
 
 (report-errs)

racket/src/racket/src/compile.c

@@ -1339,7 +1339,7 @@ set_compile (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec
 	
 	return scheme_compile_expr(form, env, rec, drec);
       } else if (scheme_is_rename_transformer(SCHEME_PTR_VAL(var))) {
-	find_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(var));
+	find_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(var), env);
 	SCHEME_USE_FUEL(1);
 	menv = NULL;
       } else
@@ -1435,7 +1435,7 @@ set_expand(Scheme_Object *orig_form, Scheme_Comp_Env *env, Scheme_Expand_Info *e
 	return scheme_expand_expr(form, env, erec, drec);
       } else if (scheme_is_rename_transformer(SCHEME_PTR_VAL(var))) {
 	Scheme_Object *new_name;
-	new_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(var));
+	new_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(var), env);
 	new_name = scheme_stx_track(new_name, find_name, find_name);
 	find_name = new_name;
 	menv = NULL;
@@ -3602,7 +3602,7 @@ void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object
     if (scheme_is_binding_rename_transformer(SCHEME_PTR_VAL(macro))) {
       /* Rebind to the target identifier's binding */
       scheme_add_binding_copy(name,
-                              scheme_rename_transformer_id(SCHEME_PTR_VAL(macro)),
+                              scheme_rename_transformer_id(SCHEME_PTR_VAL(macro), rhs_env),
                               scheme_make_integer(stx_env->genv->phase));
     }
   }
@@ -4363,7 +4363,7 @@ Scheme_Object *scheme_check_immediate_macro(Scheme_Object *first,
           if (scheme_is_rename_transformer(SCHEME_PTR_VAL(val))) {
             /* It's a rename. Look up the target name and try again. */
             Scheme_Object *new_name;
-            new_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(val));
+            new_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(val), env);
             if (!rec[drec].comp)
               new_name = scheme_stx_track(new_name, name, name);
             name = scheme_transfer_srcloc(new_name, name);
@@ -4570,7 +4570,7 @@ compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
                                                 scheme_frame_to_expansion_context_symbol(env->flags))) {
             /* It's a rename. Look up the target name and try again. */
             Scheme_Object *new_name;
-            new_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(var));
+            new_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(var), env);
             if (!rec[drec].comp) {
               new_name = scheme_stx_track(new_name, find_name, find_name);
             }
@@ -4701,7 +4701,7 @@ compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
                                                 scheme_frame_to_expansion_context_symbol(env->flags))) {
             /* It's a rename. Look up the target name and try again. */
             Scheme_Object *new_name;
-            new_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(var));
+            new_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(var), env);
             if (!rec[drec].comp) {
               new_name = scheme_stx_track(new_name, find_name, find_name);
             }
@@ -4800,7 +4800,7 @@ compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
         if (scheme_expansion_contexts_include(SCHEME_PTR_VAL(var),
                                               scheme_frame_to_expansion_context_symbol(env->flags))) {
           Scheme_Object *new_name;
-          new_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(var));
+          new_name = scheme_rename_transformer_id(SCHEME_PTR_VAL(var), env);
           if (!rec[drec].comp) {
             new_name = scheme_stx_track(new_name, find_name, find_name);
           }

racket/src/racket/src/env.c

@@ -1623,7 +1623,7 @@ void scheme_shadow(Scheme_Env *env, Scheme_Object *n, Scheme_Object *val, int as
   /* If the binding is a rename transformer, also install 
      a mapping */
   if (scheme_is_binding_rename_transformer(val))
-    scheme_add_binding_copy(id, scheme_rename_transformer_id(val), scheme_env_phase(env));
+    scheme_add_binding_copy(id, scheme_rename_transformer_id(val, NULL), scheme_env_phase(env));
 }
 
 static void install_one_binding_name(Scheme_Hash_Table *bt, Scheme_Object *name, Scheme_Object *id, Scheme_Env *benv)
@@ -2361,7 +2361,7 @@ do_local_exp_time_value(const char *name, int argc, Scheme_Object *argv[], int r
     
     v = SCHEME_PTR_VAL(v);
     if (scheme_is_rename_transformer(v)) {
-      sym = scheme_transfer_srcloc(scheme_rename_transformer_id(v), sym);
+      sym = scheme_transfer_srcloc(scheme_rename_transformer_id(v, NULL), sym);
       renamed = 1;
       menv = NULL;
       SCHEME_USE_FUEL(1);
@@ -2984,7 +2984,7 @@ rename_transformer_target(int argc, Scheme_Object *argv[])
   if (!scheme_is_rename_transformer(argv[0]))
     scheme_wrong_contract("rename-transformer-target", "rename-transformer?", 0, argc, argv);
 
-  return scheme_rename_transformer_id(argv[0]);
+  return scheme_rename_transformer_id(argv[0], NULL);
 }
 
 static Scheme_Object *

racket/src/racket/src/fun.c

@@ -1924,7 +1924,7 @@ scheme_apply_macro(Scheme_Object *name, Scheme_Env *menv,
   if (scheme_is_rename_transformer(rator)) {
     Scheme_Object *scope;
    
-    rator = scheme_rename_transformer_id(rator);
+    rator = scheme_rename_transformer_id(rator, env);
     /* rator is now an identifier */
 
     /* and it's introduced by this expression: */

racket/src/racket/src/module.c

@@ -6693,7 +6693,7 @@ static void eval_exptime(Scheme_Object *names, int count,
           if (SCHEME_TRUEP(ids_for_rename_trans)
               && scheme_is_binding_rename_transformer(values[i])) {
             scheme_add_binding_copy(SCHEME_CAR(ids_for_rename_trans),
-                                    scheme_rename_transformer_id(values[i]),
+                                    scheme_rename_transformer_id(values[i], NULL),
                                     scheme_make_integer(at_phase-1));
           }
           scheme_add_to_table(syntax, (const char *)name, macro, 0);
@@ -6714,7 +6714,7 @@ static void eval_exptime(Scheme_Object *names, int count,
       if (SCHEME_TRUEP(ids_for_rename_trans)
           && scheme_is_binding_rename_transformer(vals)) {
         scheme_add_binding_copy(SCHEME_CAR(ids_for_rename_trans),
-                                scheme_rename_transformer_id(vals),
+                                scheme_rename_transformer_id(vals, NULL),
                                 scheme_make_integer(at_phase-1));
       }
       scheme_add_to_table(syntax, (const char *)name, macro, 0);

racket/src/racket/src/schpriv.h

@@ -2149,6 +2149,7 @@ Scheme_Object *scheme_all_current_continuation_marks(void);
 
 void scheme_about_to_move_C_stack(void);
 
+Scheme_Object *scheme_apply_with_dynamic_state(Scheme_Object *rator, int num_rands, Scheme_Object **rands, Scheme_Dynamic_State *dyn_state);
 Scheme_Object *scheme_apply_multi_with_dynamic_state(Scheme_Object *rator, int num_rands, Scheme_Object **rands, Scheme_Dynamic_State *dyn_state);
 
 Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands, 
@@ -3681,7 +3682,7 @@ Scheme_Object *scheme_make_marshal_shared(Scheme_Object *v);
 
 int scheme_is_rename_transformer(Scheme_Object *o);
 int scheme_is_binding_rename_transformer(Scheme_Object *o);
-Scheme_Object *scheme_rename_transformer_id(Scheme_Object *o);
+Scheme_Object *scheme_rename_transformer_id(Scheme_Object *o, Scheme_Comp_Env *env);
 int scheme_is_set_transformer(Scheme_Object *o);
 Scheme_Object *scheme_set_transformer_proc(Scheme_Object *o);
 

racket/src/racket/src/struct.c

@@ -1885,7 +1885,7 @@ int scheme_is_rename_transformer(Scheme_Object *o)
 int scheme_is_binding_rename_transformer(Scheme_Object *o)
 {
   if (scheme_is_rename_transformer(o)) {
-    o = scheme_rename_transformer_id(o);
+    o = scheme_rename_transformer_id(o, NULL);
     o = scheme_stx_property(o, not_free_id_symbol, NULL);
     if (o && SCHEME_TRUEP(o))
       return 0;
@@ -1898,7 +1898,7 @@ static int is_stx_id(Scheme_Object *o) { return (SCHEME_STXP(o) && SCHEME_SYMBOL
 
 static int is_stx_id_or_proc_1(Scheme_Object *o) { return (is_stx_id(o) || is_proc_1(o)); }
 
-Scheme_Object *scheme_rename_transformer_id(Scheme_Object *o)
+Scheme_Object *scheme_rename_transformer_id(Scheme_Object *o, Scheme_Comp_Env *comp_env)
 {
   Scheme_Object *a[1];
 
@@ -1911,7 +1911,18 @@ Scheme_Object *scheme_rename_transformer_id(Scheme_Object *o)
       a[0] = o;
       /* apply a continuation barrier here to prevent a capture in
        * the property access */
+      if (comp_env && (scheme_current_thread->current_local_env != comp_env)) {
+        /* Getting identifier during an expansion context */
+        Scheme_Dynamic_State dyn_state;
+        Scheme_Env *genv = comp_env->genv;
+        scheme_set_dynamic_state(&dyn_state, comp_env, NULL, NULL, scheme_false,
+                                 genv, (genv->module
+                                        ? (genv->link_midx ? genv->link_midx : genv->module->me->src_modidx)
+                                        : NULL));
+        v = scheme_apply_with_dynamic_state(v, 1, a, &dyn_state);
+      } else {
         v = scheme_apply(v, 1, a);
+      }
       if (!is_stx_id(v)) {
         scheme_contract_error("prop:rename-transformer",
                               "contract violation for given value",