dynwind is now a part of guile's primitive language

[bpt/guile.git] / module / ice-9 / boot-9.scm

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 32b7f62..906a0cd 100644 (file)
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 
-;;;; Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009
+;;;; Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010
 ;;;; Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -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
@@ -3119,14 +3136,16 @@ module '(ice-9 q) '(make-q q-length))}."
               names)))
 
 (defmacro export names
-  `(call-with-deferred-observers
-    (lambda ()
-      (module-export! (current-module) ',names))))
+  `(eval-when (eval load compile)
+     (call-with-deferred-observers
+      (lambda ()
+        (module-export! (current-module) ',names)))))
 
 (defmacro re-export names
-  `(call-with-deferred-observers
-    (lambda ()
-      (module-re-export! (current-module) ',names))))
+  `(eval-when (eval load compile)
+     (call-with-deferred-observers
+       (lambda ()
+         (module-re-export! (current-module) ',names)))))
 
 (defmacro export-syntax names
   `(export ,@names))
@@ -3542,12 +3561,6 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;; {Deprecated stuff}
 ;;;
 
-(begin-deprecated
- (define (feature? sym)
-   (issue-deprecation-warning
-    "`feature?' is deprecated.  Use `provided?' instead.")
-   (provided? sym)))
-
 (begin-deprecated
  (module-use! the-scm-module (resolve-interface '(ice-9 deprecated))))