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