allow gensym' and string->uninterned-symbol' in cross-phase persistent

pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax-model.scrbl

@@ -1004,7 +1004,8 @@ and only if no module-level binding is @racket[set!]ed.
             #%plain-lambda case-lambda begin
             set! quote-syntax quote with-continuation-mark
             #%plain-app
-            cons list make-struct-type make-struct-type-property)
+            cons list make-struct-type make-struct-type-property
+            gensym string->uninterned-symbol)
 [cross-module (module id module-path
                 (#%plain-module-begin
                   cross-form ...))]
@@ -1022,7 +1023,10 @@ and only if no module-level binding is @racket[set!]ed.
                 (#%plain-app list cross-expr ...+)
                 (#%plain-app make-struct-type cross-expr ...+)
                 (#%plain-app make-struct-type-property
-                             cross-expr ...+)]
+                             cross-expr ...+)
+                (#%plain-app gensym)
+                (#%plain-app gensym string)
+                (#%plain-app string->uninterned-symbol string)]
 [cross-datum     number
                  boolean
                  identifier

pkgs/racket-pkgs/racket-test/tests/racket/cross-phase.rkt

@@ -25,6 +25,7 @@
 (check-cross-phase #t '(define-values (x) cons))
 (check-cross-phase #t '(define-values (x) (cons 1 2)))
 (check-cross-phase #t '(define-values (x) (list 1 2)))
+(check-cross-phase #t '(define-values (x) (#%app list 1 2)))
 (check-cross-phase #t '(define-values (x) (cons 1 '())))
 (check-cross-phase #t '(#%require racket/tcp))
 (check-cross-phase #t '(define-values (x) (lambda (x) x)))
@@ -36,6 +37,13 @@
 (check-cross-phase #t '(begin
                          (define-values (x) 5)
                          (define-values (y) 6)))
+(check-cross-phase #t '(define-values (x) (gensym)))
+(check-cross-phase #t '(define-values (x) (gensym "s")))
+(check-cross-phase #t '(define-values (x) (gensym '"s")))
+(check-cross-phase #t '(define-values (x) (#%app gensym '"s")))
+(check-cross-phase #t '(define-values (x) (string->uninterned-symbol "s")))
+(check-cross-phase #t '(define-values (x) (string->uninterned-symbol '"s")))
+(check-cross-phase #t '(define-values (x) (#%app string->uninterned-symbol '"s")))
 
 (check-cross-phase #f '(define-values (x) #(x)))
 (check-cross-phase #f '(define-values (x) '(x)))
@@ -47,6 +55,8 @@
 (check-cross-phase #f '(define-values (x) (lambda () (if #f (#%variable-reference) 10))))
 (check-cross-phase #f '(define-values (x) (#%variable-reference x)))
 (check-cross-phase #f '(#%require racket/base))
+(check-cross-phase #f '(define-values (x) (gensym 1)))
+(check-cross-phase #f '(define-values (x) (string->uninterned-symbol)))
 
 (check-cross-phase #t '(module* sub #f (vector 1 2 3)))
 (check-cross-phase #t '(module* sub #f (#%variable-reference)))

racket/src/racket/src/module.c

@@ -246,6 +246,8 @@ READ_ONLY static Scheme_Object *make_struct_type_stx;
 READ_ONLY static Scheme_Object *make_struct_type_property_stx;
 READ_ONLY static Scheme_Object *list_stx;
 READ_ONLY static Scheme_Object *cons_stx;
+READ_ONLY static Scheme_Object *gensym_stx;
+READ_ONLY static Scheme_Object *string_to_uninterned_symbol_stx;
 
 READ_ONLY static Scheme_Object *empty_self_modidx;
 READ_ONLY static Scheme_Object *empty_self_modname;
@@ -687,11 +689,16 @@ void scheme_finish_kernel(Scheme_Env *env)
   REGISTER_SO(make_struct_type_property_stx);
   REGISTER_SO(cons_stx);
   REGISTER_SO(list_stx);
+  REGISTER_SO(gensym_stx);
+  REGISTER_SO(string_to_uninterned_symbol_stx);
 
   make_struct_type_stx = scheme_datum_to_syntax(scheme_intern_symbol("make-struct-type"), scheme_false, w, 0, 0);
   make_struct_type_property_stx = scheme_datum_to_syntax(scheme_intern_symbol("make-struct-type-property"), scheme_false, w, 0, 0);
   cons_stx = scheme_datum_to_syntax(scheme_intern_symbol("cons"), scheme_false, w, 0, 0);
   list_stx = scheme_datum_to_syntax(scheme_intern_symbol("list"), scheme_false, w, 0, 0);
+  gensym_stx = scheme_datum_to_syntax(scheme_intern_symbol("gensym"), scheme_false, w, 0, 0);
+  string_to_uninterned_symbol_stx = scheme_datum_to_syntax(scheme_intern_symbol("string->uninterned-symbol"), 
+                                                           scheme_false, w, 0, 0);
 
   REGISTER_SO(prefix_symbol);
   REGISTER_SO(only_symbol);
@@ -11329,10 +11336,7 @@ static int expression_starts_app(Scheme_Object *expr, Scheme_Object *id, int pha
 {
   if (expression_starts(expr, app_stx, phase)) {
     expr = SCHEME_STX_CDR(expr);
-    if (SCHEME_STX_PAIRP(expr)) {
+    return expression_starts(expr, id, phase);
-      expr = SCHEME_STX_CDR(expr);
-      return expression_starts(expr, id, phase);
-    }
   } else if (expression_starts(expr, id, phase)) {
     /* would explicit `#%app' be the core one? */
     id = scheme_datum_to_syntax(SCHEME_STX_VAL(app_stx), expr, expr, 0, 0);
@@ -11344,6 +11348,15 @@ static int expression_starts_app(Scheme_Object *expr, Scheme_Object *id, int pha
   return 0;
 }
 
+static Scheme_Object *expression_app_args(Scheme_Object *expr, int phase)
+{
+  if (expression_starts(expr, app_stx, phase)) {
+    expr = SCHEME_STX_CDR(expr);
+    return SCHEME_STX_CDR(expr);
+  } else
+    return SCHEME_STX_CDR(expr);
+}
+
 static int phaseless_literal(Scheme_Object *val)
 {
   val = SCHEME_STX_VAL(val);
@@ -11436,10 +11449,36 @@ static int phaseless_constant_expression(Scheme_Object *val, int phase)
   
   if (expression_starts_app(val, cons_stx, phase)
       || expression_starts_app(val, list_stx, phase)) {
-    val = SCHEME_STX_CDR(val);
+    val = expression_app_args(val, phase);
     return phaseless_constant_expressions(val, phase);
   }
 
+  return 0;
+}
+
+static int expression_string_argument(Scheme_Object *val, int phase)
+{
+  Scheme_Object *a, *av;
+
+  if (SCHEME_STX_PAIRP(val)) {
+    a = SCHEME_STX_CAR(val);
+    val = SCHEME_STX_CDR(val);
+    if (SCHEME_STX_NULLP(val)) {
+      av = SCHEME_STX_VAL(a);
+      if (SCHEME_CHAR_STRINGP(av)
+          && phaseless_constant_expression(a, phase))
+        return 1;
+      else if (expression_starts(a, quote_stx, phase)) {
+        val = SCHEME_STX_CDR(a);
+        if (SCHEME_STX_PAIRP(val)) {
+          val = SCHEME_STX_CAR(val);
+          a = SCHEME_STX_VAL(val);
+          if (SCHEME_CHAR_STRINGP(a))
+            return 1;
+        }
+      }
+    }
+  }
 
   return 0;
 }
@@ -11449,6 +11488,17 @@ static int phaseless_rhs(Scheme_Object *val, int var_count, int phase)
   if (var_count == 1) {
     if (phaseless_constant_expression(val, phase))
       return 1;
+    else if (expression_starts_app(val, gensym_stx, phase)) {
+      val = expression_app_args(val, phase);
+      if (SCHEME_STX_NULLP(val))
+        return 1;
+      else if (expression_string_argument(val, phase))
+        return 1;
+    } else if (expression_starts_app(val, string_to_uninterned_symbol_stx, phase)) {
+      val = expression_app_args(val, phase);
+      if (expression_string_argument(val, phase))
+        return 1;
+    }
   } else if (var_count == 5) {
     if (expression_starts_app(val, make_struct_type_stx, phase)
         && phaseless_constant_expressions(val, phase)) {