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:
parent
57f0ce914a
commit
852c0b05c7
3 changed files with 16 additions and 66 deletions
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue