mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 01:30:27 +02:00
Code Activity

further autocompilation tweaks

Browse source 
* module/system/base/compile.scm (compiled-file-name):
* libguile/load.c (scm_init_load_path, scm_try_autocompile)
  (scm_primitive_load_path): Rework so that we search for .go files in
  the load-compiled path and in the fallback path, but we only
  autocompile to the fallback path. Should produce a more desirable experience.
This commit is contained in:
Andy Wingo 2009-06-05 01:20:19 +02:00
parent b193d904bb
commit 5ea401bffe
2 changed files with 76 additions and 76 deletions
Download patch file Download diff file Expand all files Collapse all files

74
module/system/base/compile.scm
View file

@ -108,48 +108,40 @@
(stable-sort (map (lambda (x) (cons (key x) x)) list)
(lambda (x y) (less (car x) (car y))))))
;;; This function is among the trickiest I've ever written. I tried many
;;; variants. In the end, simple is best, of course.
;;;
;;; After turning this around a number of times, it seems that the the
;;; desired behavior is that .go files should exist in a path, for
;;; searching. That is orthogonal to this function. For writing .go
;;; files, either you know where they should go, in which case you pass
;;; the path directly, assuming they will end up in the path, as in the
;;; srcdir != builddir case; or you don't know, in which case this
;;; function is called, and we just put them in your own ccache dir in
;;; ~/.guile-ccache.
(define (compiled-file-name file)
(let ((cext (cond ((or (null? %load-compiled-extensions)
(string-null? (car %load-compiled-extensions)))
(warn "invalid %load-compiled-extensions"
%load-compiled-extensions)
".go")
(else (car %load-compiled-extensions)))))
(define (strip-source-extension path)
(let lp ((exts %load-extensions))
(cond ((null? exts) file)
((string-null? (car exts)) (lp (cdr exts)))
((string-suffix? (car exts) path)
(substring path 0
(- (string-length path)
(string-length (car exts)))))
(else (lp (cdr exts))))))
;; there is some trickery here. if no %load-compiled-path is a
;; prefix of `file', the stability of the sort makes us end up
;; trying to write first to last dir in the path, which is usually
;; the $HOME ccache dir.
(let lp ((paths (dsu-sort (reverse %load-compiled-path)
(lambda (x)
(if (string-prefix? x file)
(string-length x)
0))
>)))
(if (null? paths)
(error "no writable path when compiling" file)
(let ((rpath (in-vicinity
(car paths)
(string-append
(strip-source-extension
(if (string-prefix? (car paths) file)
(substring file (1+ (string-length (car paths))))
(substring file 1)))
cext))))
(if (and (false-if-exception
(ensure-writable-dir (dirname rpath)))
(or (not (file-exists? rpath))
(access? rpath W_OK)))
rpath
(lp (cdr paths))))))))
(define (strip-source-extension path)
(let lp ((exts %load-extensions))
(cond ((null? exts) file)
((string-null? (car exts)) (lp (cdr exts)))
((string-suffix? (car exts) path)
(substring path 0
(- (string-length path)
(string-length (car exts)))))
(else (lp (cdr exts))))))
(define (compiled-extension)
(cond ((or (null? %load-compiled-extensions)
(string-null? (car %load-compiled-extensions)))
(warn "invalid %load-compiled-extensions"
%load-compiled-extensions)
".go")
(else (car %load-compiled-extensions))))
(and %compile-fallback-path
(let ((f (string-append %compile-fallback-path "/"
(strip-source-extension file)
(compiled-extension))))
(and (false-if-exception (ensure-writable-dir (dirname f)))
f))))
(define* (compile-file file #:key
(output-file #f)