diff options
author | Andy Wingo <wingo@pobox.com> | 2016-10-23 11:56:13 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-10-23 12:17:19 +0200 |
commit | 56b490a4dd9b8d775d476154c0d4b96483b49436 (patch) | |
tree | 8130c458df4e6bedf22e952ee988c2269f85a9ac | |
parent | 206dced87f425af7eed628530313067a45bee2c2 (diff) | |
download | guile-56b490a4dd9b8d775d476154c0d4b96483b49436.tar.gz |
Deferred module observers via a parameter
* module/ice-9/boot-9.scm (module-defer-observers): Instead of being a
global flag, change to be a parameter.
(module-defer-observers-mutex, module-defer-observers-table): Remove.
(module-modified): Adapt.
(call-with-deferred-observers): Adapt. Allow nested called.
-rw-r--r-- | module/ice-9/boot-9.scm | 38 |
1 files changed, 20 insertions, 18 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 99543e7a5..48ea61d77 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -2029,31 +2029,33 @@ written into the port is returned." (set-module-observers! module (delq1! id (module-observers module))))) *unspecified*) -(define module-defer-observers #f) -(define module-defer-observers-mutex (make-mutex 'recursive)) -(define module-defer-observers-table (make-hash-table)) +;; Hash table of module -> #t indicating modules that changed while +;; observers were deferred, or #f if observers are not being deferred. +(define module-defer-observers (make-parameter #f)) (define (module-modified m) - (if module-defer-observers - (hash-set! module-defer-observers-table m #t) - (module-call-observers m))) + (cond + ((module-defer-observers) => (lambda (tab) (hashq-set! tab m #t))) + (else (module-call-observers m)))) ;;; This function can be used to delay calls to observers so that they ;;; can be called once only in the face of massive updating of modules. ;;; (define (call-with-deferred-observers thunk) - (dynamic-wind - (lambda () - (lock-mutex module-defer-observers-mutex) - (set! module-defer-observers #t)) - thunk - (lambda () - (set! module-defer-observers #f) - (hash-for-each (lambda (m dummy) - (module-call-observers m)) - module-defer-observers-table) - (hash-clear! module-defer-observers-table) - (unlock-mutex module-defer-observers-mutex)))) + (cond + ((module-defer-observers) (thunk)) + (else + (let ((modules (make-hash-table))) + (dynamic-wind (lambda () #t) + (lambda () + (parameterize ((module-defer-observers modules)) + (thunk))) + (lambda () + (let ((changed (hash-map->list cons modules))) + (hash-clear! modules) + (for-each (lambda (pair) + (module-call-observers (car pair))) + changed)))))))) (define (module-call-observers m) (for-each (lambda (proc) (proc m)) (module-observers m)) |