fix struct-out; add -I configuration option

svn: r8530

collects/mzscheme/info.ss

@@ -1,4 +1,5 @@
 
 (module info setup/infotab
   (define name "MzScheme")
-  (define version '(400)))
+  (define version '(400))
+  (define scribblings '(("mzscheme.scrbl" (multi-page)))))

collects/scheme/private/reqprov.ss

@@ -779,8 +779,8 @@
               (raise-syntax-error
                #f
                "expected an identifier for a struct-type name, but found something else"
-               id
+               stx
-               stx))
+               id))
             (let ([v (syntax-local-value id (lambda () #f))])
               (if (struct-info? v)
                   (let* ([v (extract-struct-info v)]
@@ -799,16 +799,49 @@
                                                                  (car super-ids)))
                                          ;; stop because we got to ids that belong to the supertype
                                          null]
-                                        [else (cons (car ids) (loop (cdr ids)))])))])
+                                        [else (cons (car ids) (loop (cdr ids)))])))]
+                         ;; FIXME: we're building a list of all imports on every expansion
+                         ;; of `syntax-out'. That could become expensive if `syntax-out' is
+                         ;; used a lot.
+                         [avail-ids (append (let-values ([(ids _) (syntax-local-module-defined-identifiers)])
+                                              ids)
+                                            (let-values ([(ids _ __)
+                                                          (syntax-local-module-required-identifiers #f #t #f #f)])
+                                              ids))]
+                         [find-imported/defined (lambda (id)
+                                                  (let ([ids (filter (lambda (id2)
+                                                                       (and (free-identifier=? id2 id)
+                                                                            id2))
+                                                                     avail-ids)])
+                                                    (cond
+                                                     [(or (null? ids)
+                                                          (pair? (cdr ids)))
+                                                      (raise-syntax-error
+                                                       #f
+                                                       (if (null? ids)
+                                                           "no import for structure-type identifier"
+                                                           (format "multiple imports (~a~a~a~a) for structure-type identifier"
+                                                                   (syntax-e (car ids))
+                                                                   (if (null? (cddr ids))
+                                                                       " and "
+                                                                       ", ")
+                                                                   (syntax-e (cadr ids))
+                                                                   (if (null? (cddr ids))
+                                                                       ""
+                                                                       ", ...")))
+                                                       stx
+                                                       id)]
+                                                     [else (car ids)])))])
                     (filter
                      values
                      (map (lambda (id)
                             (and id
-                                 (make-export id
+                                 (let ([id (find-imported/defined id)])
-                                              (syntax-e id)
+                                   (make-export id
-                                              'run
+                                                (syntax-e id)
-                                              #f
+                                                'run
-                                              id)))
+                                                #f
+                                                id))))
                           (append
                            (list id
                                  (list-ref v 0)

collects/scribblings/reference/startup.scrbl

@@ -57,7 +57,9 @@ command line does not specify a @scheme[require] flag
 @Flag{u}/@DFlag{require-script}) before any @scheme[eval],
 @scheme[load], or read-eval-print-loop flag (@Flag{e}/@DFlag{eval},
 @Flag{f}/@DFlag{load}, @Flag{r}/@DFlag{script}, @Flag{m}/@DFlag{main},
-@Flag{i}/@DFlag{repl}, or @Flag{z}/@DFlag{text-repl}).
+@Flag{i}/@DFlag{repl}, or @Flag{z}/@DFlag{text-repl}). The
+initialization library can be changed with the @Flag{I}
+@tech{configuration option}.
 
 After potentially loading the initialization module, expression
 @scheme[eval]s, files @scheme[load]s, and module @scheme[require]s are
@@ -171,9 +173,10 @@ flags:
         @scheme[(find-system-path 'init-file)] for
         @Flag{i}/@DFlag{repl} or @Flag{z}/@DFlag{text-repl}.}
 
-  @item{@FlagFirst{n} or @DFlagFirst{no-lib} : Skips requiring
+  @item{@FlagFirst{n} or @DFlagFirst{no-lib} : Skips requiring the
-        @schememodname[scheme/init] or @schememodname[scheme/gui/init]
+        initialization library (i.e., @schememodname[scheme/init] or
-        when not otherwise disabled.}
+        @schememodname[scheme/gui/init], unless it is changed with the
+        @Flag{I} flag) when not otherwise disabled.}
 
   @item{@FlagFirst{v} or @DFlagFirst{version} : Shows
         @scheme[(banner)].}
@@ -196,6 +199,10 @@ flags:
         of compiled byte-code @filepath{.zo} files, by initializing
         @scheme[current-compiled-file-paths] to @scheme[null].}
 
+  @item{@FlagFirst{I} @nonterm{path} : Sets @scheme[(lib #,
+        @nontermstr{path})] as the path to @scheme[require] to initialize
+        the namespace, unless namespace initialization is disabled.}
+
   @item{@FlagFirst{X} @nonterm{dir} or @DFlagFirst{collects}
         @nonterm{dir} : Sets @nonterm{dir} as the path to the main
         collection of libraries by making @scheme[(find-system-path

collects/scribblings/reference/stx-trans.scrbl

@@ -474,7 +474,7 @@ for-syntax) definitions.}
 
 
 @defproc[(syntax-local-module-required-identifiers
-          [mod-path module-path?]
+          [mod-path (or/c module-path? false/c)]
           [normal-imports? any/c]
           [syntax-imports? any/c]
           [label-imports? any/c])
@@ -488,7 +488,8 @@ Can be called only while
 
 It returns three lists of identifiers corresponding to all bindings
 imported into the module being expanded using the module path
-@scheme[mod-path]. This information is used for implementing
+@scheme[mod-path], or all modules if @scheme[mod-path] is
+@scheme[#f]. This information is used for implementing
 @scheme[provide] sub-forms like @scheme[all-from-out].
 
 The first result list corresponds to @tech{phase level} 0 (i.e.,

collects/scribblings/reference/syntax.scrbl

@@ -226,9 +226,11 @@ expander introduces @schemeidfont{#%app} identifiers.
 (#%app cons)
 ]}
 
-@defform[(#%plain-app proc-expr arg-expr ...)]{
+@defform*[[(#%plain-app proc-expr arg-expr ...)
+           (#%plain-app)]]{
+
 Like @scheme[#%app], but without support for keyword arguments.
-}
+As a special case, @scheme[(#%plain-app)] produces @scheme['()].}
 
 @;------------------------------------------------------------------------
 @section[#:tag "lambda"]{Procedure Expressions: @scheme[lambda] and @scheme[case-lambda]}
@@ -1452,9 +1454,11 @@ The syntax of @scheme[provide-spec] can be extended via
 pre-defined forms are as follows.
 
  @specsubform[id]{ Exports @scheme[id], which must be @tech{bound}
- within the module (i.e., either defined or imported) at the relevant @tech{phase
+ within the module (i.e., either defined or imported) at the relevant
- level} 0. The symbolic form of @scheme[id] is used as the external
+ @tech{phase level}. The symbolic form of @scheme[id] is used as the
- name.}
+ external name, and the symbolic form of the defined or imported
+ identifier must match (otherwise, the external name could be
+ ambiguous). }
 
  @defsubform[(all-defined-out)]{ Exports all identifiers that are
  defined at @tech{phase level} 0 or @tech{phase level} 1 within the
@@ -1491,17 +1495,19 @@ pre-defined forms are as follows.
  Like @scheme[provide-spec], but with each symbolic export name from
  @scheme[provide-spec] prefixed with @scheme[prefix-id].}
 
- @defsubform[(struct-out id)]{Exports the bindings associated
+ @defsubform[(struct-out id)]{Exports the bindings associated with a
- with a structure type @scheme[id]. Typically, @scheme[id] is
+ structure type @scheme[id]. Typically, @scheme[id] is bound with
- bound with @scheme[(define-struct id ....)] or
+ @scheme[(define-struct id ....)] or @scheme[(define-struct (id
- @scheme[(define-struct (id super-id) ....)]; more generally,
+ super-id) ....)]; more generally, @scheme[id] must have a
- @scheme[id] must have a @tech{transformer binding} of structure-type
+ @tech{transformer binding} of structure-type information at
- information at @tech{phase level} 0; see @secref["structinfo"].
+ @tech{phase level} 0; see @secref["structinfo"].  Furthermore, for
- If the structure-type information includes a super-type
+ each identifier mentioned in the structure-type information, the
- identifier, and if the identifier has a @tech{transformer
+ enclosing module must define or import one identifier that is
- binding} of structure-type information, the accessor and mutator
+ @scheme[free-identifier=?]. If the structure-type information
- bindings of the super-type are @italic{not} included by
+ includes a super-type identifier, and if the identifier has a
- @scheme[struct-out] for export.}
+ @tech{transformer binding} of structure-type information, the
+ accessor and mutator bindings of the super-type are @italic{not}
+ included by @scheme[struct-out] for export.}
 
  @defsubform[(protect-out provide-spec ...)]{ Like the union of the
  @scheme[provide-spec]s, except that the exports are protected; see

src/mzscheme/cmdline.inc

@@ -208,6 +208,7 @@ typedef struct {
   Scheme_Object *main_args;
 #endif  
   Scheme_Env *global_env;
+  char *init_lib;
 } FinishArgs;
 
 typedef void (*Repl_Proc)(Scheme_Env *);
@@ -222,7 +223,9 @@ static int finish_cmd_line_run(FinishArgs *fa, Repl_Proc repl)
     mz_jmp_buf * volatile save, newbuf;
 
     nsreq = scheme_builtin_value("namespace-require");
-    a[0] = scheme_intern_symbol(INITIAL_NAMESPACE_MODULE);
+    a[0] = scheme_make_pair(scheme_intern_symbol("lib"),
+                            scheme_make_pair(scheme_make_utf8_string(fa->init_lib),
+                                             scheme_make_null()));
 
     p = scheme_get_current_thread();
     save = p->error_buf;
@@ -489,6 +492,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
   int alternate_rep = 0;
   int no_front = 0;
 #endif
+  char *init_lib = INITIAL_NAMESPACE_MODULE;
   int was_config_flag = 0, saw_nc_flag = 0;
   int no_compiled = 0;
   int init_ns = 0, no_init_ns = 0;
@@ -749,6 +753,17 @@ static int run_from_cmd_line(int argc, char *_argv[],
 	  scheme_set_ignore_user_paths(1);
           was_config_flag = 1;
 	  break;
+        case 'I':
+          if (argc < 2) {
+	    PRINTF("%s: missing path after %s switch\n", 
+		   prog, real_switch);
+	    goto show_need_help;
+	  }
+	  argv++;
+	  --argc;
+	  init_lib = argv[0];
+          was_config_flag = 1;
+          break;
 	case 'S':
 	  if (argc < 2) {
 	    PRINTF("%s: missing path after %s switch\n", 
@@ -941,7 +956,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
       /* No args => repl */
       use_repl = 1;
       init_ns = 1;
-    } else if ((argv[0][0] != '-') && !is_number_arg(argv[0] + 1)) {
+    } else if (argv[0][0] != '-') {
       /* No switches => -u mode */
       script_mode = 1;
       no_more_switches = 1;
@@ -1070,6 +1085,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
   fa->a->alternate_rep = alternate_rep;
   fa->a->no_front = no_front;
 #endif
+  fa->init_lib = init_lib;
   fa->global_env = global_env;
 
   scheme_set_can_break(1);
@@ -1111,7 +1127,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
 	 "  -z, --text-repl : Like -i, but use text read-eval-print loop\n"
 # endif
 	 "  -q, --no-init-file : Skip load of " INIT_FILENAME " for " REPL_FLAGS "\n"
-         "  -n, --no-lib : Skip `(require (lib \"" INITIAL_NAMESPACE_MODULE "\"))' for " REPL_FLAGS "/-e/-f/-r\n"
+         "  -n, --no-lib : Skip `(require (lib \"<init-lib>\"))' for " REPL_FLAGS "/-e/-f/-r\n"
 	 "  -v, --version : Show version\n"
 # ifdef CMDLINE_STDIO_FLAG
 	 "  -K, --back : Don't bring application to the foreground (Mac OS X)\n"
@@ -1121,6 +1137,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
 # endif
 	 " Configuration options:\n"
          "  -c, --no-compiled : Disable loading of compiled files\n"
+         "  -I <path> : Set <init-lib> to <path>\n"
 	 "  -X <dir>, --collects <dir> : Main collects at <dir> relative to " PROGRAM "\n"
 	 "  -S <dir>, --search <dir> : More collects at <dir> relative to " PROGRAM "\n"
 	 "  -U, --no-user-path : Ignore user-specific collects, etc.\n"
@@ -1139,13 +1156,14 @@ static int run_from_cmd_line(int argc, char *_argv[],
          " If only configuration options are provided, -i is added\n"
          " If only configuration options are before the first argument, -u is added\n"
          " If -t/-l/-p/-u apears before the first -i/-e/-f/-r, -n is added\n"
+         " <init-lib> defaults to " INITIAL_NAMESPACE_MODULE "\n"
          "Switch syntax:\n"
 	 " Multiple single-letter switches can be collapsed, with arguments placed\n"
 	 "   after the collapsed switches; the first collapsed switch cannot be --\n"
 	 " Example: `-ifve file expr' is the same as `-i -f file -v -e expr'\n"
          "Start-up sequence:\n"
          " 1. Set `current-library-collection-paths'\n"
-         " 2. Require `(lib \"" INITIAL_NAMESPACE_MODULE "\")' [when " REPL_FLAGS "/-e/-f/-r, unless -n]\n"
+         " 2. Require `(lib \"<init-lib>\")' [when " REPL_FLAGS "/-e/-f/-r, unless -n]\n"
          " 3. Evaluate/load expressions/files in order, until first error\n"
          " 4. Load \"" INIT_FILENAME "\" [when " REPL_FLAGS "]\n"
          " 5. Run read-eval-print loop [when " REPL_FLAGS "]\n"

src/mzscheme/src/env.c

@@ -4302,8 +4302,8 @@ local_module_imports(int argc, Scheme_Object *argv[])
     scheme_raise_exn(MZEXN_FAIL_CONTRACT, 
 		     "syntax-local-module-required-identifiers: not currently transforming module provides");
 
-  if (!scheme_is_module_path(argv[0]))
+  if (SCHEME_TRUEP(argv[0]) && !scheme_is_module_path(argv[0]))
-    scheme_wrong_type("syntax-local-module-required-identifiers", "module-path", 0, argc, argv);
+    scheme_wrong_type("syntax-local-module-required-identifiers", "module-path or #f", 0, argc, argv);
   
   return scheme_module_imported_list(scheme_current_thread->current_local_env->genv,
                                      scheme_current_thread->current_local_bindings,

src/mzscheme/src/module.c

@@ -6109,8 +6109,8 @@ int compute_reprovides(Scheme_Hash_Table *_provided, Scheme_Hash_Table *_et_prov
 {
   Scheme_Hash_Table *provided, *required;
   int i, k;
-  Scheme_Object *rx;
+  Scheme_Object *rx, *provided_list;
-  int reprovide_kernel = 0;
+  int reprovide_kernel = 0, all_mods = 0;
   int src_phase_index;
 
   if (phase == MZ_LABEL_PHASE)
@@ -6118,76 +6118,84 @@ int compute_reprovides(Scheme_Hash_Table *_provided, Scheme_Hash_Table *_et_prov
   else
     src_phase_index = phase;
 
+  if (SCHEME_FALSEP(reprovided)) {
+    all_mods = 1;
+    /* more convenient: */
+    reprovided = scheme_make_pair(scheme_false, scheme_null);
+  }
+
   /* First, check the sanity of the re-provide specifications: */
-  for (rx = reprovided; !SCHEME_NULLP(rx); rx = SCHEME_CDR(rx)) {
+  if (!all_mods) {
-    Scheme_Object *midx = SCHEME_CAR(SCHEME_CAR(rx)), *l, *exns;
+    for (rx = reprovided; !SCHEME_NULLP(rx); rx = SCHEME_CDR(rx)) {
+      Scheme_Object *midx = SCHEME_CAR(SCHEME_CAR(rx)), *l, *exns;
 	
-    for (l = requires; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
+      for (l = requires; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
-      if (same_modidx(midx, SCHEME_CAR(l)))
+        if (same_modidx(midx, SCHEME_CAR(l)))
-        break;
+          break;
-    }
-    if (SCHEME_NULLP(l)) {
-      /* Didn't require the named module */
-      if (matching_form) {
-        Scheme_Object *name;
-        name = SCHEME_CAR(rx);
-        name = SCHEME_STX_CDR(name);
-        name = SCHEME_STX_CAR(name);
-        scheme_wrong_syntax("module", 
-                            SCHEME_MODNAMEP(midx) ? midx : ((Scheme_Modidx *)midx)->path, 
-                            name,
-                            "cannot provide from a module without a matching `%s'",
-                            matching_form);
-      } else {
-        return -1;
       }
-    }
+      if (SCHEME_NULLP(l)) {
-
+        /* Didn't require the named module */
-    exns = SCHEME_CDR(SCHEME_CDR(SCHEME_CAR(rx)));
+        if (matching_form) {
-    for (l = exns; !SCHEME_STX_NULLP(l); l = SCHEME_STX_CDR(l)) {
+          Scheme_Object *name;
-      /* Make sure excluded name was required: */
+          name = SCHEME_CAR(rx);
-      Scheme_Object *a, *vec;
+          name = SCHEME_STX_CDR(name);
-      a = SCHEME_STX_VAL(SCHEME_STX_CAR(l));
+          name = SCHEME_STX_CAR(name);
-      for (k = 0; k < 3; k++) {
+          scheme_wrong_syntax("module", 
-        switch (k) {
+                              SCHEME_MODNAMEP(midx) ? midx : ((Scheme_Modidx *)midx)->path, 
-        case 0:
+                              name,
-          required = _required;
+                              "cannot provide from a module without a matching `%s'",
-          break;
+                              matching_form);
-        case 1:
+        } else {
-          required = _et_required;
+          return -1;
-          break;
-        default:
-        case 2:
-          required = _dt_required;
-          break;
         }
-        if (required)
+      }
-          vec = scheme_hash_get(required, a);
+
-        else
+      exns = SCHEME_CDR(SCHEME_CDR(SCHEME_CAR(rx)));
-          vec = NULL;
+      for (l = exns; !SCHEME_STX_NULLP(l); l = SCHEME_STX_CDR(l)) {
-      
+        /* Make sure excluded name was required: */
-        if (vec) {
+        Scheme_Object *a, *vec;
-          /* Check for nominal modidx in list */
+        a = SCHEME_STX_VAL(SCHEME_STX_CAR(l));
-          Scheme_Object *nml, *nml_modidx;
+        for (k = 0; k < 3; k++) {
-          nml = SCHEME_VEC_ELS(vec)[0];
+          switch (k) {
-          for (; SCHEME_PAIRP(nml); nml = SCHEME_CDR(nml)) {
+          case 0:
-            nml_modidx = SCHEME_CAR(nml);
+            required = _required;
-            if (SCHEME_PAIRP(nml_modidx))
+            break;
-              nml_modidx = SCHEME_CAR(nml_modidx);
+          case 1:
-            if (same_modidx(SCHEME_CAR(SCHEME_CAR(rx)), nml_modidx))
+            required = _et_required;
-              break;
+            break;
+          default:
+          case 2:
+            required = _dt_required;
+            break;
+          }
+          if (required)
+            vec = scheme_hash_get(required, a);
+          else
+            vec = NULL;
+      
+          if (vec) {
+            /* Check for nominal modidx in list */
+            Scheme_Object *nml, *nml_modidx;
+            nml = SCHEME_VEC_ELS(vec)[0];
+            for (; SCHEME_PAIRP(nml); nml = SCHEME_CDR(nml)) {
+              nml_modidx = SCHEME_CAR(nml);
+              if (SCHEME_PAIRP(nml_modidx))
+                nml_modidx = SCHEME_CAR(nml_modidx);
+              if (same_modidx(SCHEME_CAR(SCHEME_CAR(rx)), nml_modidx))
+                break;
+            }
+            if (!SCHEME_PAIRP(nml))
+              vec = NULL; /* So it was provided, but not from the indicated module */
           }
-          if (!SCHEME_PAIRP(nml))
-            vec = NULL; /* So it was provided, but not from the indicated module */
-        }
 
-        if (vec)
+          if (vec)
-          break;
+            break;
-      }
+        }
-      if (!vec) {
+        if (!vec) {
-        a = SCHEME_STX_CAR(l);
+          a = SCHEME_STX_CAR(l);
-        scheme_wrong_syntax("module", a, SCHEME_CADR(SCHEME_CAR(rx)),
+          scheme_wrong_syntax("module", a, SCHEME_CADR(SCHEME_CAR(rx)),
-                            "excluded name was not required from the module");
+                              "excluded name was not required from the module");
+        }
       }
     }
   }
@@ -6210,6 +6218,8 @@ int compute_reprovides(Scheme_Hash_Table *_provided, Scheme_Hash_Table *_et_prov
       break;
     }
 
+    provided_list = scheme_null;
+
     if (required) {
       for (i = required->size; i--; ) {
         if (required->vals[i]) {
@@ -6228,7 +6238,7 @@ int compute_reprovides(Scheme_Hash_Table *_provided, Scheme_Hash_Table *_et_prov
               nominal_modidx = SCHEME_CAR(nml);
               if (SCHEME_PAIRP(nominal_modidx))
                 nominal_modidx = SCHEME_CAR(nominal_modidx);
-              if (same_modidx(SCHEME_CAR(SCHEME_CAR(rx)), nominal_modidx)) {
+              if (all_mods || same_modidx(SCHEME_CAR(SCHEME_CAR(rx)), nominal_modidx)) {
                 Scheme_Object *pi, *nml_pi;
 
                 if (SCHEME_PAIRP(SCHEME_CAR(nml))) {
@@ -6241,16 +6251,21 @@ int compute_reprovides(Scheme_Hash_Table *_provided, Scheme_Hash_Table *_et_prov
             
                   Scheme_Object *exns, *ree;
 	      
-                  break_outer = 1;
+                  if (!all_mods) {
-	      
+                    break_outer = 1;
-                  ree = SCHEME_CDR(SCHEME_CAR(rx));
+                  
+                    ree = SCHEME_CDR(SCHEME_CAR(rx));
 
-                  exns = SCHEME_CDR(ree);
+                    exns = SCHEME_CDR(ree);
-                  if (SAME_OBJ(modidx, kernel_modidx))
+                    if (SAME_OBJ(modidx, kernel_modidx))
-                    if (!SCHEME_STX_NULLP(exns)) {
+                      if (!SCHEME_STX_NULLP(exns)) {
-                      if (_exclude_hint)
+                        if (_exclude_hint)
-                        *_exclude_hint = exns;
+                          *_exclude_hint = exns;
-                    }
+                      }
+                  } else {
+                    ree = NULL;
+                    exns = scheme_null;
+                  }
 	    
                   for (; !SCHEME_STX_NULLP(exns); exns = SCHEME_STX_CDR(exns)) {
                     /* Was this name excluded? */
@@ -6263,6 +6278,7 @@ int compute_reprovides(Scheme_Hash_Table *_provided, Scheme_Hash_Table *_et_prov
                   if (SCHEME_STX_NULLP(exns)) {
                     /* Not excluded, so provide it. */
                     if (matching_form) {
+                      /* Assert: !all_mods */
                       check_already_provided(provided, outname, name, 0, SCHEME_CAR(ree), phase);
                       scheme_hash_set(provided, outname, scheme_make_pair(name, scheme_false));
                     } else {
@@ -6284,7 +6300,8 @@ int compute_reprovides(Scheme_Hash_Table *_provided, Scheme_Hash_Table *_et_prov
                       } else {
                         scheme_signal_error("found an import with no lexical context");
                       }
-                      scheme_hash_set(provided, outname, name);
+                      
+                      provided_list = scheme_make_pair(name, provided_list);
                     }
 
                     if (SAME_OBJ(modidx, kernel_modidx) && SAME_OBJ(outname, srcname))
@@ -6297,6 +6314,10 @@ int compute_reprovides(Scheme_Hash_Table *_provided, Scheme_Hash_Table *_et_prov
           }
         }
       }
+
+      if (!matching_form) {
+        scheme_hash_set(provided, scheme_void, provided_list);
+      }
     }
   }
 
@@ -6376,7 +6397,7 @@ Scheme_Object *scheme_module_imported_list(Scheme_Env *genv, Scheme_Object *bind
 {
   Scheme_Hash_Table *ht, *et_ht, *dt_ht, *_ht, *_et_ht, *_dt_ht;
   Scheme_Object *l, *requires, *required, *et_required, *dt_required, *a[3];
-  int v, i, j, phase, inc;
+  int v, i, phase, inc;
 
   _ht = scheme_make_hash_table(SCHEME_hash_ptr);
   _et_ht = scheme_make_hash_table(SCHEME_hash_ptr);
@@ -6423,11 +6444,16 @@ Scheme_Object *scheme_module_imported_list(Scheme_Env *genv, Scheme_Object *bind
     required = SCHEME_VEC_ELS(bindings)[i];
   
     if (inc) {
+      if (SCHEME_FALSEP(modpath))
+        l = scheme_false;
+      else
+        l = scheme_make_pair(scheme_make_pair(modpath,
+                                              scheme_make_pair(scheme_false,
+                                                               scheme_null)),
+                             scheme_null);
+
       v = compute_reprovides(ht, et_ht, dt_ht,
-                             scheme_make_pair(scheme_make_pair(modpath,
+                             l,
-                                                               scheme_make_pair(scheme_false,
-                                                                                scheme_null)),
-                                              scheme_null),
                              requires, 
                              (Scheme_Hash_Table *)required, (Scheme_Hash_Table *)et_required,(Scheme_Hash_Table *)dt_required,
                              genv, NULL, NULL, NULL, 
@@ -6438,13 +6464,9 @@ Scheme_Object *scheme_module_imported_list(Scheme_Env *genv, Scheme_Object *bind
     if (v < 0) {
       l = scheme_false;
     } else {
-      l = scheme_null;
+      l = scheme_hash_get(ht, scheme_void);
-
+      if (!l)
-      for (j = ht->size; j--; ) {
+        l = scheme_null;
-        if (ht->vals[j]) {
-          l = scheme_make_pair(ht->vals[j], l);
-        }
-      }
     }
 
     a[i] = l;