1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00

add exception_on_error optional arg to primitive-load-path

* libguile/init.c (scm_load_startup_files): Use
  scm_c_primitive_load_path.

* libguile/load.c (scm_primitive_load_path): Add an optional arg,
  exception_on_error, which if #f will cause primitive-load-path to just
  return #f if no file is found. This is to help out the semantics of
  try-module-autoload. We can't just catch misc-error, because loading
  the file could raise any exception.
  (scm_c_primitive_load_path): Add the extra arg to
  scm_primitive_load_path.

* libguile/load.h: Adapt scm_primitive_load_path prototype.

* module/ice-9/boot-9.scm (try-module-autoload): Refactor slightly to be
  clearer.
This commit is contained in:
Andy Wingo 2009-06-03 09:48:16 +02:00
parent 1d022387c8
commit 0fb81f95b0
4 changed files with 23 additions and 13 deletions

View file

@ -282,7 +282,7 @@ scm_load_startup_files ()
/* Load Ice-9. */ /* Load Ice-9. */
if (!scm_ice_9_already_loaded) if (!scm_ice_9_already_loaded)
{ {
scm_primitive_load_path (scm_from_locale_string ("ice-9/boot-9")); scm_c_primitive_load_path ("ice-9/boot-9");
/* Load the init.scm file. */ /* Load the init.scm file. */
if (scm_is_true (init_path)) if (scm_is_true (init_path))

View file

@ -586,16 +586,21 @@ scm_try_autocompile (SCM source)
return SCM_BOOL_F; return SCM_BOOL_F;
} }
SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0, SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 1, 0,
(SCM filename), (SCM filename, SCM exception_on_not_found),
"Search @var{%load-path} for the file named @var{filename} and\n" "Search @var{%load-path} for the file named @var{filename} and\n"
"load it into the top-level environment. If @var{filename} is a\n" "load it into the top-level environment. If @var{filename} is a\n"
"relative pathname and is not found in the list of search paths,\n" "relative pathname and is not found in the list of search paths,\n"
"an error is signalled.") "an error is signalled, unless the optional argument\n"
"@var{exception_on_not_found} is @code{#f}, in which case\n"
"@code{#f} is returned instead.")
#define FUNC_NAME s_scm_primitive_load_path #define FUNC_NAME s_scm_primitive_load_path
{ {
SCM full_filename, compiled_filename; SCM full_filename, compiled_filename;
if (SCM_UNBNDP (exception_on_not_found))
exception_on_not_found = SCM_BOOL_T;
full_filename = scm_sys_search_load_path (filename); full_filename = scm_sys_search_load_path (filename);
compiled_filename = scm_search_path (*scm_loc_load_compiled_path, compiled_filename = scm_search_path (*scm_loc_load_compiled_path,
filename, filename,
@ -603,8 +608,13 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
SCM_BOOL_T); SCM_BOOL_T);
if (scm_is_false (full_filename) && scm_is_false (compiled_filename)) if (scm_is_false (full_filename) && scm_is_false (compiled_filename))
SCM_MISC_ERROR ("Unable to find file ~S in load path", {
scm_list_1 (filename)); if (scm_is_true (exception_on_not_found))
SCM_MISC_ERROR ("Unable to find file ~S in load path",
scm_list_1 (filename));
else
return SCM_BOOL_F;
}
if (scm_is_false (full_filename) if (scm_is_false (full_filename)
|| (scm_is_true (compiled_filename) || (scm_is_true (compiled_filename)
@ -622,7 +632,8 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
SCM SCM
scm_c_primitive_load_path (const char *filename) scm_c_primitive_load_path (const char *filename)
{ {
return scm_primitive_load_path (scm_from_locale_string (filename)); return scm_primitive_load_path (scm_from_locale_string (filename),
SCM_BOOL_T);
} }

View file

@ -33,7 +33,7 @@ SCM_API SCM scm_sys_library_dir (void);
SCM_API SCM scm_sys_site_dir (void); SCM_API SCM scm_sys_site_dir (void);
SCM_API SCM scm_search_path (SCM path, SCM filename, SCM exts, SCM require_exts); SCM_API SCM scm_search_path (SCM path, SCM filename, SCM exts, SCM require_exts);
SCM_API SCM scm_sys_search_load_path (SCM filename); SCM_API SCM scm_sys_search_load_path (SCM filename);
SCM_API SCM scm_primitive_load_path (SCM filename); SCM_API SCM scm_primitive_load_path (SCM filename, SCM exception_on_not_found);
SCM_API SCM scm_c_primitive_load_path (const char *filename); SCM_API SCM scm_c_primitive_load_path (const char *filename);
SCM_INTERNAL void scm_init_load_path (void); SCM_INTERNAL void scm_init_load_path (void);
SCM_INTERNAL void scm_init_load (void); SCM_INTERNAL void scm_init_load (void);

View file

@ -2270,16 +2270,15 @@ module '(ice-9 q) '(make-q q-length))}."
(resolve-module dir-hint-module-name #f) (resolve-module dir-hint-module-name #f)
(and (not (autoload-done-or-in-progress? dir-hint name)) (and (not (autoload-done-or-in-progress? dir-hint name))
(let ((didit #f)) (let ((didit #f))
(define (load-file proc file)
(save-module-excursion (lambda () (proc file)))
(set! didit #t))
(dynamic-wind (dynamic-wind
(lambda () (autoload-in-progress! dir-hint name)) (lambda () (autoload-in-progress! dir-hint name))
(lambda () (lambda ()
(with-fluid* current-reader #f (with-fluid* current-reader #f
(lambda () (lambda ()
(load-file primitive-load-path (save-module-excursion
(in-vicinity dir-hint name))))) (lambda ()
(primitive-load-path (in-vicinity dir-hint name) #f)
(set! didit #t))))))
(lambda () (set-autoloaded! dir-hint name didit))) (lambda () (set-autoloaded! dir-hint name didit)))
didit)))) didit))))