(in-package :smoke)

(defvar *smoke-id-class-map*
  (make-hash-table)
  "Maps a Smoke module pointer - id pair to a class.")
;; FIXME disallow adding a class when threads are running or add a lock.

(defun id-class-map (smoke)
  (let ((value (gethash (pointer-address (smoke-module-pointer smoke))
                        *smoke-id-class-map*)))
    (assert value () "Unknown smoke module ~A." smoke)
    value))

(defun (setf id-class-map) (new-value smoke)
  (setf (gethash (pointer-address (smoke-module-pointer smoke))
                 *smoke-id-class-map*)
        new-value))

(defun add-id-class-map (smoke)
  (setf (id-class-map smoke) (make-hash-table)))

(defun add-id (smoke-class class)
  "Associates the CLOS class CLASS with SMOKE-CLASS."
  (setf (gethash (id smoke-class) (id-class-map (smoke smoke-class)))
        class))

(defun find-smoke-class (class &optional (error-p t))
  "Returns the CLOS class for smoke-class CLASS."
  (let* ((class (handler-case (real-class class)
                  (undefined-class (e) (when error-p (error e)))))
         (ret (when class (gethash (id class) (id-class-map (smoke class))))))
    (when error-p
      (assert (not (null ret))
              ()
              "The class ~A was not found." (name class)))
    ret))