mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-30 00:40:20 +02:00
Code Activity

* boot-9.scm (begin-deprecated): New.

Browse source 
(call-with-deprecation): Removed.
(id): Use `issue-deprecation-warning' instead of
`call-with-deprecation'.  Wrap definition in `begin-deprecated'.
(eval-in-module): Manifest deprecation via `begin-deprecation' and
`issue-deprecation-warning'.
(warn-autoload-deprecation): Deactivated.
This commit is contained in:
Marius Vollmer 2001-05-02 00:59:43 +00:00
parent 7440341cf6
commit 9fb41ceac5
1 changed files with 37 additions and 73 deletions
Download patch file Download diff file Expand all files Collapse all files

110
ice-9/boot-9.scm
View file

@ -30,6 +30,20 @@
;;; Code: ;;; Code:
;;; {Deprecation}
;;;
;; We don't have macros here, but we do want to define
;; `begin-deprecated' early.
(define begin-deprecated
(procedure->memoizing-macro
(lambda (exp env)
(if (include-deprecated-features)
`(begin ,@(cdr exp))
`#f))))
;;; {Features} ;;; {Features}
;; ;;
@ -99,6 +113,11 @@
(define (and=> value procedure) (and value (procedure value))) (define (and=> value procedure) (and value (procedure value)))
(define (make-hash-table k) (make-vector k '())) (define (make-hash-table k) (make-vector k '()))
(begin-deprecated
(define (id x)
(issue-deprecation-warning "`id' is deprecated. Use `identity' instead.")
(identity x)))
;;; apply-to-args is functionally redunant with apply and, worse, ;;; apply-to-args is functionally redunant with apply and, worse,
;;; is less general than apply since it only takes two arguments. ;;; is less general than apply since it only takes two arguments.
;;; ;;;
@ -114,25 +133,7 @@
(define (apply-to-args args fn) (apply fn args)) (define (apply-to-args args fn) (apply fn args))
;;; {Deprecation}
;;;
(define call-with-deprecation
(let ((issued-warnings (make-hash-table 13)))
(lambda (msg thunk)
(cond ((not (hashv-ref issued-warnings msg #f))
(display ";;; " (current-error-port))
(display msg (current-error-port))
(newline (current-error-port))
(hashv-set! issued-warnings msg #t)))
(thunk))))
(define (id x)
(call-with-deprecation "`id' is deprecated. Use `identity' instead."
(lambda ()
(identity x))))
;;; {Integer Math} ;;; {Integer Math}
;;; ;;;
@ -1017,9 +1018,11 @@
;; to maximally one module. ;; to maximally one module.
(set-procedure-property! closure 'module module)))) (set-procedure-property! closure 'module module))))
;;; This procedure is deprecated (begin-deprecated
;;; (define (eval-in-module exp mod)
(define eval-in-module eval) (issue-deprecation-warning
"`eval-in-module' is deprecated. Use `eval' instead.")
(eval exp mod)))
;;; {Observer protocol} ;;; {Observer protocol}
@ -1738,48 +1741,12 @@
;;; Dynamic linking of modules ;;; Dynamic linking of modules
;; Initializing a module that is written in C is a two step process. ;; This method of dynamically linking Guile Extensions is deprecated.
;; First the module's `module init' function is called. This function ;; Use `dynamic-link' and `dynamic-call' explicitely from Scheme code
;; is expected to call `scm_register_module_xxx' to register the `real ;; instead.
;; init' function. Later, when the module is referenced for the first
;; time, this real init function is called in the right context. See ;; XXX - We can not offer the removal of this code thru the
;; gtcltk-lib/gtcltk-module.c for an example. ;; deprecation mechanism since we have no complete replacement yet.
;;
;; The code for the module can be in a regular shared library (so that
;; the `module init' function will be called when libguile is
;; initialized). Or it can be dynamically linked.
;;
;; You can safely call `scm_register_module_xxx' before libguile
;; itself is initialized. You could call it from an C++ constructor
;; of a static object, for example.
;;
;; To make your Guile extension into a dynamic linkable module, follow
;; these easy steps:
;;
;; - Find a name for your module, like (ice-9 gtcltk)
;; - Write a function with a name like
;;
;; scm_init_ice_9_gtcltk_module
;;
;; This is your `module init' function. It should call
;;
;; scm_register_module_xxx ("ice-9 gtcltk", scm_init_gtcltk);
;;
;; "ice-9 gtcltk" is the C version of the module name. Slashes are
;; replaced by spaces, the rest is untouched. `scm_init_gtcltk' is
;; the real init function that executes the usual initializations
;; like making new smobs, etc.
;;
;; - Make a shared library with your code and a name like
;;
;; ice-9/libgtcltk.so
;;
;; and put it somewhere in %load-path.
;;
;; - Then you can simply write `:use-module (ice-9 gtcltk)' and it
;; will be linked automatically.
;;
;; This is all very experimental.
(define (split-c-module-name str) (define (split-c-module-name str)
(let loop ((rev '()) (let loop ((rev '())
@ -1812,17 +1779,14 @@
registered-modules))) registered-modules)))
(define (warn-autoload-deprecation modname) (define (warn-autoload-deprecation modname)
(display ;; Do nothing here until we can deprecate the code for real.
";;; Autoloading of compiled code modules is deprecated.\n" (if #f
(current-error-port)) (issue-deprecation-warning
(display "Autoloading of compiled code modules is deprecated."
";;; Write a Scheme file instead that uses `dynamic-link' directly.\n" "Write a Scheme file instead that uses `dynamic-link' directly.")))
(current-error-port))
(format (current-error-port)
";;; (You just tried to autoload module ~S.)\n" modname))
(define (init-dynamic-module modname) (define (init-dynamic-module modname)
;; Register any linked modules which has been registered on the C level ;; Register any linked modules which have been registered on the C level
(register-modules #f) (register-modules #f)
(or-map (lambda (modinfo) (or-map (lambda (modinfo)
(if (equal? (car modinfo) modname) (if (equal? (car modinfo) modname)