mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

%load-hook not just for primitive-load

Browse source 
* libguile/load.c (scm_primitive_load_path):
* module/ice-9/boot-9.scm (load-in-vicinity): Call %load-hook as needed.
This commit is contained in:
Andy Wingo 2011-06-30 12:56:12 +02:00
parent 08969a2407
commit dcada7d8e7
2 changed files with 13 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

9
libguile/load.c
View file

@ -806,6 +806,11 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
SCM filename, exception_on_not_found;
SCM full_filename, compiled_filename;
int compiled_is_fallback = 0;
SCM hook = *scm_loc_load_hook;
if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook)))
SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
SCM_EOL);
if (scm_is_string (args))
{
@ -870,6 +875,10 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
return SCM_BOOL_F;
}
if (!scm_is_false (hook))
scm_call_1 (hook, (scm_is_true (full_filename)
? full_filename : compiled_filename));
if (scm_is_false (full_filename)
|| (scm_is_true (compiled_filename)
&& compiled_is_fresh (full_filename, compiled_filename)))

5
module/ice-9/boot-9.scm
View file

@ -3526,7 +3526,10 @@ module '(ice-9 q) '(make-q q-length))}."
(and go-path
(fresh-compiled-file-name abs-path go-path)))))))
(if cfn
(load-compiled cfn)
(begin
(if %load-hook
(%load-hook abs-path))
(load-compiled cfn))
(start-stack 'load-stack
(primitive-load abs-path)))))