0.6.11.17:

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

diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp
index 6c5b990..ba9ff36 100644 (file)
--- a/src/pcl/defs.lisp
+++ b/src/pcl/defs.lisp
@@ -23,18 +23,20 @@
 
 (in-package "SB-PCL")
 \f
-
-(eval-when (:load-toplevel :execute)
-  (when (eq *boot-state* 'complete)
-    (error "Trying to load (or compile) PCL in an environment in which it~%~
-           has already been loaded. This doesn't work, you will have to~%~
-           get a fresh lisp (reboot) and then load PCL."))
-  (when *boot-state*
-    (cerror "Try loading (or compiling) PCL anyways."
-           "Trying to load (or compile) PCL in an environment in which it~%~
-            has already been partially loaded. This may not work, you may~%~
-            need to get a fresh lisp (reboot) and then load PCL."))
-  ) ; EVAL-WHEN
+;;; (These are left over from the days when PCL was an add-on package
+;;; for a pre-CLOS Common Lisp. They shouldn't happen in a normal
+;;; build, of course, but they might happen if someone is experimenting
+;;; and debugging, and it's probably worth complaining if they do,
+;;; so we've left 'em in.)
+(when (eq *boot-state* 'complete)
+  (error "Trying to load (or compile) PCL in an environment in which it~%~
+         has already been loaded. This doesn't work, you will have to~%~
+         get a fresh lisp (reboot) and then load PCL."))
+(when *boot-state*
+  (cerror "Try loading (or compiling) PCL anyways."
+         "Trying to load (or compile) PCL in an environment in which it~%~
+          has already been partially loaded. This may not work, you may~%~
+          need to get a fresh lisp (reboot) and then load PCL."))
 \f
 ;;; comments from CMU CL version of PCL:
 ;;;     This is like fdefinition on the Lispm. If Common Lisp had
@@ -128,14 +130,14 @@
 \f
 ;;;; type specifier hackery
 
-;;; internal to this file.
+;;; internal to this file
 (defun coerce-to-class (class &optional make-forward-referenced-class-p)
   (if (symbolp class)
       (or (find-class class (not make-forward-referenced-class-p))
          (ensure-class class))
       class))
 
-;;; Interface
+;;; interface
 (defun specializer-from-type (type &aux args)
   (when (consp type)
     (setq args (cdr type) type (car type)))
@@ -454,25 +456,25 @@
 
 ;;; Grovel over SB-KERNEL::*BUILT-IN-CLASSES* in order to set
 ;;; SB-PCL:*BUILT-IN-CLASSES*.
-(sb-int:/show "about to set up SB-PCL::*BUILT-IN-CLASSES*")
+(/show "about to set up SB-PCL::*BUILT-IN-CLASSES*")
 (defvar *built-in-classes*
   (labels ((direct-supers (class)
-            (sb-int:/show "entering DIRECT-SUPERS" (sb-kernel::class-name class))
+            (/show "entering DIRECT-SUPERS" (sb-kernel::class-name class))
             (if (typep class 'cl:built-in-class)
                 (sb-kernel:built-in-class-direct-superclasses class)
                 (let ((inherits (sb-kernel:layout-inherits
                                  (sb-kernel:class-layout class))))
-                  (sb-int:/show inherits)
+                  (/show inherits)
                   (list (svref inherits (1- (length inherits)))))))
           (direct-subs (class)
-            (sb-int:/show "entering DIRECT-SUBS" (sb-kernel::class-name class))
-            (sb-int:collect ((res))
+            (/show "entering DIRECT-SUBS" (sb-kernel::class-name class))
+            (collect ((res))
               (let ((subs (sb-kernel:class-subclasses class)))
-                (sb-int:/show subs)
+                (/show subs)
                 (when subs
-                  (sb-int:dohash (sub v subs)
+                  (dohash (sub v subs)
                     (declare (ignore v))
-                    (sb-int:/show sub)
+                    (/show sub)
                     (when (member class (direct-supers sub))
                       (res sub)))))
               (res)))
@@ -500,10 +502,10 @@
                   ;; relevant cases.
                   42))))
     (mapcar (lambda (kernel-bic-entry)
-             (sb-int:/show "setting up" kernel-bic-entry)
+             (/show "setting up" kernel-bic-entry)
              (let* ((name (car kernel-bic-entry))
                     (class (cl:find-class name)))
-               (sb-int:/show name class)
+               (/show name class)
                `(,name
                  ,(mapcar #'cl:class-name (direct-supers class))
                  ,(mapcar #'cl:class-name (direct-subs class))
@@ -523,7 +525,7 @@
                                     sb-kernel:funcallable-instance
                                     function stream)))
                       sb-kernel::*built-in-classes*))))
-(sb-int:/show "done setting up SB-PCL::*BUILT-IN-CLASSES*")
+(/show "done setting up SB-PCL::*BUILT-IN-CLASSES*")
 \f
 ;;;; the classes that define the kernel of the metabraid
 
@@ -549,7 +551,8 @@
   (:metaclass structure-class))
 
 (defstruct (dead-beef-structure-object
-           (:constructor |STRUCTURE-OBJECT class constructor|)))
+           (:constructor |STRUCTURE-OBJECT class constructor|)
+           (:copier nil)))
 
 (defclass std-object (slot-object) ()
   (:metaclass std-class))