first small step toward cross-module optimization

Mainly propagates constantness for the benefit of keyword
applications, but also propagates simple constants

collects/racket/bool.rkt

@@ -4,16 +4,8 @@
          boolean=?
          symbol=?)
 
-(define-syntax-rule (define-constant id val)
+(define true #t)
-  (...
+(define false #f)
-   (define-syntax id
-     (syntax-id-rules (set!)
-       [(set! id rhs) (set! val rhs)]
-       [(id . args) (val . args)]
-       [_ val]))))
-
-(define-constant true #t)
-(define-constant false #f)
 
 (define (false? v) (eq? v #f))
 

collects/tests/racket/optimize.rktl

@@ -1309,6 +1309,14 @@
               (- (expt 2 31) 2))
            #f)
 
+;; simple cross-module inlining
+(test-comp `(module m racket/base 
+              (require racket/bool)
+              (list true))
+           `(module m racket/base 
+              (require racket/bool)
+              (list #t)))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check bytecode verification of lifted functions
 

src/racket/src/compenv.c

@@ -622,7 +622,13 @@ Scheme_Object *scheme_register_toplevel_in_prefix(Scheme_Object *var, Scheme_Com
   if (o)
     return o;
 
-  o = scheme_make_toplevel(0, cp->num_toplevels, 0, imported ? SCHEME_TOPLEVEL_READY : 0);
+  o = scheme_make_toplevel(0, cp->num_toplevels, 0, 
+                           (imported 
+                            ? (SCHEME_TOPLEVEL_READY 
+                               | ((SCHEME_MODVAR_FLAGS(var) & 0x1)
+                                  ? SCHEME_TOPLEVEL_CONST
+                                  : 0))
+                            : 0));
 
   cp->num_toplevels++;
   scheme_hash_set(ht, var, o);
@@ -877,7 +883,7 @@ static Scheme_Local *get_frame_loc(Scheme_Comp_Env *frame,
 
 Scheme_Object *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modidx, 
 					   Scheme_Object *stxsym, Scheme_Object *insp,
-					   int pos, intptr_t mod_phase)
+					   int pos, intptr_t mod_phase, int is_constant)
 {
   Scheme_Object *val;
   Scheme_Hash_Table *ht;
@@ -905,13 +911,16 @@ Scheme_Object *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modid
       Module_Variable *mv;
       
       mv = MALLOC_ONE_TAGGED(Module_Variable);
-      mv->so.type = scheme_module_variable_type;
+      mv->iso.so.type = scheme_module_variable_type;
       
       mv->modidx = modidx;
       mv->sym = stxsym;
       mv->insp = insp;
       mv->pos = pos;
       mv->mod_phase = (int)mod_phase;
+
+      if (is_constant)
+        SCHEME_MODVAR_FLAGS(mv) |= 0x1;
       
       val = (Scheme_Object *)mv;
       
@@ -1630,7 +1639,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
   int j = 0, p = 0, modpos, skip_stops = 0, module_self_reference = 0;
   Scheme_Bucket *b;
   Scheme_Object *val, *modidx, *modname, *src_find_id, *find_global_id, *mod_defn_phase;
-  Scheme_Object *find_id_sym = NULL, *rename_insp = NULL;
+  Scheme_Object *find_id_sym = NULL, *rename_insp = NULL, *mod_constant = NULL;
   Scheme_Env *genv;
   intptr_t phase;
 
@@ -1857,7 +1866,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
 					find_id, src_find_id, NULL, NULL, rename_insp,
                                         -2, 0, 
 					NULL, NULL,
-                                        env->genv, NULL);
+                                        env->genv, NULL, NULL);
   } else {
     /* Only try syntax table if there's not an explicit (later)
        variable mapping: */
@@ -1880,7 +1889,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
     else
       pos = scheme_check_accessible_in_module(genv, env->insp, in_modidx, 
 					      find_id, src_find_id, NULL, NULL, rename_insp, -1, 1,
-					      _protected, NULL, env->genv, NULL);
+					      _protected, NULL, env->genv, NULL, &mod_constant);
     modpos = (int)SCHEME_INT_VAL(pos);
   } else
     modpos = -1;
@@ -1915,7 +1924,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
         check_taint(src_find_id);
 	return scheme_hash_module_variable(genv, genv->module->self_modidx, find_id, 
 					   genv->module->insp,
-					   -1, genv->mod_phase);
+					   -1, genv->mod_phase, 0);
       }
     } else
       return NULL;
@@ -1923,6 +1932,11 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
 
   check_taint(src_find_id);
 
+  if ((flags & SCHEME_ELIM_CONST) 
+      && mod_constant 
+      && !SAME_OBJ(mod_constant, scheme_void_proc))
+    return mod_constant;
+
   /* Used to have `&& !SAME_OBJ(modidx, modname)' below, but that was a bad
      idea, because it causes module instances to be preserved. */
   if (modname && !(flags & SCHEME_RESOLVE_MODIDS) 
@@ -1934,7 +1948,8 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
     /* Create a module variable reference, so that idx is preserved: */
     return scheme_hash_module_variable(env->genv, modidx, find_id, 
 				       (rename_insp ? rename_insp : genv->module->insp),
-				       modpos, SCHEME_INT_VAL(mod_defn_phase));
+				       modpos, SCHEME_INT_VAL(mod_defn_phase),
+                                       !!mod_constant);
   }
 
   if (!modname 
@@ -1944,7 +1959,8 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
     /* Need to return a variable reference in this case, too. */
     return scheme_hash_module_variable(env->genv, genv->module->self_modidx, find_global_id, 
 				       genv->module->insp,
-				       modpos, genv->mod_phase);
+				       modpos, genv->mod_phase,
+                                       !!mod_constant);
   }
 
   b = scheme_bucket_from_table(genv->toplevel, (char *)find_global_id);

src/racket/src/compile.c

@@ -755,7 +755,7 @@ defn_targets_syntax (Scheme_Object *var, Scheme_Comp_Env *env, Scheme_Compile_In
       /* Create a module variable reference, so that idx is preserved: */
       bucket = scheme_hash_module_variable(env->genv, env->genv->module->self_modidx, 
 					   name, env->genv->module->insp, 
-					   -1, env->genv->mod_phase);
+					   -1, env->genv->mod_phase, 0);
     }
     /* Get indirection through the prefix: */
     bucket = scheme_register_toplevel_in_prefix(bucket, env, rec, drec, 0);
@@ -1396,7 +1396,7 @@ ref_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
         imported = scheme_is_imported(var, env);
 
         if (rec[drec].comp) {
-          var = scheme_register_toplevel_in_prefix(var, env, rec, drec, 0);
+          var = scheme_register_toplevel_in_prefix(var, env, rec, drec, imported);
           if (!imported && env->genv->module && !rec[drec].testing_constantness)
             SCHEME_TOPLEVEL_FLAGS(var) |= SCHEME_TOPLEVEL_MUTATED;
         }
@@ -5126,7 +5126,7 @@ top_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
        preserved within the module. */
     c = scheme_hash_module_variable(env->genv, env->genv->module->self_modidx, 
 				    c, env->genv->module->insp,
-				    -1, env->genv->mod_phase);
+				    -1, env->genv->mod_phase, 0);
   } else {
     c = (Scheme_Object *)scheme_global_bucket(c, env->genv);
   }

src/racket/src/env.c

@@ -1697,7 +1697,7 @@ static Scheme_Object *variable_const_p(int argc, Scheme_Object *argv[])
   if (!SAME_TYPE(SCHEME_TYPE(v), scheme_global_ref_type))
     scheme_wrong_type("variable-reference-constant?", "variable-reference", 0, argc, argv);
 
-  if (SCHEME_PAIR_FLAGS(v) & 0x1)
+  if (SCHEME_VARREF_FLAGS(v) & 0x1)
     return scheme_true;
 
   v = SCHEME_PTR1_VAL(v);

src/racket/src/eval.c

@@ -726,7 +726,8 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx,
 
     if (check_access && !SAME_OBJ(menv, env)) {
       varname = scheme_check_accessible_in_module(menv, insp, NULL, varname, NULL, NULL, 
-                                                  insp, NULL, pos, 0, NULL, NULL, env, NULL);
+                                                  insp, NULL, pos, 0, NULL, NULL, env, NULL,
+                                                  NULL);
     }
   }
 
@@ -1848,8 +1849,8 @@ ref_execute (Scheme_Object *data)
   SCHEME_PTR1_VAL(o) = var;
   SCHEME_PTR2_VAL(o) = (env ? (Scheme_Object *)env : scheme_false);
 
-  if (SCHEME_PAIR_FLAGS(data) & 0x1)
+  if (SCHEME_VARREF_FLAGS(data) & 0x1)
-    SCHEME_PAIR_FLAGS(o) |= 0x1;
+    SCHEME_VARREF_FLAGS(o) |= 0x1;
 
   return o;
 }

src/racket/src/jit.c

@@ -64,7 +64,7 @@ static Scheme_Object *make_global_const_ref(Scheme_Object *var, Scheme_Object *d
   GC_CAN_IGNORE Scheme_Object *o;
 
   o = make_global_ref(var, dummy);
-  SCHEME_PAIR_FLAGS(o) |= 0x1;
+  SCHEME_VARREF_FLAGS(o) |= 0x1;
 
   return o;
 }

src/racket/src/jitinline.c

@@ -431,7 +431,7 @@ static int generate_inlined_constant_varref_test(mz_jit_state *jitter, Scheme_Ob
   GC_CAN_IGNORE jit_insn *ref1, *ref2;
   int pos;
 
-  if (SCHEME_PAIR_FLAGS(obj) & 0x1) {
+  if (SCHEME_VARREF_FLAGS(obj) & 0x1) {
     jit_movi_p(JIT_R0, scheme_true);
     return 1;
   }

src/racket/src/marshal.c

@@ -450,7 +450,7 @@ static Scheme_Object *write_set_bang(Scheme_Object *obj)
 
 Scheme_Object *write_varref(Scheme_Object *o)
 {
-  int is_const = (SCHEME_PAIR_FLAGS(o) & 0x1);
+  int is_const = (SCHEME_VARREF_FLAGS(o) & 0x1);
 
   if (is_const) {
     if (SCHEME_PTR1_VAL(o) != SCHEME_PTR2_VAL(o))
@@ -470,9 +470,10 @@ Scheme_Object *read_varref(Scheme_Object *o)
   data = scheme_alloc_object();
   data->type = scheme_varref_form_type;
   SCHEME_PTR2_VAL(data) = SCHEME_CDR(o);
-  if (SAME_OBJ(SCHEME_CAR(o), scheme_true))
+  if (SAME_OBJ(SCHEME_CAR(o), scheme_true)) {
+    SCHEME_VARREF_FLAGS(data) |= 0x1;
     SCHEME_PTR1_VAL(data) = SCHEME_CDR(o);
-  else
+  } else
     SCHEME_PTR1_VAL(data) = SCHEME_CAR(o);
   
   return data;

src/racket/src/module.c

@@ -3473,9 +3473,43 @@ static void setup_accessible_table(Scheme_Module *m)
           }
         }
 
-        if (!j)
+        if (!j) {
+          /* find constants: */
+          int i, cnt = SCHEME_VEC_SIZE(m->body), k;
+          Scheme_Object *form, *tl;
+
+          for (i = 0; i < cnt; i++) {
+            form = SCHEME_VEC_ELS(m->body)[i];
+            if (SAME_TYPE(SCHEME_TYPE(form), scheme_define_values_type)) {
+              for (k = SCHEME_VEC_SIZE(form); k-- > 1; ) {
+                tl = SCHEME_VEC_ELS(form)[k];
+                if (SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_CONST) {
+                  int pos = SCHEME_TOPLEVEL_POS(tl);
+                  if (pos < m->prefix->num_toplevels) {
+                    tl = m->prefix->toplevels[pos];
+                    if (SCHEME_SYMBOLP(tl)) {
+                      Scheme_Object *v;
+                      v = scheme_hash_get(ht, tl);
+                      if (!v) scheme_signal_error("internal error: defined name inaccessible");
+                      if ((SCHEME_VEC_SIZE(form) == 2)
+                          && scheme_compiled_duplicate_ok(SCHEME_VEC_ELS(form)[0], 1)) {
+                        /* record simple constant from cross-module propagation: */
+                        v = scheme_make_pair(v, SCHEME_VEC_ELS(form)[0]);
+                      } else {
+                        /* record simply that it's constant: */
+                        v = scheme_box(v);
+                      }
+                      scheme_hash_set(ht, tl, v);
+                    } else
+                      scheme_signal_error("internal error: strange defn target %d", SCHEME_TYPE(tl));
+                  }
+                }
+              }
+            }
+          }
+
           m->accessible = ht;
-        else
+        } else
           m->et_accessible = ht;
       }
     }
@@ -3555,7 +3589,8 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
                                                  Scheme_Object *rename_insp,
 						 int position, int want_pos, 
                                                  int *_protected, int *_unexported,
-                                                 Scheme_Env *from_env, int *_would_complain)
+                                                 Scheme_Env *from_env, int *_would_complain,
+                                                 Scheme_Object **_is_constant)
      /* Returns the actual name when !want_pos, needed in case of
 	uninterned names.  Otherwise, returns a position value on success.
 	If position < -1, then merely checks for protected syntax.
@@ -3678,6 +3713,16 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
       else
         pos = NULL;
 
+      if (pos) {
+        if (SCHEME_BOXP(pos)) {
+          if (_is_constant) *_is_constant = scheme_void_proc; /* a hack to indicated "unknown constant" */
+          pos = SCHEME_BOX_VAL(pos);
+        } else if (SCHEME_PAIRP(pos)) {
+          if (_is_constant) *_is_constant = SCHEME_CDR(pos);
+          pos = SCHEME_CAR(pos);
+        }
+      }
+
       if (pos) {
         if (position < -1) {
           if (SCHEME_INT_VAL(pos) < 0)

src/racket/src/optimize.c

@@ -2476,25 +2476,27 @@ static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info, i
   return (Scheme_Object *)s;
 }
 
-int scheme_compiled_duplicate_ok(Scheme_Object *fb)
+int scheme_compiled_duplicate_ok(Scheme_Object *fb, int cross_module)
 {
   return (SCHEME_VOIDP(fb)
 	  || SAME_OBJ(fb, scheme_true)
 	  || SCHEME_FALSEP(fb)
-	  || SCHEME_SYMBOLP(fb)
+	  || (SCHEME_SYMBOLP(fb) && (!cross_module || !SCHEME_SYM_WEIRDP(fb)))
 	  || SCHEME_KEYWORDP(fb)
 	  || SCHEME_EOFP(fb)
 	  || SCHEME_INTP(fb)
 	  || SCHEME_NULLP(fb)
 	  || (SCHEME_CHARP(fb) && (SCHEME_CHAR_VAL(fb) < 256))
 	  || SAME_TYPE(SCHEME_TYPE(fb), scheme_local_type)
-          /* Values that are hashed by the printer to avoid
+          || (!cross_module
-             duplication: */
+              &&
-	  || SCHEME_CHAR_STRINGP(fb) 
+              /* Values that are hashed by the printer to avoid
-          || SCHEME_BYTE_STRINGP(fb)
+                 duplication: */
-          || SAME_TYPE(SCHEME_TYPE(fb), scheme_regexp_type)
+              (SCHEME_CHAR_STRINGP(fb) 
-          || SCHEME_NUMBERP(fb)
+               || SCHEME_BYTE_STRINGP(fb)
-	  || SCHEME_PRIMP(fb));
+               || SAME_TYPE(SCHEME_TYPE(fb), scheme_regexp_type)
+               || SCHEME_NUMBERP(fb)
+               || SCHEME_PRIMP(fb))));
 }
 
 static int equivalent_exprs(Scheme_Object *a, Scheme_Object *b)
@@ -2613,7 +2615,7 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
      for simple constants K. This is useful to expose simple
      tests to the JIT. */
   if (SAME_TYPE(SCHEME_TYPE(t), scheme_branch_type)
-      && scheme_compiled_duplicate_ok(fb)) {
+      && scheme_compiled_duplicate_ok(fb, 0)) {
     Scheme_Branch_Rec *b2 = (Scheme_Branch_Rec *)t;
     if (SCHEME_FALSEP(b2->fbranch)) {
       Scheme_Branch_Rec *b3;
@@ -3130,7 +3132,7 @@ int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator)
 
 int scheme_compiled_propagate_ok(Scheme_Object *value, Optimize_Info *info)
 {
-  if (scheme_compiled_duplicate_ok(value))
+  if (scheme_compiled_duplicate_ok(value, 0))
     return 1;
 
   if (SAME_TYPE(SCHEME_TYPE(value), scheme_compiled_unclosed_procedure_type)) {
@@ -3152,6 +3154,8 @@ int scheme_compiled_propagate_ok(Scheme_Object *value, Optimize_Info *info)
 
 
   if (SAME_TYPE(SCHEME_TYPE(value), scheme_compiled_toplevel_type)) {
+    if (SCHEME_TOPLEVEL_FLAGS(value) & SCHEME_TOPLEVEL_CONST)
+      return 1;
     if (info->top_level_consts) {
       int pos;
       pos = SCHEME_TOPLEVEL_POS(value);
@@ -4962,7 +4966,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
       }
 
       if (c) {
-	if (scheme_compiled_duplicate_ok(c))
+	if (scheme_compiled_duplicate_ok(c, 0))
 	  return c;
 
 	/* We can't inline, but mark the top level as a constant, 
@@ -5239,7 +5243,7 @@ Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *expr, Optimize_I
     return NULL;
   default:
     if (t > _scheme_compiled_values_types_) {
-      if (dup_ok || scheme_compiled_duplicate_ok(expr))
+      if (dup_ok || scheme_compiled_duplicate_ok(expr, 0))
 	return expr;
     }
   }

src/racket/src/read.c

@@ -5053,7 +5053,7 @@ static Scheme_Object *read_compact(CPort *port, int use_stack)
 	pos = read_compact_number(port);
 
 	mv = MALLOC_ONE_TAGGED(Module_Variable);
-	mv->so.type = scheme_module_variable_type;
+	mv->iso.so.type = scheme_module_variable_type;
         if (SCHEME_SYMBOLP(mod))
           mod = scheme_intern_resolved_module_path(mod);
 	mv->modidx = mod;

src/racket/src/resolve.c

@@ -675,12 +675,12 @@ ref_resolve(Scheme_Object *data, Resolve_Info *rslv)
   if (SAME_OBJ(v, scheme_true)
       || SAME_OBJ(v, scheme_false)) {
     if (SCHEME_TRUEP(v))
-      SCHEME_PAIR_FLAGS(data) |= 0x1; /* => constant */
+      SCHEME_VARREF_FLAGS(data) |= 0x1; /* => constant */
     v = SCHEME_PTR2_VAL(data);
   } else if (SAME_TYPE(SCHEME_TYPE(v), scheme_local_type)) {
     v = scheme_resolve_expr(v, rslv);
     if (SAME_TYPE(SCHEME_TYPE(v), scheme_local_type))
-      SCHEME_PAIR_FLAGS(data) |= 0x1; /* because mutable would be unbox */
+      SCHEME_VARREF_FLAGS(data) |= 0x1; /* because mutable would be unbox */
     v = SCHEME_PTR2_VAL(data);
   } else
     v = scheme_resolve_expr(v, rslv);

src/racket/src/schpriv.h

@@ -171,7 +171,7 @@ void scheme_clear_ephemerons(void);
 #define PAIR_FLAG_MASK 0x3
 
 #define SCHEME_PAIR_COPY_FLAGS(dest, src) (SCHEME_PAIR_FLAGS((dest)) |= (SCHEME_PAIR_FLAGS((src)) & PAIR_FLAG_MASK))
-      
+
 
 /*========================================================================*/
 /*                             initialization                             */
@@ -2546,7 +2546,7 @@ Scheme_Object *scheme_optimize_apply_values(Scheme_Object *f, Scheme_Object *e,
                                             int e_single_result,
                                             int context);
 
-int scheme_compiled_duplicate_ok(Scheme_Object *o);
+int scheme_compiled_duplicate_ok(Scheme_Object *o, int cross_mod);
 int scheme_compiled_propagate_ok(Scheme_Object *o, Optimize_Info *info);
 int scheme_is_statically_proc(Scheme_Object *value, Optimize_Info *info);
 Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e);
@@ -3046,13 +3046,17 @@ typedef struct Scheme_Modidx {
 } Scheme_Modidx;
 
 typedef struct Module_Variable {
-  Scheme_Object so; /* scheme_module_variable_type */
+  Scheme_Inclhash_Object iso; /* 0x1 flag => constant */
   Scheme_Object *modidx;
   Scheme_Object *sym;
   Scheme_Object *insp; /* for checking protected/unexported access */
   int pos, mod_phase;
 } Module_Variable;
 
+#define SCHEME_MODVAR_FLAGS(pr) MZ_OPT_HASH_KEY(&((Module_Variable *)pr)->iso)
+
+#define SCHEME_VARREF_FLAGS(pr) MZ_OPT_HASH_KEY(&((Scheme_Simple_Object *)pr)->iso)
+
 void scheme_add_global_keyword(const char *name, Scheme_Object *v, Scheme_Env *env);
 void scheme_add_global_keyword_symbol(Scheme_Object *name, Scheme_Object *v, Scheme_Env *env);
 void scheme_add_global_constant(const char *name, Scheme_Object *v, Scheme_Env *env);
@@ -3100,7 +3104,8 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
                                                  Scheme_Object *rename_insp,
 						 int position, int want_pos,
 						 int *_protected, int *_unexported, 
-                                                 Scheme_Env *from_env, int *_would_complain);
+                                                 Scheme_Env *from_env, int *_would_complain,
+                                                 Scheme_Object **_is_constant);
 void scheme_check_unsafe_accessible(Scheme_Object *insp, Scheme_Env *from_env);
 Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name);
 
@@ -3115,7 +3120,7 @@ int scheme_resolved_module_path_value_matches(Scheme_Object *rmp, Scheme_Object
 
 Scheme_Object *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modidx, 
 					   Scheme_Object *stxsym, Scheme_Object *insp,
-					   int pos, intptr_t mod_phase);
+					   int pos, intptr_t mod_phase, int is_constant);
 
 
 Scheme_Env *scheme_get_kernel_env();