Plaster

(defclass persistent-class (standard-class) ()) (defmethod m:validate-superclass ((c1 persistent-class) (c2 standard-class)) (eq c2 (find-class 'standard-object))) (defmethod m:validate-superclass ((c1 persistent-class) (c2 persistent-class)) t) (defclass database-object () ((id :initarg :id :initform 42) (db :initarg :db)) (:metaclass persistent-class)) (defmethod m:compute-class-precedence-list ((class persistent-class)) (let ((cpl (call-next-method)) (std (find-class 'standard-object)) (dbo (find-class 'database-object))) (loop for elt in cpl when (eq elt dbo) do (return-from m:compute-class-precedence-list cpl) when (eq elt std) collect dbo collect elt)))