wingo pushed a commit to branch wip-whippet
in repository guile.
commit 7d899fa7c7ed7627e4391af0d41ea6ce80db72f4
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Thu Jun 12 21:54:07 2025 +0200
Refactor (ice-9 deprecated) to be more concise
* module/ice-9/deprecated.scm (define-deprecated-trampoline):
(define-deprecated-trampolines): New helpers. Use them to define all
the trampolines.
---
module/ice-9/deprecated.scm | 210 ++++++++++++--------------------------------
1 file changed, 57 insertions(+), 153 deletions(-)
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 75f0e48a0..bb0beab5d 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -56,10 +56,31 @@
exp)))
(export rule)))
-(define (make-guardian*)
- (issue-deprecation-warning
- "make-guardian in the default environment is deprecated. Import it
-from (ice-9 guardians) instead.")
+(define-syntax define-deprecated-trampoline
+ (lambda (stx)
+ (syntax-case stx ()
+ ((_ ((mod proc) . params) exp)
+ (let* ((proc* (datum->syntax #'proc
+ (symbol-append (syntax->datum #'proc) '*)))
+ (msg (string-append
+ (symbol->string (syntax->datum #'proc))
+ " in the default environment is deprecated.\n"
+ "Import it from " (object->string (syntax->datum #'mod))
+ " instead.")))
+ #`(define* (#,proc* . params)
+ (issue-deprecation-warning #,msg)
+ exp))))))
+
+(define-syntax define-deprecated-trampolines
+ (lambda (stx)
+ (syntax-case stx ()
+ ((_ mod (proc arg ...) ...)
+ #'(begin
+ (define-deprecated-trampoline ((mod proc) arg ...)
+ (proc arg ...))
+ ...)))))
+
+(define-deprecated-trampolines (ice-9 guardians)
(make-guardian))
(define* (module-observe-weak module observer-id #:optional (proc observer-id))
@@ -67,170 +88,53 @@ from (ice-9 guardians) instead.")
"module-observe-weak is deprecated. Use module-observe instead.")
(module-observe module proc))
-(define (make-object-property*)
- (issue-deprecation-warning
- "make-object-property in the default environment is deprecated. Import
-it from (ice-9 object-properties) instead.")
- (make-object-property))
-
-(define (object-properties* obj)
- (issue-deprecation-warning
- "object-properties in the default environment is deprecated. Import
-it from (ice-9 object-properties) instead.")
- (object-properties obj))
-
-(define (set-object-properties!* obj props)
- (issue-deprecation-warning
- "set-object-properties! in the default environment is deprecated. Import
-it from (ice-9 object-properties) instead.")
- (set-object-properties! obj props))
-
-(define (object-property* obj key)
- (issue-deprecation-warning
- "object-property in the default environment is deprecated. Import
-it from (ice-9 object-properties) instead.")
- (object-property obj key))
-
-(define (set-object-property!* obj key value)
- (issue-deprecation-warning
- "set-object-properties! in the default environment is deprecated. Import
-it from (ice-9 object-properties) instead.")
+(define-deprecated-trampolines (ice-9 object-properties)
+ (make-object-property)
+ (object-properties obj)
+ (set-object-properties! obj props)
+ (object-property obj key)
(set-object-property! obj key value))
-(define* (make-weak-key-hash-table* #:optional (n 0))
- (issue-deprecation-warning
- "make-weak-key-hash-table in the default environment is deprecated.
-Import it from (ice-9 weak-tables) instead.")
+(define-deprecated-trampoline (((ice-9 weak-tables) make-weak-key-hash-table)
+ #:optional (n 0))
(make-weak-key-hash-table))
-
-(define* (make-weak-value-hash-table* #:optional (n 0))
- (issue-deprecation-warning
- "make-weak-value-hash-table in the default environment is deprecated.
-Import it from (ice-9 weak-tables) instead.")
+(define-deprecated-trampoline (((ice-9 weak-tables) make-weak-value-hash-table)
+ #:optional (n 0))
(make-weak-value-hash-table))
-
-(define* (make-doubly-weak-hash-table* #:optional (n 0))
- (issue-deprecation-warning
- "make-weak-key-hash-table in the default environment is deprecated.
-Import it from (ice-9 weak-tables) instead.")
+(define-deprecated-trampoline (((ice-9 weak-tables)
make-doubly-weak-hash-table)
+ #:optional (n 0))
(make-doubly-weak-hash-table))
-(define (weak-key-hash-table?* x)
- (issue-deprecation-warning
- "weak-key-hash-table? in the default environment is deprecated.
-Import it from (ice-9 weak-tables) instead.")
- (weak-key-hash-table? x))
-
-(define (weak-value-hash-table?* x)
- (issue-deprecation-warning
- "weak-value-hash-table? in the default environment is deprecated.
-Import it from (ice-9 weak-tables) instead.")
- (weak-value-hash-table? x))
-
-(define (doubly-weak-hash-table?* x)
- (issue-deprecation-warning
- "doubly-weak-hash-table? in the default environment is deprecated.
-Import it from (ice-9 weak-tables) instead.")
+(define-deprecated-trampolines (ice-9 weak-tables)
+ (weak-key-hash-table? x)
+ (weak-value-hash-table? x)
(doubly-weak-hash-table? x))
-(define (supports-source-properties?* x)
- (issue-deprecation-warning
- "supports-source-properties? in the default environment is deprecated.
-Import it from (ice-9 source-properties) instead.")
- (supports-source-properties? x))
-
-(define (source-properties* x)
- (issue-deprecation-warning
- "source-properties in the default environment is deprecated.
-Import it from (ice-9 source-properties) instead.")
- (source-properties x))
-
-(define (set-source-properties!* x alist)
- (issue-deprecation-warning
- "set-source-properties! in the default environment is deprecated.
-Import it from (ice-9 source-properties) instead.")
- (set-source-properties! x alist))
-
-(define (source-property* x k)
- (issue-deprecation-warning
- "source-property in the default environment is deprecated.
-Import it from (ice-9 source-properties) instead.")
- (source-property x k))
-
-(define (set-source-property!* x k v)
- (issue-deprecation-warning
- "set-source-property! in the default environment is deprecated.
-Import it from (ice-9 source-properties) instead.")
- (set-source-property! x k v))
-
-(define (cons-source* orig x y)
- (issue-deprecation-warning
- "cons-source in the default environment is deprecated.
-Import it from (ice-9 source-properties) instead.")
+(define-deprecated-trampolines (ice-9 source-properties)
+ (supports-source-properties? x)
+ (source-properties x)
+ (set-source-properties! x alist)
+ (source-property x k)
+ (set-source-property! x k v)
(cons-source orig x y))
-(define (array-fill!* array fill)
- (issue-deprecation-warning
- "array-fill! in the default environment is deprecated.
-Import it from (ice-9 arrays) instead.")
- (array-fill! array fill))
-
-(define (array-copy!* src dst)
- (issue-deprecation-warning
- "array-copy! in the default environment is deprecated.
-Import it from (ice-9 arrays) instead.")
- (array-copy! src dst))
-
-(define (array-copy-in-order!* src dst)
- (issue-deprecation-warning
- "array-copy-in-order! in the default environment is deprecated.
-Import it from (ice-9 arrays) instead.")
- (array-copy-in-order! src dst))
+(define-deprecated-trampolines (ice-9 arrays)
+ (array-fill! array fill)
+ (array-copy! src dst)
+ (array-copy-in-order! src dst)
+ (array-index-map! array proc))
-(define (array-map!* dst proc . src*)
- (issue-deprecation-warning
- "array-map! in the default environment is deprecated.
-Import it from (ice-9 arrays) instead.")
+(define-deprecated-trampoline (((ice-9 arrays) array-map!) dst proc . src*)
(apply array-map! dst proc src*))
-
-(define (array-for-each* proc array . arrays)
- (issue-deprecation-warning
- "array-for-each in the default environment is deprecated.
-Import it from (ice-9 arrays) instead.")
+(define-deprecated-trampoline (((ice-9 arrays) array-for-each) proc array .
arrays)
(apply array-for-each proc array arrays))
-
-(define (array-index-map!* array proc)
- (issue-deprecation-warning
- "array-index-map! in the default environment is deprecated.
-Import it from (ice-9 arrays) instead.")
- (array-index-map! array proc))
-
-(define (array-equal?* . arrays)
- (issue-deprecation-warning
- "array-equal? in the default environment is deprecated.
-Import it from (ice-9 arrays) instead.")
+(define-deprecated-trampoline (((ice-9 arrays) array-equal?) . arrays)
(apply array-equal? arrays))
-
-(define (array-slice-for-each* frame-rank proc . arrays)
- (issue-deprecation-warning
- "array-slice-for-each in the default environment is deprecated.
-Import it from (ice-9 arrays) instead.")
+(define-deprecated-trampoline (((ice-9 arrays) array-slice-for-each)
frame-rank proc . arrays)
(apply array-slice-for-each frame-rank proc arrays))
-
-(define (array-slice-for-each-in-order* frame-rank proc . arrays)
- (issue-deprecation-warning
- "array-slice-for-each-in-order in the default environment is deprecated.
-Import it from (ice-9 arrays) instead.")
+(define-deprecated-trampoline (((ice-9 arrays) array-slice-for-each-in-order)
frame-rank proc . arrays)
(apply array-slice-for-each-in-order frame-rank proc arrays))
-
-(define (array-cell-ref* array . indices)
- (issue-deprecation-warning
- "array-cell-ref in the default environment is deprecated.
-Import it from (ice-9 arrays) instead.")
+(define-deprecated-trampoline (((ice-9 arrays) array-cell-ref) array . indices)
(apply array-cell-ref array indices))
-
-(define (array-cell-set!* array val . indices)
- (issue-deprecation-warning
- "array-cell-set! in the default environment is deprecated.
-Import it from (ice-9 arrays) instead.")
+(define-deprecated-trampoline (((ice-9 arrays) array-cell-set!) array val .
indices)
(apply array-cell-set! array val indices))
