From 04af4c4c5221c082905d52eb5ad3829ed681d097 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Tue, 16 Feb 2010 21:11:27 +0100
Subject: [PATCH] `load' doesn't cause the compiler to be loaded in some cases

* module/system/base/compile.scm (compiled-file-name): Add a comment.
* module/ice-9/boot-9.scm (load): Avoid loading up (system base compile)
  just to compute an autocompiled file name. Fixes the issue whereby
  guile-tools snarf-check-and-output-texi was inadvertantly loading up
  srfi-1, and thereby a stale library, just to see if guile-tools itself
  had a compiled version.

  Not sure what the right unit test is here, other than vigilance.
---
 module/ice-9/boot-9.scm        | 31 ++++++++++++++++++++++++-------
 module/system/base/compile.scm |  2 ++
 2 files changed, 26 insertions(+), 7 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index af09be82b..906a0cd41 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -907,19 +907,34 @@
   ;; 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)
+  ;;
+  ;; NB: Unless we need to compile the file, this function should not cause
+  ;; (system base compile) to be loaded up. For that reason compiled-file-name
+  ;; partially duplicates functionality from (system base compile).
+  (define (compiled-file-name canon-path)
+    (and %compile-fallback-path
+         (string-append
+          %compile-fallback-path
+          ;; no need for '/' separator here, canon-path is absolute
+          canon-path
+          (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 (fresh-compiled-file-name go-path)
     (catch #t
       (lambda ()
-        (let* ((cfn ((@ (system base compile) compiled-file-name) name))
-               (scmstat (stat name))
-               (gostat (stat cfn #f)))
+        (let* ((scmstat (stat name))
+               (gostat (stat go-path #f)))
           (if (and gostat (= (stat:mtime gostat) (stat:mtime scmstat)))
-              cfn
+              go-path
               (begin
                 (if gostat
                     (format (current-error-port)
                             ";;; note: source file ~a\n;;;       newer than compiled ~a\n"
-                            name cfn))
+                            name go-path))
                 (cond
                  (%load-should-autocompile
                   (%warn-autocompilation-enabled)
@@ -936,7 +951,9 @@
         #f)))
   (with-fluid* current-reader (and (pair? reader) (car reader))
     (lambda ()
-      (let ((cfn (autocompiled-file-name name)))
+      (let ((cfn (and=> (and=> (false-if-exception (canonicalize-path name))
+                               compiled-file-name)
+                        fresh-compiled-file-name)))
         (if cfn
             (load-compiled cfn)
             (start-stack 'load-stack
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 977536f64..34e097b75 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -121,6 +121,8 @@
 ;;; 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.
+;;;
+;;; See also boot-9.scm:load.
 (define (compiled-file-name file)
   (define (compiled-extension)
     (cond ((or (null? %load-compiled-extensions)