Plaster
New
List
Login
common-lisp
default
phoe
2022.02.07 20:01:14
(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 no-initarg-slot-definition (c2mop:standard-effective-slot-definition) ()) (defclass trash-slot-definition (c2mop:standard-effective-slot-definition) ()) (defmethod c2mop:effective-slot-definition-class ((class foo-class) &rest initargs) (multiple-value-bind (indicator value) (get-properties initargs '(:allocation)) (cond ((null indicator) ;; ALLOCATION was not provided, supply the default. (find-class 'no-initarg-slot-definition)) ((eq value :trash) ;; ALLOCATION is :TRASH (find-class 'trash-slot-definition)) (t ;; ALLOCATION is something else, defer to the next method. (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)) NIL C2CL-USER> (c2mop:class-slots (find-class 'foo)) (#<STANDARD-EFFECTIVE-SLOT-DEFINITION CLOSER-COMMON-LISP-USER::DEFAULT-SLOT> #<TRASH-SLOT-DEFINITION CLOSER-COMMON-LISP-USER::TRASH-SLOT> #<STANDARD-EFFECTIVE-SLOT-DEFINITION CLOSER-COMMON-LISP-USER::NO-INITARG-SLOT>)
Raw
Annotate
Repaste