From d879f751528abc68ceb3740dfc8e7ac648b1edc8 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@eecs.northwestern.edu>
Date: Sun, 28 Nov 2010 15:24:49 -0600
Subject: [PATCH] adjusted the registration mechanism for planet-terse-register
 to be clearer and simpler

---
 collects/planet/planet.scrbl   | 33 +++++++++++++++++----------------
 collects/planet/terse-info.rkt | 34 ++++++++++++++++------------------
 2 files changed, 33 insertions(+), 34 deletions(-)

diff --git a/collects/planet/planet.scrbl b/collects/planet/planet.scrbl
index fd3c4fee09..59d31e9fe8 100644
--- a/collects/planet/planet.scrbl
+++ b/collects/planet/planet.scrbl
@@ -736,30 +736,31 @@ namespace-specific.
 @defproc[(planet-terse-register
           [proc (-> (or/c 'download 'install 'docs-build 'finish)
                     string?
-                    any/c)]
-          [key symbol? (planet-terse-log-key-param)])
+                    any/c)])
          void?]{
 Registers @racket[proc] as a function to be called when
-@racket[planet-terse-log] is called with a matching namespace argument.
- Note that @racket[proc] is called 
+@racket[planet-terse-log] is called.
+
+Note that @racket[proc] is called 
 asynchronously (ie, on some thread other than the one calling @racket[planet-terse-register]).
 }
 
 @defproc[(planet-terse-log [id (or/c 'download 'install 'finish)]
-                           [msg string?]
-                           [key symbol? (planet-terse-log-key-param)]) void?]{
-This function is called by PLaneT to announce when things are happening.
-The namespace passed along is used to identify the procs to notify. This function
-invokes all of the callbacks registered with @racket[key], and when PLaneT invokes it,
-the @racket[key] argument is always @racket[(planet-terse-log-key-param)].
+                           [msg string?]) void?]{
+This function is called by PLaneT to announce when things are happening. See also
+@racket[planet-terse-set-key].
 }
 
-@defparam[planet-terse-log-key-param key symbol?]{
-  Holds the current value of the key used for getting and setting the @PLaneT logging information.                                                  
-}
-
-@defproc[(planet-terse-set-key [key symbol?]) void?]{
-  Equivalent to @racket[(planet-terse-log-key-param new-key)].                                               
+@defproc[(planet-terse-set-key [key any/c]) void?]{
+  This sets a @seclink["threadcells" #:doc '(lib "scribblings/reference/reference.scrbl")]{thread cell}
+  to the value of @racket[key].
+  The value of the thread cell is used as an index into a table to determine which
+  of the functions passed to @racket[planet-terse-register] to call when 
+  @racket[planet-terse-log] is called.
+  
+  The table holding the key uses ephemerons and a weak hash table to ensure that
+  when the @racket[key] is unreachable, then the procedures passed to @racket[planet-terse-log]
+  cannot be reached through the table.
 }
 
 @section{Developing Packages for PLaneT}
diff --git a/collects/planet/terse-info.rkt b/collects/planet/terse-info.rkt
index 51519fb078..c4d256ae9a 100644
--- a/collects/planet/terse-info.rkt
+++ b/collects/planet/terse-info.rkt
@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
 
 #|
 
@@ -14,12 +14,11 @@ seems little point to that).
   
 (provide planet-terse-register
          planet-terse-log
-         planet-terse-set-key
-         planet-terse-log-key-param) 
+         planet-terse-set-key) 
 
 (define terse-log-message-chan (make-channel))
 (define terse-log-proc-chan (make-channel))
-(define planet-terse-log-key-param (make-parameter (gensym)))
+(define log-key-tc (make-thread-cell (gensym) #t))
   
 (define thd
   (thread
@@ -33,30 +32,29 @@ seems little point to that).
              (let ([registry (list-ref msg 0)]
                    [id (list-ref msg 1)]
                    [str (list-ref msg 2)])
-               (for-each (lambda (eph) 
-                           (let ([proc (weak-box-value eph)])
-                             (when proc
-                               (proc id str))))
-                         (hash-ref procs registry '())))
+               (for ([eph (in-list (hash-ref procs registry '()))])
+                 (let ([proc (ephemeron-value eph)])
+                   (when proc
+                     (proc id str)))))
              (loop)))
           (handle-evt
            terse-log-proc-chan
            (lambda (rp)
-             (let ([registry (list-ref rp 0)]
-                   [proc (list-ref rp 1)])
+             (let* ([registry (list-ref rp 0)]
+                    [proc (list-ref rp 1)])
                (hash-update! procs
                              registry 
-                             (lambda (x) (cons (make-weak-box proc) x)) 
+                             (lambda (x) (cons (make-ephemeron registry proc) x)) 
                              '())
                (loop))))))))))
 
-(define (planet-terse-log id str [key (planet-terse-log-key-param)])
-  (sync (channel-put-evt terse-log-message-chan (list key id str)))
+(define (planet-terse-log id str)
+  (sync (channel-put-evt terse-log-message-chan (list (thread-cell-ref log-key-tc) id str)))
   (void))
-  
-(define (planet-terse-register proc [key (planet-terse-log-key-param)])
-  (sync (channel-put-evt terse-log-proc-chan (list key proc)))
+
+(define (planet-terse-register proc)
+  (sync (channel-put-evt terse-log-proc-chan (list (thread-cell-ref log-key-tc) proc)))
   (void))
 
 (define (planet-terse-set-key new-key)
-  (planet-terse-log-key-param new-key))
+  (thread-cell-set! log-key-tc new-key))