wingo pushed a commit to branch wip-whippet
in repository guile.
commit 852c0b05c7483a6ee367a00d0bfed7f8660ed9c5
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Tue May 6 11:09:34 2025 +0200
Remove module weak observers
If that's what you want, you need to bring your own weak hash table on a
normal observer.
* module/ice-9/boot-9.scm (module): Remove weak-observers field.
(make-module, make-autoload-interface): Don't pass weak table to
constructor.
(module-observe-weak): Remove.
(module-unobserve, module-call-observers): Remove weak case.
* module/ice-9/deprecated.scm (module-observe-weak): Dispatch to
module-observe.
* test-suite/tests/modules.test ("observers"): Adapt.
---
module/ice-9/boot-9.scm | 31 ++++---------------------------
module/ice-9/deprecated.scm | 8 +++++++-
test-suite/tests/modules.test | 43 +++++--------------------------------------
3 files changed, 16 insertions(+), 66 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 5443b2fb6..98ba4660b 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2291,9 +2291,6 @@ name extensions listed in %load-extensions."
;;; - observers: a list of procedures that get called when the module is
;;; modified.
;;;
-;;; - weak-observers: a weak-key hash table of procedures that get called
-;;; when the module is modified. See `module-observe-weak' for details.
-;;;
;;; In addition, the module may (must?) contain a binding for
;;; `%module-public-interface'. This variable should be bound to a module
;;; representing the exported interface of a module. See the
@@ -2486,7 +2483,6 @@ name extensions listed in %load-extensions."
duplicates-handlers
(import-obarray #:no-setter)
observers
- (weak-observers #:no-setter)
version
submodules
submodule-binder
@@ -2514,7 +2510,7 @@ initial uses list, or binding procedure."
#f #f #f
(make-hash-table)
'()
- (make-weak-key-hash-table) #f
+ #f
(make-hash-table) #f #f #f 0
(make-hash-table) #f))
@@ -2528,24 +2524,10 @@ initial uses list, or binding procedure."
(set-module-observers! module (cons proc (module-observers module)))
(cons module proc))
-(define* (module-observe-weak module observer-id #:optional (proc observer-id))
- "Register PROC as an observer of MODULE under name OBSERVER-ID (which can
-be any Scheme object). PROC is invoked and passed MODULE any time
-MODULE is modified. PROC gets unregistered when OBSERVER-ID gets GC'd
-(thus, it is never unregistered if OBSERVER-ID is an immediate value,
-for instance).
-
-The two-argument version is kept for backward compatibility: when called
-with two arguments, the observer gets unregistered when closure PROC
-gets GC'd (making it impossible to use an anonymous lambda for PROC)."
- (hashq-set! (module-weak-observers module) observer-id proc))
-
(define (module-unobserve token)
(let ((module (car token))
(id (cdr token)))
- (if (integer? id)
- (hash-remove! (module-weak-observers module) id)
- (set-module-observers! module (delq1! id (module-observers module)))))
+ (set-module-observers! module (delq1! id (module-observers module))))
*unspecified*)
;; Hash table of module -> #t indicating modules that changed while
@@ -2577,12 +2559,7 @@ gets GC'd (making it impossible to use an anonymous
lambda for PROC)."
changed))))))))
(define (module-call-observers m)
- (for-each (lambda (proc) (proc m)) (module-observers m))
-
- ;; We assume that weak observers don't (un)register themselves as they are
- ;; called since this would preclude proper iteration over the hash table
- ;; elements.
- (hash-for-each (lambda (id proc) (proc m)) (module-weak-observers m)))
+ (for-each (lambda (proc) (proc m)) (module-observers m)))
@@ -3459,7 +3436,7 @@ error if selected binding does not exist in the used
module."
(error "binding not presentin module" name sym))))
#:warning "Failed to autoload ~a in ~a:\n" sym name))))
(module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f
- (make-hash-table 0) '() (make-weak-value-hash-table) #f
+ (make-hash-table 0) '() #f
(make-hash-table 0) #f #f #f 0 (make-hash-table 0)
#f)))
(define (module-autoload! module . args)
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 4d87e8fb3..d7f7a6104 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -17,7 +17,8 @@
(define-module (ice-9 deprecated)
#:use-module (ice-9 guardians)
- #:export ((make-guardian* . make-guardian)))
+ #:export ((make-guardian* . make-guardian)
+ module-observe-weak))
#;
(define-syntax-rule (define-deprecated name message exp)
@@ -34,3 +35,8 @@
"make-guardian in the default environment is deprecated. Import it
from (ice-9 guardians) instead.")
(make-guardian))
+
+(define* (module-observe-weak module observer-id #:optional (proc observer-id))
+ (issue-deprecation-warning
+ "module-observe-weak is deprecated. Use module-observe instead.")
+ (module-observe module proc))
diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test
index de595c02d..2a309a470 100644
--- a/test-suite/tests/modules.test
+++ b/test-suite/tests/modules.test
@@ -1,6 +1,6 @@
;;;; modules.test --- exercise some of guile's module stuff -*- scheme -*-
-;;;; Copyright (C) 2006, 2007, 2009-2011, 2014, 2019 Free Software Foundation,
Inc.
+;;;; Copyright (C) 2006, 2007, 2009-2011, 2014, 2019, 2025 Free Software
Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -212,49 +212,16 @@
(with-test-prefix "observers"
- (pass-if "weak observer invoked"
+ (pass-if "observer invoked"
(let* ((m (make-module))
(invoked 0))
- (module-observe-weak m (lambda (mod)
- (if (eq? mod m)
- (set! invoked (+ invoked 1)))))
+ (module-observe m (lambda (mod)
+ (if (eq? mod m)
+ (set! invoked (+ invoked 1)))))
(module-define! m 'something 2)
(module-define! m 'something-else 1)
(= invoked 2)))
- (pass-if "all weak observers invoked"
- ;; With the two-argument `module-observe-weak' available in previous
- ;; versions, the observer would get unregistered as soon as the observing
- ;; closure gets GC'd, making it impossible to use an anonymous lambda as
- ;; the observing procedure.
-
- (let* ((m (make-module))
- (observer-count 500)
- (observer-ids (let loop ((i observer-count)
- (ids '()))
- (if (= i 0)
- ids
- (loop (- i 1) (cons (make-module) ids)))))
- (observers-invoked (make-hash-table observer-count)))
-
- ;; register weak observers
- (for-each (lambda (id)
- (module-observe-weak m id
- (lambda (m)
- (hashq-set! observers-invoked
- id #t))))
- observer-ids)
-
- (gc)
-
- ;; invoke them
- (module-call-observers m)
-
- ;; make sure all of them were invoked
- (->bool (every (lambda (id)
- (hashq-ref observers-invoked id))
- observer-ids))))
-
(pass-if "imported bindings updated"
(let ((m (make-module))
(imported (make-module)))
