mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 14:21:10 +02:00
`load' autocompiles
* libguile/load.h: * libguile/load.c (scm_sys_warn_autocompilation_enabled): New primitive, not exported. Since `load' autocompiles now, it should warn in the same way that the bits hardcoded into C warn. (scm_try_autocompile): Use scm_sys_warn_autocompilation_enabled. * module/ice-9/boot-9.scm (autocompiled-file-name): New helper. (load): Try autocompiling the argument, if appropriate. Will autocompile files passed on Guile's command line. `primitive-load' is unaffected.
This commit is contained in:
parent
e33a910dd0
commit
9591a2b016
3 changed files with 51 additions and 7 deletions
|
@ -639,14 +639,11 @@ autocompile_catch_handler (void *data, SCM tag, SCM throw_args)
|
|||
return SCM_BOOL_F;
|
||||
}
|
||||
|
||||
static SCM
|
||||
scm_try_autocompile (SCM source)
|
||||
SCM_DEFINE (scm_sys_warn_autocompilation_enabled, "%warn-autocompilation-enabled", 0, 0, 0,
|
||||
(void), "")
|
||||
{
|
||||
static int message_shown = 0;
|
||||
|
||||
if (scm_is_false (*scm_loc_load_should_autocompile))
|
||||
return SCM_BOOL_F;
|
||||
|
||||
if (!message_shown)
|
||||
{
|
||||
scm_puts (";;; note: autocompilation is enabled, set GUILE_AUTO_COMPILE=0\n"
|
||||
|
@ -655,6 +652,17 @@ scm_try_autocompile (SCM source)
|
|||
message_shown = 1;
|
||||
}
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
|
||||
static SCM
|
||||
scm_try_autocompile (SCM source)
|
||||
{
|
||||
if (scm_is_false (*scm_loc_load_should_autocompile))
|
||||
return SCM_BOOL_F;
|
||||
|
||||
scm_sys_warn_autocompilation_enabled ();
|
||||
return scm_c_catch (SCM_BOOL_T,
|
||||
do_try_autocompile,
|
||||
SCM2PTR (source),
|
||||
|
|
|
@ -36,6 +36,7 @@ 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_primitive_load_path (SCM filename, SCM exception_on_not_found);
|
||||
SCM_API SCM scm_c_primitive_load_path (const char *filename);
|
||||
SCM_INTERNAL SCM scm_sys_warn_autocompilation_enabled (void);
|
||||
SCM_INTERNAL void scm_init_load_path (void);
|
||||
SCM_INTERNAL void scm_init_load (void);
|
||||
|
||||
|
|
|
@ -867,11 +867,46 @@
|
|||
|
||||
(set! %load-hook %load-announce)
|
||||
|
||||
;;; Returns the .go file corresponding to `name'. Does not search load
|
||||
;;; paths, only the fallback path. If the .go file is missing or out of
|
||||
;;; date, and autocompilation is enabled, will try autocompilation, just
|
||||
;;; as primitive-load-path does internally. primitive-load is
|
||||
;;; unaffected. Returns #f if autocompilation failed or was disabled.
|
||||
(define (autocompiled-file-name name)
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(let* ((cfn ((@ (system base compile) compiled-file-name) name))
|
||||
(scmstat (stat name))
|
||||
(gostat (stat cfn #f)))
|
||||
(if (and gostat (= (stat:mtime gostat) (stat:mtime scmstat)))
|
||||
cfn
|
||||
(begin
|
||||
(if gostat
|
||||
(format (current-error-port)
|
||||
";;; note: source file ~a\n;;; newer than compiled ~a\n"
|
||||
name cfn))
|
||||
(cond
|
||||
(%load-should-autocompile
|
||||
(%warn-autocompilation-enabled)
|
||||
(format (current-error-port) ";;; compiling ~a\n" name)
|
||||
(let ((cfn ((@ (system base compile) compile-file) name)))
|
||||
(format (current-error-port) ";;; compiled ~a\n" cfn)
|
||||
cfn))
|
||||
(else #f))))))
|
||||
(lambda (k . args)
|
||||
(format (current-error-port)
|
||||
";;; WARNING: compilation of ~a failed:\n;;; key ~a, throw_args ~s\n"
|
||||
name k args)
|
||||
#f)))
|
||||
|
||||
(define (load name . reader)
|
||||
(with-fluid* current-reader (and (pair? reader) (car reader))
|
||||
(lambda ()
|
||||
(start-stack 'load-stack
|
||||
(primitive-load name)))))
|
||||
(let ((cfn (autocompiled-file-name name)))
|
||||
(if cfn
|
||||
(load-compiled cfn)
|
||||
(start-stack 'load-stack
|
||||
(primitive-load name)))))))
|
||||
|
||||
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue