guile-commits
[Top][All Lists]
Advanced

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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]