Plaster
New
List
Login
common-lisp
default
phoe
2022.02.07 20:18:52
(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) (defclass default-remembering-slot-definition (c2mop:standard-direct-slot-definition) (initargs)) (defmethod c2mop:direct-slot-definition-class ((class foo-class) &rest initargs) (declare (ignore initargs)) (find-class 'default-remembering-slot-definition)) (defmethod initialize-instance :after ((dsd default-remembering-slot-definition) &rest initargs) (setf (slot-value dsd 'initargs) initargs)) (defclass no-initarg-slot-definition (c2mop:standard-effective-slot-definition) ()) (defclass trash-slot-definition (c2mop:standard-effective-slot-definition) ()) (defvar *direct-slot-definitions* '()) (defmethod c2mop:compute-effective-slot-definition ((class foo-class) name dslotds) (let ((*direct-slot-definitions* dslotds)) (call-next-method))) (defmethod c2mop:effective-slot-definition-class ((class foo-class) &rest initargs) (declare (ignore initargs)) (flet ((frob (x) (pprint-logical-block (*standard-output* nil :per-line-prefix ";; ") (print (slot-value x 'initargs))) (terpri))) (mapc #'frob *direct-slot-definitions*)) (call-next-method)) C2CL-USER> (defclass foo () ((default-slot :allocation :instance) (trash-slot :allocation :trash) (no-initarg-slot)) (:metaclass foo-class)) #<FOO-CLASS CLOSER-COMMON-LISP-USER::FOO> C2CL-USER> (finalize-inheritance (find-class 'foo)) ;; ;; (:CLASS #<FOO-CLASS CLOSER-COMMON-LISP-USER::FOO> :NAME DEFAULT-SLOT ;; :READERS NIL :WRITERS NIL :INITARGS NIL SB-PCL::SOURCE ;; #S(SB-C:DEFINITION-SOURCE-LOCATION :NAMESTRING NIL :INDICES 0) :ALLOCATION ;; :INSTANCE) ;; ;; (:CLASS #<FOO-CLASS CLOSER-COMMON-LISP-USER::FOO> :NAME TRASH-SLOT :READERS ;; NIL :WRITERS NIL :INITARGS NIL SB-PCL::SOURCE ;; #S(SB-C:DEFINITION-SOURCE-LOCATION :NAMESTRING NIL :INDICES 0) :ALLOCATION ;; :TRASH) ;; ;; (:CLASS #<FOO-CLASS CLOSER-COMMON-LISP-USER::FOO> :NAME NO-INITARG-SLOT ;; :READERS NIL :WRITERS NIL :INITARGS NIL SB-PCL::SOURCE ;; #S(SB-C:DEFINITION-SOURCE-LOCATION :NAMESTRING NIL :INDICES 0)) NIL
Raw
Annotate
Repaste