Commits

Moritz Heidkamp committed e465802

extract set implementation and use set instead of queue for handlers

Comments (0)

Files changed (2)

  channel-empty? channel-closed? channel-drained?)
 
 (import chicken scheme)
-(use data-structures srfi-18 srfi-1 srfi-69
+(use data-structures srfi-18 srfi-1
      (only srfi-1 filter)
      (only miscmacros push!)
      (only lolevel make-weak-locative locative->object))
 
+(include "set.scm")
+
 (define-record channel
   (setter closed?)
   (setter receivers)
 (define (with-locked-channel channel thunk)
   (with-semaphore (channel-mutex channel) thunk))
 
-
-(define-record set table)
-
-(define %make-set make-set)
-
-(define (make-set)
-  (%make-set (make-hash-table eq?)))
-
-(define (set-contains? set object)
-  (hash-table-exists? (set-table set) object))
-
-(define (set-insert! set object)
-  (hash-table-set! (set-table set) object #t))
-
-(define (set-insert-list! set objects)
-  (for-each
-   (lambda (object)
-     (set-insert! set object))
-   objects))
-
-(define (set-remove! set object)
-  (hash-table-delete! (set-table set) object))
-
-(define (set-clear! set)
-  (hash-table-clear! (set-table set)))
-
-(define (set-members set)
-  (hash-table-keys (set-table set)))
-
-(define (set-fold set proc seed)
-  (hash-table-fold
-   (set-table set)
-   (lambda (k v s) (proc k seed))
-   seed))
-
-(define (set-empty? set)
-  (zero? (hash-table-size (set-table set))))
-
 (define %make-channel make-channel)
 
 (define (queue-add-list! queue items)
      (queue-add! queue item))
    items))
 
-(define (safe-call proc . args)
+(define (safe-apply proc args)
   (handle-exceptions _ #f (begin (apply proc args) #t)))
 
-(define (safe-call-some arg procs)
+(define (safe-apply-some procs . args)
   (fold (lambda (proc handled?)
-          (or (safe-call proc arg) handled?))
+          (or (safe-apply proc args) handled?))
         #f
         procs))
 
-(define (run-callback-queue! queue . args)
-  (let loop ((handled? #f))
-    (unless (queue-empty? queue)
-      (loop (or (apply safe-call (queue-remove! queue) args) handled?)))))
-
-(define (run-callbacks! callbacks message)
+(define (run-callbacks! callbacks . args)
   (define handled? 
     (set-fold
      callbacks
      (lambda (callback handled?)
-       (or (safe-call callback message) handled?))
+       (or (safe-apply callback args) handled?))
      #f))
   (set-clear! callbacks)
   handled?)
 
 (define (make-channel . messages)
   (%make-channel #f '() '()
-                 (make-set)
+                 (make-set eq?)
                  (list->queue messages)
-                 (make-queue)
-                 (make-queue)
+                 (make-set eq?)
+                 (make-set eq?)
                  (make-mutex)
                  (make-condition-variable)))
 
                 (when (run-callbacks! onetime-receivers message)
                   (set! handled? #t)
                   (condition-variable-broadcast! (channel-cvar channel))))
-              (when (or (safe-call-some message receivers) handled?)
+              (when (or (safe-apply-some receivers message) handled?)
                 (queue-remove! queue)
                 (loop)))))
         (when (channel-drained? channel)
-          (run-callback-queue! (channel-on-drain-handlers channel)))))))
+          (run-callbacks! (channel-on-drain-handlers channel)))))))
 
 (define (channel-enqueue channel message . messages)
   (and (not (channel-closed? channel))
               (set-insert-list! otrec args)
               (mutex-unlock! mutex)
               #f)
-            (let ((message (queue-remove! queue)))
-              (unless (safe-call-some message args)
-                (queue-push-back! queue message))
+            (let ((message (queue-first queue)))
+              (when (safe-apply-some args message)
+                (queue-remove! queue))
               (mutex-unlock! mutex)
               #t)))))
 
 
 (define (close-channel channel)
   (set! (channel-closed? channel) #t)
-  (run-callback-queue! (channel-on-close-handlers channel)))
+  (run-callbacks! (channel-on-close-handlers channel)))
 
 (define (channel-empty? channel)
   (queue-empty? (channel-queue channel)))
 (define (on-channel-close channel thunk)
   (if (channel-closed? channel)
       (thunk)
-      (queue-add! (channel-on-close-handlers channel) thunk)))
+      (set-insert! (channel-on-close-handlers channel) thunk)))
 
 (define (on-channel-drain channel thunk)
   (if (channel-drained? channel)
       (thunk)
-      (queue-add! (channel-on-drain-handlers channel) thunk)))
+      (set-insert! (channel-on-drain-handlers channel) thunk)))
 
 (define (siphon-channel source-channel
                         #!optional
+(use extras srfi-69)
+
+(define-record set table)
+
+(define-record-printer (set s out)
+  (fprintf out "#<set ~A>" (hash-table-size (set-table s))))
+
+(define make-set
+  (let ((super make-set))
+    (lambda args
+      (super (apply make-hash-table args)))))
+
+(define (set-contains? set object)
+  (hash-table-exists? (set-table set) object))
+
+(define (set-insert! set object)
+  (hash-table-set! (set-table set) object #t))
+
+(define (set-insert-list! set objects)
+  (for-each
+   (lambda (object)
+     (set-insert! set object))
+   objects))
+
+(define (set-remove! set object)
+  (hash-table-delete! (set-table set) object))
+
+(define (set-clear! set)
+  (hash-table-clear! (set-table set)))
+
+(define (set-members set)
+  (hash-table-keys (set-table set)))
+
+(define (set-fold set proc seed)
+  (hash-table-fold
+   (set-table set)
+   (lambda (k v s) (proc k seed))
+   seed))
+
+(define (set-empty? set)
+  (zero? (hash-table-size (set-table set))))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.