Simplify (and robustify) regular PACKing

[sbcl.git] / src / pcl / fsc.lisp

diff --git a/src/pcl/fsc.lisp b/src/pcl/fsc.lisp
index bb4cd60..4d118a4 100644 (file)
--- a/src/pcl/fsc.lisp
+++ b/src/pcl/fsc.lisp
@@ -32,9 +32,6 @@
 ;;;; specification.
 
 (in-package "SB-PCL")
-
-(sb-int:file-comment
-  "$Header$")
 \f
 (defmethod wrapper-fetcher ((class funcallable-standard-class))
   'fsc-instance-wrapper)
@@ -43,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.
 ;;;;
@@ -71,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)