add `exn:fail:{filesystem,syntax}:missing-module'

These exception types are intended as a hook for a programming
environment to recommend packages that can provide a module that isn't
found (through an uncaught-exception handler). The new exceptions are
generated by the default module name resolver and defaultload
handler. In addition to the exceptions, there's a new
`prop:exn:missing-module' property and `exn:missing-module?', which is
what an environment should use to detect relevant exceptions.

There's also a new `current-module-path-for-load' parameter, which
just provides a commuincation path from the module name resolver to
the the load handler. The parameter is a relatively ugly piece of the
puzzle, but it's the best I could find to squash the new functionality
into the existing stack of handlers.

collects/racket/private/kernstruct.rkt

@@ -211,6 +211,28 @@
           '(#f #f #f)
           (quote-syntax exn:fail:syntax)))
        (λ () (quote-syntax kernel:exn:fail:syntax:unbound)))))
+  (begin
+    (#%require
+     (rename '#%kernel
+             kernel:exn:fail:syntax:missing-module
+             exn:fail:syntax:missing-module))
+    (define make-exn:fail:syntax:missing-module
+      kernel:exn:fail:syntax:missing-module)
+    (define-syntax exn:fail:syntax:missing-module
+      (make-self-ctr-struct-info
+       (λ ()
+         (list
+          (quote-syntax struct:exn:fail:syntax:missing-module)
+          (quote-syntax make-exn:fail:syntax:missing-module)
+          (quote-syntax exn:fail:syntax:missing-module?)
+          (list
+           (quote-syntax exn:fail:syntax:missing-module-path)
+           (quote-syntax exn:fail:syntax-exprs)
+           (quote-syntax exn-continuation-marks)
+           (quote-syntax exn-message))
+          '(#f #f #f #f)
+          (quote-syntax exn:fail:syntax)))
+       (λ () (quote-syntax kernel:exn:fail:syntax:missing-module)))))
   (begin
     (#%require (rename '#%kernel kernel:exn:fail:read exn:fail:read))
     (define make-exn:fail:read kernel:exn:fail:read)
@@ -339,6 +361,27 @@
           '(#f #f #f)
           (quote-syntax exn:fail:filesystem)))
        (λ () (quote-syntax kernel:exn:fail:filesystem:errno)))))
+  (begin
+    (#%require
+     (rename '#%kernel
+             kernel:exn:fail:filesystem:missing-module
+             exn:fail:filesystem:missing-module))
+    (define make-exn:fail:filesystem:missing-module
+      kernel:exn:fail:filesystem:missing-module)
+    (define-syntax exn:fail:filesystem:missing-module
+      (make-self-ctr-struct-info
+       (λ ()
+         (list
+          (quote-syntax struct:exn:fail:filesystem:missing-module)
+          (quote-syntax make-exn:fail:filesystem:missing-module)
+          (quote-syntax exn:fail:filesystem:missing-module?)
+          (list
+           (quote-syntax exn:fail:filesystem:missing-module--path)
+           (quote-syntax exn-continuation-marks)
+           (quote-syntax exn-message))
+          '(#f #f #f)
+          (quote-syntax exn:fail:filesystem)))
+       (λ () (quote-syntax kernel:exn:fail:filesystem:missing-module)))))
   (begin
     (#%require (rename '#%kernel kernel:exn:fail:network exn:fail:network))
     (define make-exn:fail:network kernel:exn:fail:network)

collects/scribblings/reference/exns.scrbl

@@ -615,6 +615,7 @@ exn
       exn:fail:contract:variable
     exn:fail:syntax
       exn:fail:syntax:unbound
+      exn:fail:syntax:missing-module
     exn:fail:read
       exn:fail:read:eof
       exn:fail:read:non-char
@@ -622,6 +623,7 @@ exn
       exn:fail:filesystem:exists
       exn:fail:filesystem:version
       exn:fail:filesystem:errno
+      exn:fail:filesystem:missing-module
     exn:fail:network
       exn:fail:network:errno
     exn:fail:out-of-memory
@@ -677,7 +679,9 @@ or @tech{module-level variable}.}
 
 Raised for a syntax error that is not a @racket[read] error. The
 @racket[exprs] indicate the relevant source expressions,
-least-specific to most-specific.}
+least-specific to most-specific.
+
+This structure type implements the @racket[prop:exn:srclocs] property.}
 
 @defstruct[(exn:fail:syntax:unbound exn:fail:syntax) ()
            #:inspector #f]{
@@ -685,6 +689,22 @@ least-specific to most-specific.}
 Raised by @racket[#%top] or @racket[set!] for an
 unbound identifier within a module.}
 
+@defstruct[(exn:fail:syntax:missing-module exn:fail:syntax) ([path module-path?])
+           #:inspector #f]{
+
+Raised by the default @tech{module name resolver} or default
+@tech{load handler} to report a module path---a reported in the
+@racket[path] field---whose implementation file cannot be
+found.
+
+The default @tech{module name resolver} raises this exception only
+when it is given a syntax object as its second argument, and the
+default @tech{load handler} raises this exception only when the value
+of @racket[current-module-path-for-load] is a syntax object (in which
+case both the @racket[exprs] field and the @racket[path] field
+are determined by the syntax object.
+
+This structure type implements the @racket[prop:exn:missing-module] property.}
 
 @defstruct[(exn:fail:read exn:fail) ([srclocs (listof srcloc?)])
            #:inspector #f]{
@@ -735,6 +755,21 @@ code (under Windows, only), and @racket['gai] indicates a
 hostnames, but it allowed in @racket[exn:fail:filesystem:errno]
 instances for consistency).}
 
+@defstruct[(exn:fail:filesystem:missing-module exn:fail:filesystem) ([path module-path?])
+           #:inspector #f]{
+
+Raised by the default @tech{module name resolver} or default
+@tech{load handler} to report a module path---a reported in the
+@racket[path] field---whose implementation file cannot be
+found.
+
+The default @tech{module name resolver} raises this exception only
+when it is @emph{not} given a syntax object as its second argument, and the
+default @tech{load handler} raises this exception only when the value
+of @racket[current-module-path-for-load] is @emph{not} a syntax object.
+
+This structure type implements the @racket[prop:exn:missing-module] property.}
+
 @defstruct[(exn:fail:network exn:fail) ()
            #:inspector #f]{
 
@@ -892,3 +927,24 @@ The fields of a @racket[srcloc] instance are as follows:
  0) or @racket[#f] (unknown).}
 
 ]}
+
+
+@defthing[prop:exn:missing-module struct-type-property?]{
+
+A property that identifies structure types that provide a module path
+for a load that fails because a module is not found.
+
+The property value must be a procedure that accepts a single
+value---the structure type instance from which to extract source
+locations---and returns a @tech{module path}.}
+
+@defproc[(exn:missing-module? [v any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[v] has the @racket[prop:exn:missing-module]
+property, @racket[#f] otherwise.}
+
+
+@defproc[(exn:missing-module-accessor [v exn:srclocs?])
+         (exn:missing-module? . -> . module-path?)]{
+
+Returns the @tech{module path}-getting procedure associated with @racket[v].}

collects/scribblings/reference/module-reflect.scrbl

@@ -171,6 +171,18 @@ is @racket[#f], the module's name (as determined by
 @racket[current-module-declare-name]) is used as the source name
 instead of the parameter value.}
 
+
+@defparam[current-module-path-for-load path (or/c #f module-path? 
+                                                  (and/c syntax? 
+                                                         (lambda (stx)
+                                                           (module-path? (syntax->datum s)))))]{
+
+A @tech{parameter} that determines a module path used for
+@racket[exn:fail:syntax:missing-module] and
+@racket[exn:fail:filesytem:missing-module] exceptions as raised by the
+default @tech{load handler}.  The parameter is normally set by a
+@tech{module name resolver}.}
+
 @;------------------------------------------------------------------------
 @section[#:tag "modpathidx"]{Compiled Modules and References}
 

doc/release-notes/racket/HISTORY.txt

@@ -1,3 +1,8 @@
+Version 5.3.4.4
+Added current-module-path-for-load, exn:fail:syntax:missing-module, 
+  exn:fail:filesystem:missing-module, prop:exn:missing-module,
+  exn:missing-module?, and exn:missing-module-accessor
+
 Version 5.3.4.3
 Added make-environment-variables
 Changed initialization of current-directory to use PWD

src/racket/include/scheme.h

@@ -1372,6 +1372,7 @@ enum {
   MZCONFIG_CURRENT_MODULE_RESOLVER,
   MZCONFIG_CURRENT_MODULE_NAME,
   MZCONFIG_CURRENT_MODULE_SRC,
+  MZCONFIG_CURRENT_MODULE_LOAD_PATH,
 
   MZCONFIG_ERROR_PRINT_SRCLOC,
 

src/racket/src/error.c

@@ -257,6 +257,7 @@ Scheme_Config *scheme_init_error_escape_proc(Scheme_Config *config)
   %V = scheme_value
   %@ = list of scheme_value to write splice
   %D = scheme value to display
+  %W = scheme value to write
   %_ = skip pointer
   %- = skip int
 
@@ -336,6 +337,7 @@ static intptr_t sch_vsprintf(char *s, intptr_t maxlen, const char *msg, va_list
       case 'V':
       case '@':
       case 'D':
+      case 'W':
       case 'T':
       case 'Q':
       case '_':
@@ -578,6 +580,15 @@ static intptr_t sch_vsprintf(char *s, intptr_t maxlen, const char *msg, va_list
             tlen = dlen;
 	  }
 	  break;
+	case 'W':
+	  {
+	    Scheme_Object *o;
+            intptr_t dlen;
+	    o = (Scheme_Object *)ptrs[pp++];
+	    t = scheme_write_to_string(o, &dlen);
+            tlen = dlen;
+	  }
+	  break;
         case '_':
           {
             pp++;
@@ -4365,6 +4376,24 @@ static Scheme_Object *errno_field_check(int argc, Scheme_Object **argv)
   return scheme_values (3, argv);
 }
 
+static Scheme_Object *module_path_field_check(int pos, int argc, Scheme_Object **argv)
+{
+  if (!scheme_is_module_path(argv[pos]))
+    scheme_wrong_field_contract(argv[pos+1], "(or/c #f module-path?)", argv[pos]);
+
+  return scheme_values (pos+1, argv);
+}
+
+static Scheme_Object *module_path_field_check_2(int argc, Scheme_Object **argv)
+{
+  return module_path_field_check(2, argc, argv);
+}
+
+static Scheme_Object *module_path_field_check_3(int argc, Scheme_Object **argv)
+{
+  return module_path_field_check(3, argc, argv);
+}
+
 static Scheme_Object *extract_syntax_locations(int argc, Scheme_Object **argv)
 {
   if (scheme_is_struct_instance(exn_table[MZEXN_FAIL_SYNTAX].type, argv[0])) {
@@ -4401,6 +4430,32 @@ static Scheme_Object *extract_read_locations(int argc, Scheme_Object **argv)
   return NULL;
 }
 
+static Scheme_Object *extract_module_path(int pos, int argc, Scheme_Object **argv,
+                                          int exn_kind, const 
+                                          char *accessor_name, const char *contract)
+{
+  if (scheme_is_struct_instance(exn_table[exn_kind].type, argv[0]))
+    return scheme_struct_ref(argv[0], pos);
+  scheme_wrong_contract(accessor_name, contract, 0, argc, argv);
+  return NULL;
+}
+
+static Scheme_Object *extract_module_path_2(int argc, Scheme_Object **argv)
+{
+  return extract_module_path(2, argc, argv,
+                             MZEXN_FAIL_FILESYSTEM_MISSING_MODULE,
+                             "exn:fail:filesystem:missing-module:path-accessor", 
+                             "exn:fail:filesystem:missing-module?");
+}
+
+static Scheme_Object *extract_module_path_3(int argc, Scheme_Object **argv)
+{
+  return extract_module_path(3, argc, argv,
+                             MZEXN_FAIL_SYNTAX_MISSING_MODULE,
+                             "exn:fail:syntax:missing-module:path-accessor", 
+                             "exn:fail:syntax:missing-module?");
+}
+
 void scheme_init_exn(Scheme_Env *env)
 {
   int i, j;

src/racket/src/file.c

@@ -3939,7 +3939,7 @@ static Scheme_Object *copy_file(int argc, Scheme_Object **argv)
     Scheme_Object *a[2], * volatile in, * volatile out;
 
     reason = NULL;
-    in = scheme_do_open_input_file("copy-file", 0, 1, argv, 1, &reason, &err_val);
+    in = scheme_do_open_input_file("copy-file", 0, 1, argv, 1, &reason, &err_val, 0);
     if (!in) {
       has_err_val = !!err_val;
       goto failed;

src/racket/src/makeexn

@@ -48,7 +48,11 @@ propeties (the latter in curly braces), strings are contracts/comments.
                     {exn:source scheme_source_property |scheme_make_prim(extract_syntax_locations)|}]
                    "syntax error, but not a \\scmfirst{read} error"
                    (unbound []
-                            "unbound module variable"))
+                            "unbound module variable")
+                   (missing-module [module_path_field_check_3
+                                    (path "module path" "module path")
+                                    {exn:module-path scheme_module_path_property |scheme_make_prim(extract_module_path_3)|}]
+                                   "error resolving a module path"))
            (read [read_field_check
                   (srclocs "immutable list of \\scmk{srcloc}s (see \\SecRef{linecol})" "source location(s) of error")
                   {exn:source scheme_source_property  |scheme_make_prim(extract_read_locations)|}]
@@ -60,7 +64,11 @@ propeties (the latter in curly braces), strings are contracts/comments.
                        (version [] "version mismatch loading an extension")
                        (errno [errno_field_check
                                (errno "pair of symbol and number" "system error code")]
-                              "error with system error code"))
+                              "error with system error code")
+                       (missing-module [module_path_field_check_2
+                                        (-path "module path" "module path")
+                                        {exn:module-path scheme_module_path_property |scheme_make_prim(extract_module_path_2)|}]
+                                       "error resolving a module path"))
            (network [] "TCP and UDP errors"
                     (errno [errno_field_check
                             (errno "pair of symbol and number" "system error code")]

src/racket/src/module.c

@@ -46,6 +46,7 @@ SHARED_OK static mzrt_mutex *modpath_table_mutex;
 static Scheme_Object *current_module_name_resolver(int argc, Scheme_Object *argv[]);
 static Scheme_Object *current_module_name_prefix(int argc, Scheme_Object *argv[]);
 static Scheme_Object *current_module_name_source(int argc, Scheme_Object *argv[]);
+static Scheme_Object *current_module_load_path(int argc, Scheme_Object *argv[]);
 static Scheme_Object *dynamic_require_for_syntax(int argc, Scheme_Object *argv[]);
 static Scheme_Object *namespace_require(int argc, Scheme_Object *argv[]);
 static Scheme_Object *namespace_require_copy(int argc, Scheme_Object *argv[]);
@@ -428,6 +429,7 @@ void scheme_init_module(Scheme_Env *env)
   GLOBAL_PARAMETER("current-module-name-resolver",  current_module_name_resolver, MZCONFIG_CURRENT_MODULE_RESOLVER, env);
   GLOBAL_PARAMETER("current-module-declare-name",   current_module_name_prefix,   MZCONFIG_CURRENT_MODULE_NAME,     env);
   GLOBAL_PARAMETER("current-module-declare-source", current_module_name_source,   MZCONFIG_CURRENT_MODULE_SRC,      env);
+  GLOBAL_PARAMETER("current-module-path-for-load",  current_module_load_path,     MZCONFIG_CURRENT_MODULE_LOAD_PATH, env);
 
   GLOBAL_PRIM_W_ARITY("dynamic-require",                  scheme_dynamic_require,     2, 3, env);
   GLOBAL_PRIM_W_ARITY("dynamic-require-for-syntax",       dynamic_require_for_syntax, 2, 3, env);
@@ -1036,6 +1038,28 @@ current_module_name_source(int argc, Scheme_Object *argv[])
 			     -1, source_p, "symbol, complete path, or #f", 1);
 }
 
+static Scheme_Object *load_path_p(int argc, Scheme_Object **argv)
+{
+  Scheme_Object *o = argv[0];
+  
+  if (!SCHEME_FALSEP(o)
+      && !scheme_is_module_path(o)
+      && (!SCHEME_STXP(o)
+          || !scheme_is_module_path(scheme_syntax_to_datum(o, 0, NULL))))
+    return NULL;
+
+  return o;
+}
+
+static Scheme_Object *
+current_module_load_path(int argc, Scheme_Object *argv[])
+{
+  return scheme_param_config("current-module-path-for-load",
+			     scheme_make_integer(MZCONFIG_CURRENT_MODULE_LOAD_PATH),
+			     argc, argv,
+			     -1, load_path_p, "module path, module path as syntax, or #f", 1);
+}
+
 /**********************************************************************/
 /*                            procedures                              */
 /**********************************************************************/

src/racket/src/port.c

@@ -4491,11 +4491,12 @@ Scheme_Object *scheme_terminal_port_p(int argc, Scheme_Object *argv[])
   return is_fd_terminal(fd) ? scheme_true : scheme_false;
 }
 
-static void filename_exn(char *name, char *msg, char *filename, int err)
+static void filename_exn(char *name, char *msg, char *filename, int err, int maybe_module_errno)
 {
   char *dir, *drive;
   int len;
   char *pre, *rel, *post;
+  Scheme_Object *mod_path, *mp;
 
   len = strlen(filename);
 
@@ -4514,6 +4515,38 @@ static void filename_exn(char *name, char *msg, char *filename, int err)
   rel = dir ? dir : (drive ? drive : "");
   post = dir ? "" : "";
 
+  if (maybe_module_errno && (err == maybe_module_errno)) {
+    mod_path = scheme_get_param(scheme_current_config(), MZCONFIG_CURRENT_MODULE_LOAD_PATH);
+    if (SCHEME_TRUEP(mod_path)) {
+      if (SCHEME_STXP(mod_path)) {
+        mp = scheme_syntax_to_datum(mod_path, 0, NULL);
+        scheme_raise_exn(MZEXN_FAIL_SYNTAX_MISSING_MODULE,
+                         scheme_make_pair(mod_path, scheme_null),
+                         mp,
+                         "%s: %s\n"
+                         "  module path: %W\n"
+                         "  path: %q%s%q%s\n"
+                         "  system error: " FILENAME_EXN_E,
+                         name, "cannot open module file", 
+                         mp, filename,
+                         pre, rel, post,
+                         err);
+      } else {
+        scheme_raise_exn(MZEXN_FAIL_FILESYSTEM_MISSING_MODULE,
+                         mod_path,
+                         "%s: %s\n"
+                         "  module path: %W\n"
+                         "  path: %q%s%q%s\n"
+                         "  system error: " FILENAME_EXN_E,
+                         name, "cannot open module file", 
+                         mod_path, filename,
+                         pre, rel, post,
+                         err);
+      }
+      return;
+    }
+  }
+
   scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
 		   "%s: %s\n"
                    "  path: %q%s%q%s\n"
@@ -4525,7 +4558,7 @@ static void filename_exn(char *name, char *msg, char *filename, int err)
 
 Scheme_Object *
 scheme_do_open_input_file(char *name, int offset, int argc, Scheme_Object *argv[], 
-                          int internal, char **err, int *eerrno)
+                          int internal, char **err, int *eerrno, int for_module)
 {
 #ifdef USE_FD_PORTS
   int fd;
@@ -4601,7 +4634,7 @@ scheme_do_open_input_file(char *name, int offset, int argc, Scheme_Object *argv[
       *err = "cannot open source file";
       *eerrno = errno;
     } else
-      filename_exn(name, "cannot open input file", filename, errno);
+      filename_exn(name, "cannot open input file", filename, errno, (for_module ? ENOENT : 0));
     return NULL;
   } else {
     int ok;
@@ -4619,7 +4652,7 @@ scheme_do_open_input_file(char *name, int offset, int argc, Scheme_Object *argv[
         *err = "source is a directory";
         *eerrno = 0;
       } else
-        filename_exn(name, "cannot open directory as a file", filename, 0);
+        filename_exn(name, "cannot open directory as a file", filename, 0, 0);
       return NULL;
     } else {
       regfile = S_ISREG(buf.st_mode);
@@ -4643,14 +4676,14 @@ scheme_do_open_input_file(char *name, int offset, int argc, Scheme_Object *argv[
       *err = "cannot open source file";
       *eerrno = errv;
     } else
-      filename_exn(name, "cannot open input file", filename, GetLastError());
+      filename_exn(name, "cannot open input file", filename, GetLastError(), (for_module ? ERROR_FILE_NOT_FOUND : 0));
     return NULL;
   } else
     regfile = (GetFileType(fd) == FILE_TYPE_DISK);
 
   if ((mode[1] == 't') && !regfile) {
     CloseHandle(fd);
-    filename_exn(name, "cannot use text-mode on a non-file device", filename, 0);
+    filename_exn(name, "cannot use text-mode on a non-file device", filename, 0, 0);
     return NULL;
   }
 
@@ -4661,7 +4694,7 @@ scheme_do_open_input_file(char *name, int offset, int argc, Scheme_Object *argv[
       *err = "source is a directory";
       *eerrno = 0;
     } else
-      filename_exn(name, err, filename, 0);
+      filename_exn(name, err, filename, 0, 0);
     return NULL;
   }
 
@@ -4673,7 +4706,7 @@ scheme_do_open_input_file(char *name, int offset, int argc, Scheme_Object *argv[
       *err = "cannot open source file";
       *eerrno = errno;
     } else
-      filename_exn(name, "cannot open input file", filename, errno);
+      filename_exn(name, "cannot open input file", filename, errno, (for_module ? ENOENT : 0));
     return NULL;
   }
 
@@ -4877,7 +4910,7 @@ scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv
         *err = "cannot open destination file";
         *eerrno = errno;
       } else
-        filename_exn(name, "cannot open output file", filename, errno);
+        filename_exn(name, "cannot open output file", filename, errno, 0);
       return NULL;
     }
   }
@@ -5077,7 +5110,7 @@ Scheme_Object *scheme_open_input_file(const char *name, const char *who)
   Scheme_Object *a[1];
 
   a[0]= scheme_make_path(name);
-  return scheme_do_open_input_file((char *)who, 0, 1, a, 0, NULL, NULL);
+  return scheme_do_open_input_file((char *)who, 0, 1, a, 0, NULL, NULL, 0);
 }
 
 Scheme_Object *scheme_open_output_file(const char *name, const char *who)

src/racket/src/portfun.c

@@ -2542,7 +2542,7 @@ make_output_port (int argc, Scheme_Object *argv[])
 static Scheme_Object *
 open_input_file (int argc, Scheme_Object *argv[])
 {
-  return scheme_do_open_input_file("open-input-file", 0, argc, argv, 0, NULL, NULL);
+  return scheme_do_open_input_file("open-input-file", 0, argc, argv, 0, NULL, NULL, 0);
 }
 
 static Scheme_Object *
@@ -2731,7 +2731,7 @@ call_with_input_file(int argc, Scheme_Object *argv[])
 
   scheme_check_proc_arity("call-with-input-file", 1, 1, argc, argv);
 
-  port = scheme_do_open_input_file("call-with-input-file", 1, argc, argv, 0, NULL, NULL);
+  port = scheme_do_open_input_file("call-with-input-file", 1, argc, argv, 0, NULL, NULL, 0);
 
   v = _scheme_apply_multi(argv[1], 1, &port);
 
@@ -2802,7 +2802,7 @@ with_input_from_file(int argc, Scheme_Object *argv[])
 
   scheme_check_proc_arity("with-input-from-file", 0, 1, argc, argv);
 
-  port = scheme_do_open_input_file("with-input-from-file", 1, argc, argv, 0, NULL, NULL);
+  port = scheme_do_open_input_file("with-input-from-file", 1, argc, argv, 0, NULL, NULL, 0);
 
   config = scheme_extend_config(scheme_current_config(),
 				MZCONFIG_INPUT_PORT,
@@ -4724,7 +4724,7 @@ static Scheme_Object *default_load(int argc, Scheme_Object *argv[])
                           "(or/c #f symbol? (cons/c (or/c #f symbol?) (non-empty-listof symbol?)))",
                           1, argc, argv);
 
-  port = scheme_do_open_input_file("default-load-handler", 0, 1, argv, 0, NULL, NULL);
+  port = scheme_do_open_input_file("default-load-handler", 0, 1, argv, 0, NULL, NULL, SCHEME_TRUEP(expected_module));
 
   /* Turn on line/column counting, unless it's a .zo file: */
   if (SCHEME_PATHP(argv[0])) {

src/racket/src/read.c

@@ -5715,7 +5715,7 @@ Scheme_Object *scheme_load_delayed_code(int _which, Scheme_Load_Delay *_delay_in
     scheme_release_file_descriptor();
 
     a[0] = delay_info->path;
-    port = scheme_do_open_input_file("on-demand-loader", 0, 1, a, 0, NULL, NULL);
+    port = scheme_do_open_input_file("on-demand-loader", 0, 1, a, 0, NULL, NULL, 0);
 
     savebuf = scheme_current_thread->error_buf;
     scheme_current_thread->error_buf = &newbuf;

src/racket/src/schexn.h

@@ -12,6 +12,7 @@ enum {
   MZEXN_FAIL_CONTRACT_VARIABLE,
   MZEXN_FAIL_SYNTAX,
   MZEXN_FAIL_SYNTAX_UNBOUND,
+  MZEXN_FAIL_SYNTAX_MISSING_MODULE,
   MZEXN_FAIL_READ,
   MZEXN_FAIL_READ_EOF,
   MZEXN_FAIL_READ_NON_CHAR,
@@ -19,6 +20,7 @@ enum {
   MZEXN_FAIL_FILESYSTEM_EXISTS,
   MZEXN_FAIL_FILESYSTEM_VERSION,
   MZEXN_FAIL_FILESYSTEM_ERRNO,
+  MZEXN_FAIL_FILESYSTEM_MISSING_MODULE,
   MZEXN_FAIL_NETWORK,
   MZEXN_FAIL_NETWORK_ERRNO,
   MZEXN_FAIL_OUT_OF_MEMORY,
@@ -33,7 +35,7 @@ enum {
 
 #ifdef _MZEXN_TABLE
 
-#define MZEXN_MAXARGS 3
+#define MZEXN_MAXARGS 4
 
 #ifdef GLOBAL_EXN_ARRAY
 static exn_rec exn_table[] = {
@@ -47,21 +49,23 @@ static exn_rec exn_table[] = {
   { 3, NULL, NULL, 0, NULL, 2 },
   { 3, NULL, NULL, 0, NULL, 1 },
   { 3, NULL, NULL, 0, NULL, 8 },
+  { 4, NULL, NULL, 0, NULL, 8 },
   { 3, NULL, NULL, 0, NULL, 1 },
-  { 3, NULL, NULL, 0, NULL, 10 },
+  { 3, NULL, NULL, 0, NULL, 11 },
-  { 3, NULL, NULL, 0, NULL, 10 },
+  { 3, NULL, NULL, 0, NULL, 11 },
   { 2, NULL, NULL, 0, NULL, 1 },
-  { 2, NULL, NULL, 0, NULL, 13 },
+  { 2, NULL, NULL, 0, NULL, 14 },
-  { 2, NULL, NULL, 0, NULL, 13 },
+  { 2, NULL, NULL, 0, NULL, 14 },
-  { 3, NULL, NULL, 0, NULL, 13 },
+  { 3, NULL, NULL, 0, NULL, 14 },
+  { 3, NULL, NULL, 0, NULL, 14 },
   { 2, NULL, NULL, 0, NULL, 1 },
-  { 3, NULL, NULL, 0, NULL, 17 },
+  { 3, NULL, NULL, 0, NULL, 19 },
   { 2, NULL, NULL, 0, NULL, 1 },
   { 2, NULL, NULL, 0, NULL, 1 },
   { 2, NULL, NULL, 0, NULL, 1 },
   { 3, NULL, NULL, 0, NULL, 0 },
-  { 3, NULL, NULL, 0, NULL, 22 },
+  { 3, NULL, NULL, 0, NULL, 24 },
-  { 3, NULL, NULL, 0, NULL, 22 }
+  { 3, NULL, NULL, 0, NULL, 24 }
 };
 #else
 static exn_rec *exn_table;
@@ -83,6 +87,7 @@ static exn_rec *exn_table;
   exn_table[MZEXN_FAIL_CONTRACT_VARIABLE].args = 3;
   exn_table[MZEXN_FAIL_SYNTAX].args = 3;
   exn_table[MZEXN_FAIL_SYNTAX_UNBOUND].args = 3;
+  exn_table[MZEXN_FAIL_SYNTAX_MISSING_MODULE].args = 4;
   exn_table[MZEXN_FAIL_READ].args = 3;
   exn_table[MZEXN_FAIL_READ_EOF].args = 3;
   exn_table[MZEXN_FAIL_READ_NON_CHAR].args = 3;
@@ -90,6 +95,7 @@ static exn_rec *exn_table;
   exn_table[MZEXN_FAIL_FILESYSTEM_EXISTS].args = 2;
   exn_table[MZEXN_FAIL_FILESYSTEM_VERSION].args = 2;
   exn_table[MZEXN_FAIL_FILESYSTEM_ERRNO].args = 3;
+  exn_table[MZEXN_FAIL_FILESYSTEM_MISSING_MODULE].args = 3;
   exn_table[MZEXN_FAIL_NETWORK].args = 2;
   exn_table[MZEXN_FAIL_NETWORK_ERRNO].args = 3;
   exn_table[MZEXN_FAIL_OUT_OF_MEMORY].args = 2;
@@ -106,15 +112,19 @@ static exn_rec *exn_table;
   static const char *MZEXN_FIELDS[2] = { "message", "continuation-marks" };
   static const char *MZEXN_FAIL_CONTRACT_VARIABLE_FIELDS[1] = { "id" };
   static const char *MZEXN_FAIL_SYNTAX_FIELDS[1] = { "exprs" };
+  static const char *MZEXN_FAIL_SYNTAX_MISSING_MODULE_FIELDS[1] = { "path" };
   static const char *MZEXN_FAIL_READ_FIELDS[1] = { "srclocs" };
   static const char *MZEXN_FAIL_FILESYSTEM_ERRNO_FIELDS[1] = { "errno" };
+  static const char *MZEXN_FAIL_FILESYSTEM_MISSING_MODULE_FIELDS[1] = { "-path" };
   static const char *MZEXN_FAIL_NETWORK_ERRNO_FIELDS[1] = { "errno" };
   static const char *MZEXN_BREAK_FIELDS[1] = { "continuation" };
 #endif
 
 #ifdef _MZEXN_DECL_PROPS
 #  define MZEXN_FAIL_SYNTAX_PROPS scheme_make_pair(scheme_make_pair(scheme_source_property, scheme_make_prim(extract_syntax_locations)), scheme_null)
+#  define MZEXN_FAIL_SYNTAX_MISSING_MODULE_PROPS scheme_make_pair(scheme_make_pair(scheme_module_path_property, scheme_make_prim(extract_module_path_3)), scheme_null)
 #  define MZEXN_FAIL_READ_PROPS scheme_make_pair(scheme_make_pair(scheme_source_property, scheme_make_prim(extract_read_locations)), scheme_null)
+#  define MZEXN_FAIL_FILESYSTEM_MISSING_MODULE_PROPS scheme_make_pair(scheme_make_pair(scheme_module_path_property, scheme_make_prim(extract_module_path_2)), scheme_null)
 #endif
 
 #ifdef _MZEXN_SETUP
@@ -128,6 +138,7 @@ static exn_rec *exn_table;
   SETUP_STRUCT(MZEXN_FAIL_CONTRACT_VARIABLE, EXN_PARENT(MZEXN_FAIL_CONTRACT), "exn:fail:contract:variable", 1, MZEXN_FAIL_CONTRACT_VARIABLE_FIELDS, scheme_null, scheme_make_prim(variable_field_check))
   SETUP_STRUCT(MZEXN_FAIL_SYNTAX, EXN_PARENT(MZEXN_FAIL), "exn:fail:syntax", 1, MZEXN_FAIL_SYNTAX_FIELDS, MZEXN_FAIL_SYNTAX_PROPS, scheme_make_prim(syntax_field_check))
   SETUP_STRUCT(MZEXN_FAIL_SYNTAX_UNBOUND, EXN_PARENT(MZEXN_FAIL_SYNTAX), "exn:fail:syntax:unbound", 0, NULL, scheme_null, NULL)
+  SETUP_STRUCT(MZEXN_FAIL_SYNTAX_MISSING_MODULE, EXN_PARENT(MZEXN_FAIL_SYNTAX), "exn:fail:syntax:missing-module", 1, MZEXN_FAIL_SYNTAX_MISSING_MODULE_FIELDS, MZEXN_FAIL_SYNTAX_MISSING_MODULE_PROPS, scheme_make_prim(module_path_field_check_3))
   SETUP_STRUCT(MZEXN_FAIL_READ, EXN_PARENT(MZEXN_FAIL), "exn:fail:read", 1, MZEXN_FAIL_READ_FIELDS, MZEXN_FAIL_READ_PROPS, scheme_make_prim(read_field_check))
   SETUP_STRUCT(MZEXN_FAIL_READ_EOF, EXN_PARENT(MZEXN_FAIL_READ), "exn:fail:read:eof", 0, NULL, scheme_null, NULL)
   SETUP_STRUCT(MZEXN_FAIL_READ_NON_CHAR, EXN_PARENT(MZEXN_FAIL_READ), "exn:fail:read:non-char", 0, NULL, scheme_null, NULL)
@@ -135,6 +146,7 @@ static exn_rec *exn_table;
   SETUP_STRUCT(MZEXN_FAIL_FILESYSTEM_EXISTS, EXN_PARENT(MZEXN_FAIL_FILESYSTEM), "exn:fail:filesystem:exists", 0, NULL, scheme_null, NULL)
   SETUP_STRUCT(MZEXN_FAIL_FILESYSTEM_VERSION, EXN_PARENT(MZEXN_FAIL_FILESYSTEM), "exn:fail:filesystem:version", 0, NULL, scheme_null, NULL)
   SETUP_STRUCT(MZEXN_FAIL_FILESYSTEM_ERRNO, EXN_PARENT(MZEXN_FAIL_FILESYSTEM), "exn:fail:filesystem:errno", 1, MZEXN_FAIL_FILESYSTEM_ERRNO_FIELDS, scheme_null, scheme_make_prim(errno_field_check))
+  SETUP_STRUCT(MZEXN_FAIL_FILESYSTEM_MISSING_MODULE, EXN_PARENT(MZEXN_FAIL_FILESYSTEM), "exn:fail:filesystem:missing-module", 1, MZEXN_FAIL_FILESYSTEM_MISSING_MODULE_FIELDS, MZEXN_FAIL_FILESYSTEM_MISSING_MODULE_PROPS, scheme_make_prim(module_path_field_check_2))
   SETUP_STRUCT(MZEXN_FAIL_NETWORK, EXN_PARENT(MZEXN_FAIL), "exn:fail:network", 0, NULL, scheme_null, NULL)
   SETUP_STRUCT(MZEXN_FAIL_NETWORK_ERRNO, EXN_PARENT(MZEXN_FAIL_NETWORK), "exn:fail:network:errno", 1, MZEXN_FAIL_NETWORK_ERRNO_FIELDS, scheme_null, scheme_make_prim(errno_field_check))
   SETUP_STRUCT(MZEXN_FAIL_OUT_OF_MEMORY, EXN_PARENT(MZEXN_FAIL), "exn:fail:out-of-memory", 0, NULL, scheme_null, NULL)

src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1093
+#define EXPECTED_PRIM_COUNT 1105
 #define EXPECTED_UNSAFE_COUNT 100
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45

src/racket/src/schpriv.h

@@ -899,6 +899,7 @@ Scheme_Object *scheme_print_attribute_ref(Scheme_Object *s);
 #define SCHEME_STRUCT_INSPECTOR(obj) (((Scheme_Structure *)obj)->stype->inspector)
 
 extern Scheme_Object *scheme_source_property;
+extern Scheme_Object *scheme_module_path_property;
 
 Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_count);
 Scheme_Object *scheme_make_blank_prefab_struct_instance(Scheme_Struct_Type *stype);
@@ -3794,7 +3795,7 @@ void scheme_flush_orig_outputs(void);
 Scheme_Object *scheme_file_stream_port_p(int, Scheme_Object *[]);
 Scheme_Object *scheme_terminal_port_p(int, Scheme_Object *[]);
 Scheme_Object *scheme_do_open_input_file(char *name, int offset, int argc, Scheme_Object *argv[], 
-                                         int internal, char **err, int *eerrno);
+                                         int internal, char **err, int *eerrno, int for_module);
 Scheme_Object *scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv[], int and_read, 
                                           int internal, char **err, int *eerrno);
 Scheme_Object *scheme_file_position(int argc, Scheme_Object *argv[]);

src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.3.4.3"
+#define MZSCHEME_VERSION "5.3.4.4"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 3
 #define MZSCHEME_VERSION_Z 4
-#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)

src/racket/src/startup.inc

@@ -1011,14 +1011,24 @@
 " base))))))"
 "(current-load-relative-directory)"
 "(current-directory))))"
-"(show-collection-err(lambda(s)"
+"(show-collection-err(lambda(msg)"
-" (let ((s (string-append \"standard-module-name-resolver: \" s)))"
+"(let((msg(string-append"
+" \"standard-module-name-resolver: \" "
+" (regexp-replace #rx\"\\n\" "
+" msg"
+" (format \"\\n for module path: ~s\\n\""
+" s)))))"
+"(raise"
 "(if stx"
-"(raise-syntax-error"
+"(exn:fail:syntax:missing-module"
-" #f"
+" msg"
-" s"
+"(current-continuation-marks)"
-" stx)"
+"(list stx)"
-"(error s)))))"
+" s)"
+"(exn:fail:filesystem:missing-module"
+" msg"
+"(current-continuation-marks)"
+" s))))))"
 "(ss->rkt(lambda(s)"
 "(let((len(string-length s)))"
 "(if(and(len . >= . 3)"
@@ -1202,7 +1212,20 @@
 "(namespace-module-registry(current-namespace))"
 " normal-filename)"
 " loading)"
-"(parameterize((current-module-declare-name root-modname))"
+"(parameterize((current-module-declare-name root-modname)"
+"(current-module-path-for-load"
+"((if stx"
+"(lambda(p)(datum->syntax #f p stx))"
+" values)"
+"(cond"
+"((symbol? s) s)"
+"((and(pair? s)(eq?(car s) 'lib)) s)"
+"(else(if(resolved-module-path? root-modname)"
+"(let((src(resolved-module-path-name root-modname)))"
+"(if(symbol? src)"
+"(list 'quote src)"
+" src))"
+" root-modname))))))"
 "((current-load/use-compiled) "
 " filename "
 "(let((sym(string->symbol(path->string no-sfx))))"

src/racket/src/startup.rktl

@@ -1144,14 +1144,24 @@
                                                      base))))))
                                  (current-load-relative-directory)
                                  (current-directory)))]
-                  [show-collection-err (lambda (s)
+                  [show-collection-err (lambda (msg)
-                                         (let ([s (string-append "standard-module-name-resolver: " s)])
+                                         (let ([msg (string-append
+                                                     "standard-module-name-resolver: " 
+                                                     (regexp-replace #rx"\n" 
+                                                                     msg
+                                                                     (format "\n  for module path: ~s\n"
+                                                                             s)))])
+                                           (raise
                                             (if stx
-                                               (raise-syntax-error
+                                                (exn:fail:syntax:missing-module
-                                                #f
+                                                 msg
-                                                s
+                                                 (current-continuation-marks)
-                                                stx)
+                                                 (list stx)
-                                               (error s))))]
+                                                 s)
+                                                (exn:fail:filesystem:missing-module
+                                                 msg
+                                                 (current-continuation-marks)
+                                                 s)))))]
                   [ss->rkt (lambda (s)
                              (let ([len (string-length s)])
                                (if (and (len . >= . 3)
@@ -1343,7 +1353,24 @@
                                                                                     (namespace-module-registry (current-namespace))
                                                                                     normal-filename)
                                                                                    loading)
-                                     (parameterize ([current-module-declare-name root-modname])
+                                     (parameterize ([current-module-declare-name root-modname]
+                                                    [current-module-path-for-load
+                                                     ;; If `s' is an absolute module path, then
+                                                     ;; keep it as-is, the better to let a tool
+                                                     ;; recommend how to get an unavailable module;
+                                                     ;; also, propagate the source location.
+                                                     ((if stx
+                                                          (lambda (p) (datum->syntax #f p stx))
+                                                          values)
+                                                      (cond
+                                                       [(symbol? s) s]
+                                                       [(and (pair? s) (eq? (car s) 'lib)) s]
+                                                       [else (if (resolved-module-path? root-modname)
+                                                                 (let ([src (resolved-module-path-name root-modname)])
+                                                                   (if (symbol? src)
+                                                                       (list 'quote src)
+                                                                       src))
+                                                                 root-modname)]))])
                                        ((current-load/use-compiled) 
                                         filename 
                                         (let ([sym (string->symbol (path->string no-sfx))])

src/racket/src/struct.c

@@ -29,6 +29,7 @@ READ_ONLY Scheme_Object *scheme_arity_at_least;
 READ_ONLY Scheme_Object *scheme_date;
 READ_ONLY Scheme_Object *scheme_make_arity_at_least;
 READ_ONLY Scheme_Object *scheme_source_property;
+READ_ONLY Scheme_Object *scheme_module_path_property;
 READ_ONLY Scheme_Object *scheme_input_port_property;
 READ_ONLY Scheme_Object *scheme_output_port_property;
 READ_ONLY Scheme_Object *scheme_cpointer_property;
@@ -173,6 +174,10 @@ static Scheme_Object *check_exn_source_property_value_ok(int argc, Scheme_Object
 static Scheme_Object *exn_source_p(int argc, Scheme_Object **argv);
 static Scheme_Object *exn_source_get(int argc, Scheme_Object **argv);
 
+static Scheme_Object *check_exn_module_path_property_value_ok(int argc, Scheme_Object *argv[]);
+static Scheme_Object *exn_module_path_p(int argc, Scheme_Object **argv);
+static Scheme_Object *exn_module_path_get(int argc, Scheme_Object **argv);
+
 static Scheme_Object *procedure_extract_target(int argc, Scheme_Object **argv);
 static Scheme_Struct_Type *hash_prefab(Scheme_Struct_Type *type);
 
@@ -791,6 +796,26 @@ scheme_init_struct (Scheme_Env *env)
 						      1, 1, 1),
 			     env);
 
+  REGISTER_SO(scheme_module_path_property);
+  {
+    guard = scheme_make_prim_w_arity(check_exn_module_path_property_value_ok,
+				     "guard-for-prop:exn:srclocs",
+				     2, 2);
+    scheme_module_path_property = scheme_make_struct_type_property_w_guard(scheme_intern_symbol("prop:exn:missing-module"),
+                                                                           guard);
+  }
+  scheme_add_global_constant("prop:exn:missing-module", scheme_module_path_property, env);
+  scheme_add_global_constant("exn:missing-module?",
+			     scheme_make_folding_prim(exn_module_path_p,
+						      "exn:missing-module?",
+						      1, 1, 1),
+			     env);
+  scheme_add_global_constant("exn:missing-module-accessor", 
+			     scheme_make_folding_prim(exn_module_path_get,
+						      "exn:missing-module-accessor",
+						      1, 1, 1),
+			     env);
+
   {
     Scheme_Object *p;
     p = scheme_make_prim_w_arity(scheme_extract_checked_procedure,
@@ -5298,6 +5323,34 @@ static Scheme_Object *check_exn_source_property_value_ok(int argc, Scheme_Object
 
 /**********************************************************************/
 
+static Scheme_Object *exn_module_path_p(int argc, Scheme_Object **argv)
+{
+  return (scheme_struct_type_property_ref(scheme_module_path_property, argv[0])
+	  ? scheme_true
+	  : scheme_false);
+}
+
+static Scheme_Object *exn_module_path_get(int argc, Scheme_Object **argv)
+{
+  Scheme_Object *v;
+
+  v = scheme_struct_type_property_ref(scheme_module_path_property, argv[0]);
+  if (!v)
+    scheme_wrong_contract("exn:missing-module-accessor", "exn:missing-module?", 0, argc, argv);
+  
+  return v;
+}
+
+static Scheme_Object *check_exn_module_path_property_value_ok(int argc, Scheme_Object *argv[])
+     /* This is the guard for prop:exn:srclocs */
+{
+  scheme_check_proc_arity("guard-for-prop:exn:missing-module", 1, 0, argc, argv);
+
+  return argv[0];
+}
+
+/**********************************************************************/
+
 static Scheme_Object *do_chaperone_struct(const char *name, int is_impersonator, int argc, Scheme_Object **argv)
 /* (chaperone-struct v mutator/selector redirect-proc ...) */
 {