[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/03: Deferred module observers via a parameter
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/03: Deferred module observers via a parameter |
Date: |
Sun, 23 Oct 2016 20:34:19 +0000 (UTC) |
wingo pushed a commit to branch master
in repository guile.
commit 56b490a4dd9b8d775d476154c0d4b96483b49436
Author: Andy Wingo <address@hidden>
Date: Sun Oct 23 11:56:13 2016 +0200
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.
---
module/ice-9/boot-9.scm | 38 ++++++++++++++++++++------------------
1 file changed, 20 insertions(+), 18 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 99543e7..48ea61d 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))