1
Fork 0
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:
Andy Wingo 2009-08-18 11:05:17 +02:00
parent e33a910dd0
commit 9591a2b016
3 changed files with 51 additions and 7 deletions

View file

@ -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),

View file

@ -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);

View file

@ -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)))))))