add variable-reference-from-unsafe?

For now, the result is always #f, but this is a bridge to slightly
more useful functionality in the racket7 branch.

Author: mflatt

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "6.12.0.3")
+(define version "6.12.0.4")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/racket-doc/scribblings/reference/namespaces.scrbl

@@ -496,3 +496,22 @@ Returns the declaration @tech{inspector} (see @secref["modprotect"])
 for the module of @racket[varref], where @racket[varref] must refer to
 an anonymous module variable as produced by
 @racket[(#%variable-reference)].}
+
+
+@defproc[(variable-reference-from-unsafe? [varref variable-reference?]) boolean?]{
+
+Returns @racket[#t] if the module of the variable reference itself
+(not necessarily a referenced variable) is compiled in unsafe mode,
+@racket[#f] otherwise. Since unsafe-mode compilation is not currently
+supported, the result is always @racket[#f].
+
+The @racket[variable-reference-from-unsafe?] procedure is intended for
+use as
+
+@racketblock[
+(variable-reference-from-unsafe? (#%variable-reference))
+]
+
+which the compiler can currently optimize to a literal @racket[#f].
+
+@history[#:added "6.12.0.4"]}

racket/src/racket/src/cstartup.inc

@@ -48,6 +48,7 @@ THREAD_LOCAL_DECL(int scheme_starting_up);
 
 /* globals READ-ONLY SHARED */
 Scheme_Object *scheme_varref_const_p_proc;
+Scheme_Object *scheme_varref_from_unsafe_p_proc;
 READ_ONLY static Scheme_Env    *kernel_env;
 READ_ONLY static Scheme_Env    *unsafe_env;
 READ_ONLY static Scheme_Env    *flfxnum_env;
@@ -92,6 +93,7 @@ static Scheme_Object *variable_phase(int, Scheme_Object *[]);
 static Scheme_Object *variable_base_phase(int, Scheme_Object *[]);
 static Scheme_Object *variable_inspector(int, Scheme_Object *[]);
 static Scheme_Object *variable_const_p(int, Scheme_Object *[]);
+static Scheme_Object *variable_unsafe_p(int, Scheme_Object *[]);
 static Scheme_Object *now_transforming(int argc, Scheme_Object *argv[]);
 static Scheme_Object *now_transforming_with_lifts(int argc, Scheme_Object *argv[]);
 static Scheme_Object *now_transforming_module(int argc, Scheme_Object *argv[]);
@@ -767,6 +769,12 @@ static void make_kernel_env(void)
                                                         1, 1);
   scheme_add_global_constant("variable-reference-constant?", scheme_varref_const_p_proc, env);
 
+  REGISTER_SO(scheme_varref_from_unsafe_p_proc);
+  scheme_varref_from_unsafe_p_proc = scheme_make_prim_w_arity(variable_unsafe_p, 
+                                                              "variable-reference-from-unsafe?", 
+                                                              1, 1);
+  scheme_add_global_constant("variable-reference-from-unsafe?", scheme_varref_from_unsafe_p_proc, env);
+
   GLOBAL_PRIM_W_ARITY("syntax-transforming?", now_transforming, 0, 0, env);
   GLOBAL_PRIM_W_ARITY("syntax-transforming-with-lifts?", now_transforming_with_lifts, 0, 0, env);
   GLOBAL_PRIM_W_ARITY("syntax-transforming-module-expression?", now_transforming_module, 0, 0, env);
@@ -2174,6 +2182,18 @@ static Scheme_Object *variable_const_p(int argc, Scheme_Object *argv[])
   return scheme_false;
 }
 
+static Scheme_Object *variable_unsafe_p(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *v;
+
+  v = argv[0];
+
+  if (!SAME_TYPE(SCHEME_TYPE(v), scheme_global_ref_type))
+    scheme_wrong_contract("variable-reference-from-unsafe?", "variable-reference?", 0, argc, argv);
+
+  return scheme_false;
+}
+
 static Scheme_Object *variable_p(int argc, Scheme_Object *argv[])
 {
   Scheme_Env *env;

racket/src/racket/src/env.c

@@ -4490,6 +4490,10 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
       }
     }
 
+    if (SAME_OBJ(scheme_varref_from_unsafe_p_proc, rator)
+        && SAME_TYPE(SCHEME_TYPE(rand), scheme_varref_form_type)) {
+      return replace_tail_inside(scheme_false, inside, app->rand);
+    }
 
     if (SCHEME_PRIMP(rator) && IS_NAMED_PRIM(rator, "zero?")) {
       Scheme_Object* pred;

racket/src/racket/src/optimize.c

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1161
+#define EXPECTED_PRIM_COUNT 1162
 #define EXPECTED_UNSAFE_COUNT 162
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45

racket/src/racket/src/schminc.h

@@ -555,6 +555,7 @@ extern Scheme_Object *scheme_struct_type_p_proc;
 extern Scheme_Object *scheme_current_inspector_proc;
 extern Scheme_Object *scheme_make_inspector_proc;
 extern Scheme_Object *scheme_varref_const_p_proc;
+extern Scheme_Object *scheme_varref_from_unsafe_p_proc;
 extern Scheme_Object *scheme_unsafe_fxnot_proc;
 extern Scheme_Object *scheme_unsafe_fxand_proc;
 extern Scheme_Object *scheme_unsafe_fxior_proc;

racket/src/racket/src/schpriv.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "6.12.0.3"
+#define MZSCHEME_VERSION "6.12.0.4"
 
 #define MZSCHEME_VERSION_X 6
 #define MZSCHEME_VERSION_Y 12
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 3
+#define MZSCHEME_VERSION_W 4
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)