suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjusted the registration mechanism for planet-terse-register to be clearer and simpler

Browse Source
This commit is contained in:
Robby Findler 2010-11-28 15:24:49 -06:00
parent 2282cae59a
commit d879f75152
2 changed files with 33 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/planet/planet.scrbl
View File

@ -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}

34
collects/planet/terse-info.rkt
View File

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