X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Flow.lisp;h=0949623e8967f862cae5a320dc690c7c72bdcb66;hb=f73aadf04d841e0f1bfede4c11a13c4ba5c4e264;hp=aa65f9ef8b27e37cc3d5fac2255b0f445ceb994d;hpb=832f3b5652ae1b4a8888829cd4a1b391a8ca9952;p=sbcl.git

diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp
index aa65f9e..0949623 100644
--- a/src/pcl/low.lisp
+++ b/src/pcl/low.lisp
@@ -66,8 +66,9 @@
                       ;; default of WRAPPER-INVALID. Instead of trying
                       ;; to find out, I just overrode the LAYOUT
                       ;; default here. -- WHN 19991204
-                      (invalid nil))
-            (:conc-name %wrapper-)
+                      (invalid nil)
+                      ;; This allows quick testing of wrapperness.
+                      (for-std-class-p t))
             (:constructor make-wrapper-internal)
             (:copier nil))
   (instance-slots-layout nil :type list)
@@ -178,16 +179,18 @@
   (declare (special *boot-state* *the-class-standard-generic-function*))
   (when (valid-function-name-p fun)
     (setq fun (fdefinition fun)))
-  (when (funcallable-instance-p fun)
-    ;; HACK
-    (case (classoid-name (classoid-of fun))
-      (%method-function (setf (%method-function-name fun) new-name))
-      (t ;; KLUDGE: probably a generic function...
-       (if (if (eq *boot-state* 'complete)
-               (typep fun 'generic-function)
-               (eq (class-of fun) *the-class-standard-generic-function*))
-           (setf (%funcallable-instance-info fun 2) new-name)
-           (bug "unanticipated function type")))))
+  (typecase fun
+    (%method-function (setf (%method-function-name fun) new-name))
+    #+sb-eval
+    (sb-eval:interpreted-function
+     (setf (sb-eval:interpreted-function-name fun) new-name))
+    (funcallable-instance ;; KLUDGE: probably a generic function...
+     (cond ((if (eq *boot-state* 'complete)
+                (typep fun 'generic-function)
+                (eq (class-of fun) *the-class-standard-generic-function*))
+            (setf (%funcallable-instance-info fun 2) new-name))
+           (t
+            (bug "unanticipated function type")))))
   ;; Fixup name-to-function mappings in cases where the function
   ;; hasn't been defined by DEFUN.  (FIXME: is this right?  This logic
   ;; comes from CMUCL).  -- CSR, 2004-12-31
@@ -259,8 +262,6 @@
   (when (pcl-instance-p instance)
     (get-slots instance)))
 
-(defmacro built-in-or-structure-wrapper (x) `(layout-of ,x))
-
 (defmacro get-wrapper (inst)
   (once-only ((wrapper `(wrapper-of ,inst)))
     `(progn
@@ -304,11 +305,8 @@
 
 ;;; The definition of STRUCTURE-TYPE-P was moved to early-low.lisp.
 
-(defun get-structure-dd (type)
-  (layout-info (classoid-layout (find-classoid type))))
-
 (defun structure-type-included-type-name (type)
-  (let ((include (dd-include (get-structure-dd type))))
+  (let ((include (dd-include (find-defstruct-description type))))
     (if (consp include)
         (car include)
         include)))
@@ -316,8 +314,8 @@
 (defun structure-type-slot-description-list (type)
   (nthcdr (length (let ((include (structure-type-included-type-name type)))
                     (and include
-                         (dd-slots (get-structure-dd include)))))
-          (dd-slots (get-structure-dd type))))
+                         (dd-slots (find-defstruct-description include)))))
+          (dd-slots (find-defstruct-description type))))
 
 (defun structure-slotd-name (slotd)
   (dsd-name slotd))
@@ -330,7 +328,7 @@
 
 (defun structure-slotd-writer-function (type slotd)
   (if (dsd-read-only slotd)
-      (let ((dd (get-structure-dd type)))
+      (let ((dd (find-defstruct-description type)))
         (coerce (slot-setter-lambda-form dd slotd) 'function))
       (fdefinition `(setf ,(dsd-accessor-name slotd)))))
 
@@ -364,8 +362,8 @@
   :slot-names (fast-function name)
   :boa-constructor %make-method-function
   :superclass-name function
-  :metaclass-name random-pcl-classoid
-  :metaclass-constructor make-random-pcl-classoid
+  :metaclass-name static-classoid
+  :metaclass-constructor make-static-classoid
   :dd-type funcallable-structure)
 
 ;;; WITH-PCL-LOCK is used around some forms that were previously