[plt-scheme] Seeking comments about my object finalize module

From: D.E. (derick.eddington at gmail.com)
Date: Wed Feb 7 00:49:41 EST 2007

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



Posted on the users mailing list.