Plaster
New
List
Login
common-lisp
default
phoe
2022.02.07 19:42:49
(defclass foo-class (standard-class) (original-args)) (defmethod c2mop:validate-superclass ((c foo-class) (s standard-class)) t) (defmethod c2mop:validate-superclass ((c standard-class) (s foo-class)) t) (defmethod initialize-instance :before ((class foo-class) &rest args) (setf (slot-value class 'original-args) args)) (defmethod reinitialize-instance :before ((class foo-class) &rest args) (setf (slot-value class 'original-args) args)) (defmethod c2mop:effective-slot-definition-class ((class foo-class) &rest initargs) (declare (ignore initargs)) (pprint-logical-block (*standard-output* nil :per-line-prefix ";; ") (print (slot-value class 'original-args))) (call-next-method)) C2CL-USER> (defclass foo () (bar) (:metaclass foo-class)) #<FOO-CLASS CLOSER-COMMON-LISP-USER::FOO> C2CL-USER> (c2mop:finalize-inheritance (find-class 'foo)) ;; ;; (:NAME FOO :DIRECT-SUPERCLASSES NIL :DIRECT-SLOTS ;; ((:NAME BAR :READERS NIL :WRITERS NIL :INITARGS NIL SB-PCL::SOURCE ;; #S(SB-C:DEFINITION-SOURCE-LOCATION :NAMESTRING NIL :INDICES 0))) ;; SB-PCL::SOURCE ;; #S(SB-C:DEFINITION-SOURCE-LOCATION :NAMESTRING NIL :INDICES 32787) ;; SB-PCL::SAFE-P T :DIRECT-DEFAULT-INITARGS NIL) NIL C2CL-USER> (defclass foo2 () ((bar :allocation :class)) (:metaclass foo-class)) #<FOO-CLASS CLOSER-COMMON-LISP-USER::FOO2> C2CL-USER> (c2mop:finalize-inheritance (find-class 'foo2)) ;; ;; (:NAME FOO2 :DIRECT-SUPERCLASSES NIL :DIRECT-SLOTS ;; ((:NAME BAR :READERS NIL :WRITERS NIL :INITARGS NIL SB-PCL::SOURCE ;; #S(SB-C:DEFINITION-SOURCE-LOCATION :NAMESTRING NIL :INDICES 0) ;; :ALLOCATION :CLASS)) ;; SB-PCL::SOURCE ;; #S(SB-C:DEFINITION-SOURCE-LOCATION :NAMESTRING NIL :INDICES 32787) ;; SB-PCL::SAFE-P T :DIRECT-DEFAULT-INITARGS NIL) NIL
Raw
Annotate
Repaste