(defvar *finalizer-list-map* (make-hash-table :weakness :key))

(defun finalize (object function)
  (let ((finalizer-array (gethash object *finalizer-list-map*)))
    (cond (finalizer-array
           (vector-push-extend function finalizer-array))
          (T
           (let ((finalizer-array (make-array 1 :adjustable T :fill-pointer 0)))
             (vector-push-extend function finalizer-array)
             (setf (gethash object *finalizer-list-map*) finalizer-array)
             (setf (gc:%actual-finalizer-function object)
                   (lambda ()
                     (loop for finalizer across finalizer-array
                           do (funcall finalizer)))))))))