guile/guile-core/ice-9 boot-9.scm

[Marius Vollmer]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Marius Vollmer <address@hidden> 01/06/02 18:02:53

Modified files:
        guile-core/ice-9: boot-9.scm 

Log message:
        (try-load-module): Bracket calls to try-module-linked
        and try-module-dynamic-link with `begin-deprecated'.
        (split-c-module-name, convert-c-registered-modules,
        registered-modules, register-modules, warn-autoload-deprecation,
        init-dynamic-module, dynamic-maybe-call, dynamic-maybe-link,
        find-and-link-dynamic-module, try-using-libtool-name,
        try-using-sharlib-name, link-dynamic-module, try-module-linked,
        try-module-dynamic-link): Deprecated.  Activate deprecation
        message.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/boot-9.scm.diff?cvsroot=OldCVS&tr1=1.257&tr2=1.258&r1=text&r2=text

Patches:
Index: guile/guile-core/ice-9/boot-9.scm
diff -u guile/guile-core/ice-9/boot-9.scm:1.257 
guile/guile-core/ice-9/boot-9.scm:1.258
--- guile/guile-core/ice-9/boot-9.scm:1.257     Sat Jun  2 11:33:25 2001
+++ guile/guile-core/ice-9/boot-9.scm   Sat Jun  2 18:02:53 2001
@@ -1610,9 +1610,9 @@
 ;; (define-special-value '(app modules new-ws) (lambda () (make-scm-module)))
 
 (define (try-load-module name)
-  (or (try-module-linked name)
+  (or (begin-deprecated (try-module-linked name))
       (try-module-autoload name)
-      (try-module-dynamic-link name)))
+      (begin-deprecated (try-module-dynamic-link name))))
 
 (define (purify-module! module)
   "Removes bindings in MODULE which are inherited from the (guile) module."
@@ -1803,152 +1803,150 @@
 ;;; Dynamic linking of modules
 
 ;; This method of dynamically linking Guile Extensions is deprecated.
-;; Use `dynamic-link' and `dynamic-call' explicitely from Scheme code
-;; instead.
+;; Use `load-extension' explicitely from Scheme code instead.
 
-;; XXX - We can not offer the removal of this code thru the
-;; deprecation mechanism since we have no complete replacement yet.
+(begin-deprecated
 
-(define (split-c-module-name str)
-  (let loop ((rev '())
-            (start 0)
-            (pos 0)
-            (end (string-length str)))
-    (cond
-     ((= pos end)
-      (reverse (cons (string->symbol (substring str start pos)) rev)))
-     ((eq? (string-ref str pos) #\space)
-      (loop (cons (string->symbol (substring str start pos)) rev)
-           (+ pos 1)
-           (+ pos 1)
-           end))
-     (else
-      (loop rev start (+ pos 1) end)))))
-
-(define (convert-c-registered-modules dynobj)
-  (let ((res (map (lambda (c)
-                   (list (split-c-module-name (car c)) (cdr c) dynobj))
-                 (c-registered-modules))))
-    (c-clear-registered-modules)
-    res))
-
-(define registered-modules '())
-
-(define (register-modules dynobj)
-  (set! registered-modules
-       (append! (convert-c-registered-modules dynobj)
-                registered-modules)))
-
-(define (warn-autoload-deprecation modname)
-  ;; Do nothing here until we can deprecate the code for real.
-  (if #f
-      (issue-deprecation-warning
-       "Autoloading of compiled code modules is deprecated."
-       "Write a Scheme file instead that uses `dynamic-link' directly.")))
-
-(define (init-dynamic-module modname)
-  ;; Register any linked modules which have been registered on the C level
-  (register-modules #f)
-  (or-map (lambda (modinfo)
-           (if (equal? (car modinfo) modname)
-               (begin
-                 (warn-autoload-deprecation modname)
-                 (set! registered-modules (delq! modinfo registered-modules))
-                 (let ((mod (resolve-module modname #f)))
-                   (save-module-excursion
-                    (lambda ()
-                      (set-current-module mod)
-                      (set-module-public-interface! mod mod)
-                      (dynamic-call (cadr modinfo) (caddr modinfo))
-                      ))
-                   #t))
-               #f))
-         registered-modules))
-
-(define (dynamic-maybe-call name dynobj)
-  (catch #t                            ; could use false-if-exception here
-        (lambda ()
-          (dynamic-call name dynobj))
-        (lambda args
-          #f)))
-
-(define (dynamic-maybe-link filename)
-  (catch #t                            ; could use false-if-exception here
-        (lambda ()
-          (dynamic-link filename))
-        (lambda args
-          #f)))
-
-(define (find-and-link-dynamic-module module-name)
-  (define (make-init-name mod-name)
-    (string-append "scm_init"
-                  (list->string (map (lambda (c)
-                                       (if (or (char-alphabetic? c)
-                                               (char-numeric? c))
-                                           c
-                                           #\_))
-                                     (string->list mod-name)))
-                  "_module"))
-
-  ;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME,
-  ;; and the `libname' (the name of the module prepended by `lib') in the cdr
-  ;; field.  For example, if MODULE-NAME is the list (inet tcp-ip udp), then
-  ;; SUBDIR-AND-LIBNAME will be the pair ("inet/tcp-ip" . "libudp").
-  (let ((subdir-and-libname
-        (let loop ((dirs "")
-                   (syms module-name))
-          (if (null? (cdr syms))
-              (cons dirs (string-append "lib" (symbol->string (car syms))))
-              (loop (string-append dirs (symbol->string (car syms)) "/")
-                    (cdr syms)))))
-       (init (make-init-name (apply string-append
-                                    (map (lambda (s)
-                                           (string-append "_"
-                                                          (symbol->string s)))
-                                         module-name)))))
-    (let ((subdir (car subdir-and-libname))
-         (libname (cdr subdir-and-libname)))
-
-      ;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'.  If that
-      ;; file exists, fetch the dlname from that file and attempt to link
-      ;; against it.  If `subdir/libfoo.la' does not exist, or does not seem
-      ;; to name any shared library, look for `subdir/libfoo.so' instead and
-      ;; link against that.
-      (let check-dirs ((dir-list %load-path))
-       (if (null? dir-list)
-           #f
-           (let* ((dir (in-vicinity (car dir-list) subdir))
-                  (sharlib-full
-                   (or (try-using-libtool-name dir libname)
-                       (try-using-sharlib-name dir libname))))
-             (if (and sharlib-full (file-exists? sharlib-full))
-                 (link-dynamic-module sharlib-full init)
-                 (check-dirs (cdr dir-list)))))))))
-
-(define (try-using-libtool-name libdir libname)
-  (let ((libtool-filename (in-vicinity libdir
-                                      (string-append libname ".la"))))
-    (and (file-exists? libtool-filename)
-        libtool-filename)))
-
-(define (try-using-sharlib-name libdir libname)
-  (in-vicinity libdir (string-append libname ".so")))
-
-(define (link-dynamic-module filename initname)
-  ;; Register any linked modules which has been registered on the C level
-  (register-modules #f)
-  (let ((dynobj (dynamic-link filename)))
-    (dynamic-call initname dynobj)
-    (register-modules dynobj)))
-
-(define (try-module-linked module-name)
-  (init-dynamic-module module-name))
-
-(define (try-module-dynamic-link module-name)
-  (and (find-and-link-dynamic-module module-name)
-       (init-dynamic-module module-name)))
-
-
+ (define (split-c-module-name str)
+   (let loop ((rev '())
+             (start 0)
+             (pos 0)
+             (end (string-length str)))
+     (cond
+      ((= pos end)
+       (reverse (cons (string->symbol (substring str start pos)) rev)))
+      ((eq? (string-ref str pos) #\space)
+       (loop (cons (string->symbol (substring str start pos)) rev)
+            (+ pos 1)
+            (+ pos 1)
+            end))
+      (else
+       (loop rev start (+ pos 1) end)))))
+
+ (define (convert-c-registered-modules dynobj)
+   (let ((res (map (lambda (c)
+                    (list (split-c-module-name (car c)) (cdr c) dynobj))
+                  (c-registered-modules))))
+     (c-clear-registered-modules)
+     res))
+
+ (define registered-modules '())
+
+ (define (register-modules dynobj)
+   (set! registered-modules
+        (append! (convert-c-registered-modules dynobj)
+                 registered-modules)))
+
+ (define (warn-autoload-deprecation modname)
+   (issue-deprecation-warning
+    "Autoloading of compiled code modules is deprecated."
+    "Write a Scheme file instead that uses `load-extension'.")
+   (issue-deprecation-warning
+    (simple-format #f "(You just autoloaded module ~S.)" modname)))
+ 
+ (define (init-dynamic-module modname)
+   ;; Register any linked modules which have been registered on the C level
+   (register-modules #f)
+   (or-map (lambda (modinfo)
+            (if (equal? (car modinfo) modname)
+                (begin
+                  (warn-autoload-deprecation modname)
+                  (set! registered-modules (delq! modinfo registered-modules))
+                  (let ((mod (resolve-module modname #f)))
+                    (save-module-excursion
+                     (lambda ()
+                       (set-current-module mod)
+                       (set-module-public-interface! mod mod)
+                       (dynamic-call (cadr modinfo) (caddr modinfo))
+                       ))
+                    #t))
+                #f))
+          registered-modules))
+
+ (define (dynamic-maybe-call name dynobj)
+   (catch #t                           ; could use false-if-exception here
+         (lambda ()
+           (dynamic-call name dynobj))
+         (lambda args
+           #f)))
+
+ (define (dynamic-maybe-link filename)
+   (catch #t                           ; could use false-if-exception here
+         (lambda ()
+           (dynamic-link filename))
+         (lambda args
+           #f)))
+
+ (define (find-and-link-dynamic-module module-name)
+   (define (make-init-name mod-name)
+     (string-append "scm_init"
+                   (list->string (map (lambda (c)
+                                        (if (or (char-alphabetic? c)
+                                                (char-numeric? c))
+                                            c
+                                            #\_))
+                                      (string->list mod-name)))
+                   "_module"))
+
+   ;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME,
+   ;; and the `libname' (the name of the module prepended by `lib') in the cdr
+   ;; field.  For example, if MODULE-NAME is the list (inet tcp-ip udp), then
+   ;; SUBDIR-AND-LIBNAME will be the pair ("inet/tcp-ip" . "libudp").
+   (let ((subdir-and-libname
+         (let loop ((dirs "")
+                    (syms module-name))
+           (if (null? (cdr syms))
+               (cons dirs (string-append "lib" (symbol->string (car syms))))
+               (loop (string-append dirs (symbol->string (car syms)) "/")
+                     (cdr syms)))))
+        (init (make-init-name (apply string-append
+                                     (map (lambda (s)
+                                            (string-append "_"
+                                                           (symbol->string s)))
+                                          module-name)))))
+     (let ((subdir (car subdir-and-libname))
+          (libname (cdr subdir-and-libname)))
+       
+       ;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'.  If that
+       ;; file exists, fetch the dlname from that file and attempt to link
+       ;; against it.  If `subdir/libfoo.la' does not exist, or does not seem
+       ;; to name any shared library, look for `subdir/libfoo.so' instead and
+       ;; link against that.
+       (let check-dirs ((dir-list %load-path))
+        (if (null? dir-list)
+            #f
+            (let* ((dir (in-vicinity (car dir-list) subdir))
+                   (sharlib-full
+                    (or (try-using-libtool-name dir libname)
+                        (try-using-sharlib-name dir libname))))
+              (if (and sharlib-full (file-exists? sharlib-full))
+                  (link-dynamic-module sharlib-full init)
+                  (check-dirs (cdr dir-list)))))))))
+ 
+ (define (try-using-libtool-name libdir libname)
+   (let ((libtool-filename (in-vicinity libdir
+                                       (string-append libname ".la"))))
+     (and (file-exists? libtool-filename)
+         libtool-filename)))
+ 
+ (define (try-using-sharlib-name libdir libname)
+   (in-vicinity libdir (string-append libname ".so")))
+ 
+ (define (link-dynamic-module filename initname)
+   ;; Register any linked modules which have been registered on the C level
+   (register-modules #f)
+   (let ((dynobj (dynamic-link filename)))
+     (dynamic-call initname dynobj)
+     (register-modules dynobj)))
+ 
+ (define (try-module-linked module-name)
+   (init-dynamic-module module-name))
+
+ (define (try-module-dynamic-link module-name)
+   (and (find-and-link-dynamic-module module-name)
+       (init-dynamic-module module-name))))
+;; end of deprecated section
+ 
 
 (define autoloads-done '((guile . guile)))