X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fbraid.lisp;h=373ee530da8eb378346b81c90bf043831a40a13f;hb=cbaa1997bb097a55d108df592ac3b7eb4a703fff;hp=2168017ef465f6a091ff90dc1ab3ceeddd2619c6;hpb=99ad0a384664dc98af26245a33f11619ec0854ad;p=sbcl.git

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index 2168017..373ee53 100644
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -44,7 +44,7 @@
 			(i 0 (1+ i)))
 		       ((>= i no-of-slots)) ;endp rem-slots))
 		     (declare (list rem-slots)
-			      (type sb-int:index i))
+			      (type index i))
 		     (setf (aref slots i) (first rem-slots)))
 		   slots))
 		(t
@@ -197,7 +197,7 @@
 				  (t
 				   (boot-make-wrapper (length slots) name))))
 		   (proto nil))
-	      (when (eq name 't) (setq *the-wrapper-of-t* wrapper))
+	      (when (eq name t) (setq *the-wrapper-of-t* wrapper))
 	      (set (intern (format nil "*THE-CLASS-~A*" (symbol-name name))
 			   *pcl-package*)
 		   class)
@@ -277,7 +277,7 @@
 	   (!bootstrap-set-slot metaclass-name class slot-name value)))
     (set-slot 'name name)
     (set-slot 'source source)
-    (set-slot 'type (if (eq class (find-class 't))
+    (set-slot 'type (if (eq class (find-class t))
 			t
 			;; FIXME: Could this just be CLASS instead
 			;; of `(CLASS ,CLASS)? If not, why not?
@@ -317,7 +317,8 @@
 					(make-class-predicate-name name)))
 	  (set-slot 'defstruct-form
 		    `(defstruct (structure-object (:constructor
-						   ,constructor-sym))))
+						   ,constructor-sym)
+						  (:copier nil))))
 	  (set-slot 'defstruct-constructor constructor-sym)
 	  (set-slot 'from-defclass-p t)
 	  (set-slot 'plist nil)
@@ -410,7 +411,7 @@
 	(writer (values 'standard-writer-method
 			#'make-std-writer-method-function
 			(list 'new-value class-name)
-			(list 't class-name)
+			(list t class-name)
 			"automatically generated writer method"))
 	(boundp (values 'standard-boundp-method
 			#'make-std-boundp-method-function
@@ -473,7 +474,7 @@
   ;; other sorts of brainos.
   (dolist (e *built-in-classes*)
     (dolist (super (cadr e))
-      (unless (or (eq super 't)
+      (unless (or (eq super t)
 		  (assq super *built-in-classes*))
 	(error "in *BUILT-IN-CLASSES*: ~S has ~S as a super,~%~
 		but ~S is not itself a class in *BUILT-IN-CLASSES*."
@@ -551,7 +552,7 @@
 					(cl:find-class symbol))))
 			      ;; a hack to add the STREAM class as a
 			      ;; mixin to the LISP-STREAM class.
-			      ((eq symbol 'sb-sys:lisp-stream)
+			      ((eq symbol 'sb-kernel:lisp-stream)
 			       '(structure-object stream))
 			      ((structure-type-included-type-name symbol)
 			       (list (structure-type-included-type-name
@@ -562,14 +563,6 @@
 				 symbol)))))
       (error "~S is not a legal structure class name." symbol)))
 
-(defun method-function-returning-nil (args next-methods)
-  (declare (ignore args next-methods))
-  nil)
-
-(defun method-function-returning-t (args next-methods)
-  (declare (ignore args next-methods))
-  t)
-
 (defun make-class-predicate (class name)
   (let* ((gf (ensure-generic-function name))
 	 (mlist (if (eq *boot-state* 'complete)
@@ -577,7 +570,7 @@
 		    (early-gf-methods gf))))
     (unless mlist
       (unless (eq class *the-class-t*)
-	(let* ((default-method-function #'method-function-returning-nil)
+	(let* ((default-method-function #'constantly-nil)
 	       (default-method-initargs (list :function
 					      default-method-function))
 	       (default-method (make-a-method 'standard-method
@@ -589,7 +582,7 @@
 	  (setf (method-function-get default-method-function :constant-value)
 		nil)
 	  (add-method gf default-method)))
-      (let* ((class-method-function #'method-function-returning-t)
+      (let* ((class-method-function #'constantly-t)
 	     (class-method-initargs (list :function
 					  class-method-function))
 	     (class-method (make-a-method 'standard-method
@@ -636,7 +629,7 @@
   (!bootstrap-class-predicates nil)
   (!bootstrap-built-in-classes)
 
-  (sb-int:dohash (name x *find-class*)
+  (dohash (name x *find-class*)
     (let* ((class (find-class-from-cell name x))
 	   (layout (class-wrapper class))
 	   (lclass (sb-kernel:layout-class layout))