Sun Aug 2 12:12:41 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Cleanup C++ to Lisp translation

--- old-smoke/src/class-map.lisp 2014-10-30 08:11:47.000000000 +0100

+++ new-smoke/src/class-map.lisp 2014-10-30 08:11:47.000000000 +0100

@@ -5,35 +5,31 @@

"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

- ()

+ (assert value ()

"Unknown smoke module ~A ~A."

smoke (smoke-get-module-name (smoke-module-pointer smoke)))

value))

(defun (setf id-class-map) (new-value smoke)

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

+ (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)))

+ (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)))

+ (setf (gethash (id smoke-class) (id-class-map (smoke smoke-class)))

class))

(defun find-smoke-class (class)

"Returns the CLOS class for smoke-class CLASS."

(let* ((class (real-class class))

- (ret (gethash (id class)

- (id-class-map (smoke class)))))

+ (ret (gethash (id class) (id-class-map (smoke class)))))

(assert (not (null ret))

()

"The class ~A was not found." (name class))