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:
parent
9fbca4b32e
commit
ca8be3f5b3
1 changed files with 39 additions and 13 deletions
|
@ -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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue