(define callback-registry
    (make-hash-table))

  (define-method (refcount (alist <list>))
    (cdr (find (lambda (a) (eq? refcount: (car a))) alist)))
  (define-method (refcount (ht <hash-table>) (ptr <pointer>))
    (if (hash-table-exists? callback-registry ptr)
        (refcount (hash-table-ref ht ptr))
        0))

  (define-class <QMLBase> ()
    ((ptr accessor: ptr initform: #f)))
  (define-method (delete-pointer (qbase <QMLBase>))
    (abort (make-property-condition 'exn 'Message "Please implement the delete method for your subtype.")))
  (define-method (add-ptrentry (qbase <QMLBase>))
    (hash-table-update! callback-registry (ptr qbase)
                        (lambda (alist)
                          (alist-update refcount: (+ 1 (refcount alist)) alist))
                        (lambda ()
                          (alist-cons refcount: 1 '()))))
  (define-method (remove-ptrentry (qbase <QMLBase>))
    (if (eq? 1 (refcount callback-registry (ptr qbase)))
        (hash-table-delete! callback-registry (ptr qbase))
        (hash-table-update! callback-registry (ptr qbase)
                            (lambda (alist)
                              (alist-update refcount: (- (refcount alist) 1) alist)))))
  (define-method (initialize-instance (qbase <QMLBase>))
    (call-next-method)
    (add-ptrentry qbase)
    (set-finalizer! qbase (lambda (obj)
                            (remove-ptrentry qbase)
                            (when (= 0 (refcount callback-registry (ptr qbase)))))))