[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/ice-9 boot-9.scm
From: |
Marius Vollmer |
Subject: |
guile/guile-core/ice-9 boot-9.scm |
Date: |
Sat, 02 Jun 2001 18:02:53 -0700 |
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)))
- guile/guile-core/ice-9 boot-9.scm, Marius Vollmer, 2001/06/01
- guile/guile-core/ice-9 boot-9.scm, Marius Vollmer, 2001/06/01
- guile/guile-core/ice-9 boot-9.scm, Marius Vollmer, 2001/06/02
- guile/guile-core/ice-9 boot-9.scm,
Marius Vollmer <=
- guile/guile-core/ice-9 boot-9.scm, Marius Vollmer, 2001/06/04
- guile/guile-core/ice-9 boot-9.scm, Gary Houston, 2001/06/10
- guile/guile-core/ice-9 boot-9.scm, Marius Vollmer, 2001/06/11
- guile/guile-core/ice-9 boot-9.scm, Marius Vollmer, 2001/06/16
- guile/guile-core/ice-9 boot-9.scm, Marius Vollmer, 2001/06/24