* boot-9.scm (load-module): When loading files from within files

[bpt/guile.git] / ice-9 / slib.scm

diff --git a/ice-9/slib.scm b/ice-9/slib.scm
index 43eaa1d..dcfbe7f 100644 (file)
--- a/ice-9/slib.scm
+++ b/ice-9/slib.scm
@@ -20,7 +20,7 @@
 (define slib:exit quit)
 (define slib:error error)
 (define slib:warn warn)
-(define slib:eval eval)
+(define slib:eval (lambda (x) (eval-in-module x slib-module)))
 (define defmacro:eval eval)
 (define logical:logand logand)
 (define logical:logior logior)
@@ -117,23 +117,22 @@
 ;;; changing catalog:get in slib/require.scm, and I don't expect
 ;;; Aubrey will integrate such a change.  So I'm just going to punt
 ;;; for the time being.
-(define (slib:load name)
+(define-public (slib:load name)
   (save-module-excursion
    (lambda ()
      (set-current-module slib-module)
-     (let* ((errinfo (catch 'system-error
-                           (lambda ()
-                             (load-from-path name)
-                             #f)
-                           (lambda args args)))
-           (errinfo (and errinfo
-                         (catch 'system-error
-                                (lambda ()
-                                  (load-from-path
-                                   (string-append name ".scm"))
-                                  #f)
-                                (lambda args args)))))
-       (if errinfo
+     (let ((errinfo (catch 'system-error
+                          (lambda ()
+                            (load-from-path name)
+                            #f)
+                          (lambda args args))))
+       (if (and errinfo
+               (catch 'system-error
+                      (lambda ()
+                        (load-from-path
+                         (string-append name ".scm"))
+                        #f)
+                      (lambda args args)))
           (apply throw errinfo))))))
 
 (define slib:load-source slib:load)
@@ -149,12 +148,14 @@
   (string-append slib-parent-dir "/"))
 (define (library-vicinity)
   (string-append (implementation-vicinity) "slib/"))
+(define home-vicinity
+  (let ((home-path (getenv "HOME")))
+    (lambda () home-path)))
 (define (scheme-implementation-type) 'guile)
 (define (scheme-implementation-version) "")
 
 (define (output-port-width . arg) 80)
 (define (output-port-height . arg) 24)
-
 (define (identity x) x)
 
 ;;; {Time}
@@ -173,6 +174,12 @@
         `(define-public ,@(cdr exp))
         `(%system-define ,@(cdr exp))))))
 
+;;; Hack to make syncase macros work in the slib module
+(if (nested-ref the-root-module '(app modules ice-9 syncase))
+    (set-object-property! (module-local-variable (current-module) 'define)
+                         '*sc-expander*
+                         '(define)))
+
 (define (software-type) 'UNIX)
 
 (slib:load (in-vicinity (library-vicinity) "require.scm"))