From: Lars Rune Nøstdal
Subject: Re: virtual, static, member (?)
Date:
Message-ID: <1227226809.16144.31.camel@blackbox.nostdal.org>
(let ((id-generators (make-hash-table :test #'eq :weakness :key)))
(defmethod generate-id-for (object)
(declare (optimize speed))
(multiple-value-bind (id-generator found-p)
(gethash (class-of object) id-generators)
(if found-p
(funcall (the function id-generator))
(prog1 0
(setf (gethash (class-of object) id-generators)
(let ((id 0))
(declare (integer id))
(lambda () (incf id)))))))))
(defmethod get-obj (id class)
(when (symbolp class)
(setf class (find-class class)))
(multiple-value-bind (object-cache found-p)
(gethash class *global-object-cache-mapping*)
(if found-p
(gethash id object-cache)
(error "No object cache for ~A." class))))
(defclass cached-object ()
((global-object-cache-mapping :reader global-object-cache-mapping-of
:allocation :class
:initform (make-hash-table :test #'eq :weakness :key))
(id :reader id-of)))
(defmethod mk-object-cache (object)
(make-hash-table :test #'equal :weakness :value :synchronized t))
(defmethod initialize-instance :before ((object cached-object) &key (id nil id-supplied-p))
(multiple-value-bind (object-cache found-p)
(gethash (class-of object) (global-object-cache-mapping-of object))
(unless found-p
(setf (gethash (class-of object) (global-object-cache-mapping-of object))
(setf object-cache (mk-object-cache object))))
(let ((id (if id-supplied-p id (generate-id-for object))))
(setf (slot-value object 'id) id
(gethash id object-cache) object))))
AMU> (defclass test (cached-object) ())
#<STANDARD-CLASS TEST>
AMU> (id-of (make-instance 'test))
0
AMU> (id-of (make-instance 'test))
1
AMU> (id-of (make-instance 'test))
2
AMU> (defclass test2 (test) ())
#<STANDARD-CLASS TEST2>
AMU> (id-of (make-instance 'test))
3
AMU> (id-of (make-instance 'test2))
0
AMU> (id-of (make-instance 'test2))
1
..no?