Plaster

common-lisp
(defclass metaclass (sb-mop:standard-class) ()) (defmethod sb-mop:validate-superclass ((class metaclass) (superclass t)) NIL) (defmethod sb-mop:validate-superclass ((class standard-class) (superclass metaclass)) T) (defmethod sb-mop:validate-superclass ((class metaclass) (superclass standard-class)) T) (defmethod sb-mop:validate-superclass ((class metaclass) (superclass metaclass)) T) (defmethod sb-mop:direct-slot-definition-class ((class metaclass) &rest initargs) (find-class 'sb-mop:standard-direct-slot-definition)) (defmethod sb-mop:effective-slot-definition-class ((class metaclass) &rest initargs) (find-class 'sb-mop:standard-effective-slot-definition)) (defmethod sb-mop:slot-value-using-class ((class metaclass) object slot) (if (eq 'test (sb-mop:slot-definition-name slot)) (* 2 (call-next-method)) (call-next-method))) (defmethod (setf sb-mop:slot-value-using-class) (value (class metaclass) object slot) (if (eq 'test (sb-mop:slot-definition-name slot)) (call-next-method (/ value 2) class object slot) (call-next-method))) (defclass stdclass () ((test :initform 2)) (:metaclass metaclass)) (defun test () (let ((a (make-instance 'stdclass))) (print (slot-value a 'test)) (change-class a 'stdclass) (print (slot-value a 'test)) NIL))

Annotations