1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-23 20:05:32 +02:00

simplify autocompilation some more

* libguile/load.c (scm_init_load_path): Set the fallback path even if
  GUILE_SYSTEM_COMPILED_PATH is set. Now that we store full paths in the
  autocompiled files, and the path contains the effective Guile version,
  there's no danger of accidental collisions.
  (do_try_autocompile, autocompile_catch_handler, scm_try_autocompile):
  Simplify again -- since there's only one place we put autocompiled
  files, and compile-file finds it itself, there's no need to pass along
  the compiled file path.
  (scm_primitive_load_path): Don't call out to compiled-file-name to get
  the fallback path, as we might not be autocompiling, and besides that
  we need to check if the file exists at all.

* module/system/base/compile.scm (compiled-file-name): Simplify again.
  The auto-compiled path is just fallback path + full source path + .go.
This commit is contained in:
Andy Wingo 2009-06-05 10:06:39 +02:00
parent 5ea401bffe
commit 3c997c4ba9
2 changed files with 71 additions and 92 deletions

View file

@ -114,21 +114,11 @@
;;; 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.
;;; files, either you know where they should go, in which case you tell
;;; compile-file explicitly, 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)
(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)))
@ -137,9 +127,8 @@
".go")
(else (car %load-compiled-extensions))))
(and %compile-fallback-path
(let ((f (string-append %compile-fallback-path "/"
(strip-source-extension file)
(compiled-extension))))
(let ((f (string-append
%compile-fallback-path "/" file (compiled-extension))))
(and (false-if-exception (ensure-writable-dir (dirname f)))
f))))