1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-03 18:50:19 +02:00

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.
This commit is contained in:
Andy Wingo 2025-05-06 11:09:34 +02:00
parent 57f0ce914a
commit 852c0b05c7
3 changed files with 16 additions and 66 deletions

View file

@ -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)

View file

@ -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))

View file

@ -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)))