fix debug-options

[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 4406631..78b194a 100644 (file)
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -382,8 +382,12 @@
 (define (apply-to-args args fn) (apply fn args))
 
 (defmacro false-if-exception (expr)
-  `(catch #t (lambda () ,expr)
-         (lambda args #f)))
+  `(catch #t
+     (lambda ()
+       ;; avoid saving backtraces inside false-if-exception
+       (with-fluid* the-last-stack (fluid-ref the-last-stack)
+         (lambda () ,expr)))
+     (lambda args #f)))
 
 \f
 
@@ -611,12 +615,10 @@
     (primitive-load-path "ice-9/networking"))
 
 ;; For reference, Emacs file-exists-p uses stat in this same way.
-;; ENHANCE-ME: Catching an exception from stat is a bit wasteful, do this in
-;; C where all that's needed is to inspect the return from stat().
 (define file-exists?
   (if (provided? 'posix)
       (lambda (str)
-       (->bool (false-if-exception (stat str))))
+       (->bool (stat str #f)))
       (lambda (str)
        (let ((port (catch 'system-error (lambda () (open-file str OPEN_READ))
                           (lambda args #f))))
@@ -2272,27 +2274,15 @@ module '(ice-9 q) '(make-q q-length))}."
     (resolve-module dir-hint-module-name #f)
     (and (not (autoload-done-or-in-progress? dir-hint name))
         (let ((didit #f))
-          (define (load-file proc file)
-            (save-module-excursion (lambda () (proc file)))
-            (set! didit #t))
           (dynamic-wind
            (lambda () (autoload-in-progress! dir-hint name))
            (lambda ()
-             (let ((file (in-vicinity dir-hint name)))
-                (let ((compiled (and load-compiled
-                                     (%search-load-path
-                                      (string-append file ".go"))))
-                      (source (%search-load-path file)))
-                  (cond ((and source
-                              (or (not compiled)
-                                  (< (stat:mtime (stat compiled))
-                                     (stat:mtime (stat source)))))
-                         (if compiled
-                             (warn "source file" source "newer than" compiled))
-                         (with-fluid* current-reader #f
-                           (lambda () (load-file primitive-load source))))
-                        (compiled
-                         (load-file load-compiled compiled))))))
+             (with-fluid* current-reader #f
+                (lambda ()
+                  (save-module-excursion
+                   (lambda () 
+                     (primitive-load-path (in-vicinity dir-hint name) #f)
+                     (set! didit #t))))))
            (lambda () (set-autoloaded! dir-hint name didit)))
           didit))))
 
@@ -2334,9 +2324,9 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;;
 
 (defmacro define-option-interface (option-group)
-  (let* ((option-name car)
-        (option-value cadr)
-        (option-documentation caddr)
+  (let* ((option-name 'car)
+        (option-value 'cadr)
+        (option-documentation 'caddr)
 
         ;; Below follow the macros defining the run-time option interfaces.
 
@@ -2347,15 +2337,15 @@ module '(ice-9 q) '(make-q q-length))}."
                                   (,interface (car args)) (,interface))
                                  (else (for-each
                                          (lambda (option)
-                                           (display (option-name option))
+                                           (display (,option-name option))
                                            (if (< (string-length
-                                                   (symbol->string (option-name option)))
+                                                   (symbol->string (,option-name option)))
                                                   8)
                                                (display #\tab))
                                            (display #\tab)
-                                           (display (option-value option))
+                                           (display (,option-value option))
                                            (display #\tab)
-                                           (display (option-documentation option))
+                                           (display (,option-documentation option))
                                            (newline))
                                          (,interface #t)))))))