X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Ffsc.lisp;h=4d118a414bd486ef20369004b174fb83c41fc06e;hb=1540c1c1d517c58fa9a41629beb65cdce7dfafb6;hp=3fb228fddcb71e2215f9beb6f51687cc8937db99;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/pcl/fsc.lisp b/src/pcl/fsc.lisp index 3fb228f..4d118a4 100644 --- a/src/pcl/fsc.lisp +++ b/src/pcl/fsc.lisp @@ -40,27 +40,22 @@ 'fsc-instance-slots) (defmethod raw-instance-allocator ((class funcallable-standard-class)) - 'allocate-funcallable-instance) - -(defmethod validate-superclass ((fsc funcallable-standard-class) - (new-super std-class)) - (let ((new-super-meta-class (class-of new-super))) - (or (eq new-super-meta-class *the-class-std-class*) - (eq (class-of fsc) new-super-meta-class)))) + 'allocate-standard-funcallable-instance) (defmethod allocate-instance - ((class funcallable-standard-class) &rest initargs) + ((class funcallable-standard-class) &rest initargs) (declare (ignore initargs)) - (unless (class-finalized-p class) (finalize-inheritance class)) - (allocate-funcallable-instance (class-wrapper class))) + (unless (class-finalized-p class) + (finalize-inheritance class)) + (allocate-standard-funcallable-instance (class-wrapper class))) (defmethod make-reader-method-function ((class funcallable-standard-class) - slot-name) - (make-std-reader-method-function (class-name class) slot-name)) + slot-name) + (make-std-reader-method-function class slot-name)) (defmethod make-writer-method-function ((class funcallable-standard-class) - slot-name) - (make-std-writer-method-function (class-name class) slot-name)) + slot-name) + (make-std-writer-method-function class slot-name)) ;;;; See the comment about reader-function--std and writer-function--sdt. ;;;; @@ -68,17 +63,17 @@ ; `(function ; (lambda (instance) ; (slot-value-using-class (wrapper-class (get-wrapper instance)) -; instance -; slot-name)))) +; instance +; slot-name)))) ; ;(define-function-template writer-function--fsc () '(slot-name) ; `(function ; (lambda (nv instance) ; (setf -; (slot-value-using-class (wrapper-class (get-wrapper instance)) -; instance -; slot-name) -; nv)))) +; (slot-value-using-class (wrapper-class (get-wrapper instance)) +; instance +; slot-name) +; nv)))) ; ;(eval-when (:load-toplevel) ; (pre-make-templated-function-constructor reader-function--fsc)