1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00

Have load-in-vicinity' look for .go' files in %LOAD-COMPILED-PATH.

Fixes <http://bugs.gnu.org/12519>.

* module/ice-9/boot-9.scm (load-in-vicinity)[fresh-compiled-file-name]:
  New `scmstat' parameter; use it.
  [sans-extension]: New procedure.
  [load-absolute]: Call (stat ABS-PATH) from here.  Search a `.go' file
  from %LOAD-COMPILED-PATH before searching %COMPILE-FALLBACK-PATH.
This commit is contained in:
Ludovic Courtès 2012-11-26 23:51:20 +01:00
parent 9fbca4b32e
commit ca8be3f5b3

View file

@ -3635,14 +3635,13 @@ reading PATH with READER."
;; (system base compile) to be loaded up. For that reason compiled-file-name
;; partially duplicates functionality from (system base compile).
(define (fresh-compiled-file-name name go-path)
(define (fresh-compiled-file-name name scmstat go-path)
;; Return GO-PATH after making sure that it contains a freshly compiled
;; version of source file NAME; return #f on failure.
;; version of source file NAME with stat SCMSTAT; return #f on failure.
(catch #t
(lambda ()
(let* ((scmstat (stat name))
(gostat (and (not %fresh-auto-compile)
(stat go-path #f))))
(let ((gostat (and (not %fresh-auto-compile)
(stat go-path #f))))
(if (and gostat (more-recent? gostat scmstat))
go-path
(begin
@ -3667,20 +3666,47 @@ reading PATH with READER."
(define (absolute-path? path)
(string-prefix? "/" path))
(define (sans-extension file)
(let ((dot (string-rindex file #\.)))
(if dot
(substring file 0 dot)
file)))
(define (load-absolute abs-path)
(let ((cfn (let ((canon (false-if-exception (canonicalize-path abs-path))))
(and canon
(let ((go-path (fallback-file-name canon)))
(and go-path
(fresh-compiled-file-name abs-path go-path)))))))
(if cfn
;; Load from ABS-PATH, using a compiled file or auto-compiling if needed.
(define scmstat
(catch #t
(lambda ()
(stat abs-path))
(lambda (key . args)
(warn-about-exception key args)
#f)))
(define (pre-compiled)
(let ((go-path (search-path %load-compiled-path (sans-extension path)
%load-compiled-extensions #t)))
(and go-path
(let ((gostat (stat go-path #f)))
(and gostat (more-recent? gostat scmstat)
go-path)))))
(define (fallback)
(let ((canon (false-if-exception (canonicalize-path abs-path))))
(and canon
(let ((go-path (fallback-file-name canon)))
(and go-path
(fresh-compiled-file-name abs-path scmstat go-path))))))
(let ((compiled (and scmstat
(or (pre-compiled) (fallback)))))
(if compiled
(begin
(if %load-hook
(%load-hook abs-path))
(load-compiled cfn))
(load-compiled compiled))
(start-stack 'load-stack
(primitive-load abs-path)))))
(save-module-excursion
(lambda ()
(with-fluids ((current-reader reader)