Plaster
New
List
Login
common-lisp
default
anonymous
2022.02.06 13:25:47
(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)))
Raw
Annotate
Repaste
Edit