[plt-scheme] Seeking comments about my object finalize module
I've made a module which attempts to automate the task of finalizing
object% instances. It registers instances with a will-executor so that
when they are no longer reachable they are finalized, and it registers
them with a custom exit-handler so that if they are still reachable they
are finalized when MzScheme exits. Instances are finalized by sending
them a `finalize' message, so they must implement a method named such.
It works via a syntax wrapper around class* which inserts at the end of
the class-clause a call to a procedure which registers the instance. It
attempts to conserve resources by not allocating them until needed, to
be concurrency-safe, to make finalizing atomic by disabling breaks, and
to be reliable by not letting exceptions from an instance's `finalize'
method stop the facility from dispatching other finalizers.
I'm seeking comments about it in general and specifically. I want to
know if I did anything wrong or how it could be or should be. Thanks
for any feedback!
;--------------------------------------------------------------------
(module finalize mzscheme
(require (lib "class.ss"))
(provide class/finalize
class*/finalize)
(define ((error-display where) ex)
((error-display-handler)
(string-append (format "exn:fail trapped by finalize ~a: " where)
(exn-message ex))
ex))
(define-values (wextor wextor-sema wextor-thread exit-ht)
(values #f #f #f #f))
(define initialize
(let ([init-sema (make-semaphore 1)])
(lambda ()
;(printf "initialize~n")
(call-with-semaphore init-sema
(lambda ()
(when initialize
(set! wextor (make-will-executor))
(set! wextor-sema (make-semaphore 1))
(set! wextor-thread
(thread (lambda ()
(let loop () (will-execute wextor) (loop)))))
(set! exit-ht (make-hash-table 'weak))
(let ([orig (exit-handler)])
(exit-handler
(lambda (ev)
;(printf "exit-handler~n")
(parameterize-break #f
(call-with-semaphore wextor-sema
(lambda () (kill-thread wextor-thread)))
(hash-table-for-each exit-ht
(lambda (instance _)
(with-handlers ([exn:fail?
(error-display
"exit-handler")])
(send instance finalize)))))
(orig ev))))
(set! initialize #f)))))))
(define (register instance)
;(printf "register ~s~n" instance)
(parameterize-break #f
(when initialize (initialize))
(will-register wextor instance
(lambda (_instance)
;(printf "will for ~s~n" _instance)
(parameterize-break #f
(call-with-semaphore wextor-sema
(lambda ()
(with-handlers ([exn:fail?
(error-display "will-executor")])
(send _instance finalize))
(hash-table-remove! exit-ht _instance))))))
(hash-table-put! exit-ht instance #f)))
(define-syntax (class/finalize stx)
(syntax-case stx ()
[(_ superclass-expr class-clauses ...)
(syntax/loc stx
(class*/finalize superclass-expr () class-clauses ...))]))
(define-syntax (class*/finalize stx)
(syntax-case stx ()
[(_ superclass-expr (interface-exprs ...) class-clauses ...)
(syntax/loc stx
(class* superclass-expr (interface-exprs ...)
class-clauses ...
(register this)))]))
)
#|
(module test mzscheme
(require (lib "class.ss")
finalize)
(define C%
(class/finalize object%
(super-new)
(define/public (finalize)
(printf "~s finalize~n" this)
#;(error "from inside C% finalize"))))
(define c (new C%))
(sleep 1)
(set! c (new C%))
(collect-garbage)
(sleep 1)
(exit)
)
(require test)
|#
;--------------------------------------------------------------------
--
: Derick
----------------------------------------------------------------