mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-22 04:30:19 +02:00
Code Activity

`load' autocompiles -- in the current module.

Browse source 
* module/ice-9/boot-9.scm (load): Pull `autocompiled-file-name' inside
  `load', and make it autocompile in the current module. Should fix
  Julian's issue noted in
  http://article.gmane.org/gmane.lisp.guile.devel/9483.
This commit is contained in:
Andy Wingo 2009-10-15 15:48:14 +02:00
parent b0217d1704
commit 1ab3976ef7
1 changed files with 32 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -899,39 +899,39 @@
(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)
;; 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
#:env (current-module))))
(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)))
(with-fluid* current-reader (and (pair? reader) (car reader))
(lambda ()
(let ((cfn (autocompiled-file-name name)))