X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefstruct.lisp;h=7b16ef27a73cf4a53a6df3327d81e4a5ea95666f;hb=bee53328c93be3433477821131ab805557476c8b;hp=384aab06eaf06ca33d93df7cbb2d9eab12a8db8f;hpb=d147d512602d761a2dcdfded506dd1a8f9a140dc;p=sbcl.git

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 384aab0..7b16ef2 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -85,7 +85,7 @@
   ;; classes, CLASS-STRUCTURE-P = NIL)
   ;;
   ;; vector element type
-  (element-type 't)
+  (element-type t)
   ;; T if :NAMED was explicitly specified, NIL otherwise
   (named nil :type boolean)
   ;; any INITIAL-OFFSET option on this direct type
@@ -165,8 +165,8 @@
 ;;;; the legendary DEFSTRUCT macro itself (both CL:DEFSTRUCT and its
 ;;;; close personal friend SB!XC:DEFSTRUCT)
 
-;;; Return a list of forms to install print and make-load-form funs, mentioning
-;;; them in the expansion so that they can be compiled.
+;;; Return a list of forms to install PRINT and MAKE-LOAD-FORM funs,
+;;; mentioning them in the expansion so that they can be compiled.
 (defun class-method-definitions (defstruct)
   (let ((name (dd-name defstruct)))
     `((locally
@@ -199,7 +199,7 @@
 			 (funcall #',(farg po) ,x ,s))))
 		    (t nil))))
 	,@(let ((pure (dd-pure defstruct)))
-	    (cond ((eq pure 't)
+	    (cond ((eq pure t)
 		   `((setf (layout-pure (class-layout
 					 (sb!xc:find-class ',name)))
 			   t)))
@@ -210,9 +210,7 @@
 	,@(let ((def-con (dd-default-constructor defstruct)))
 	    (when (and def-con (not (dd-alternate-metaclass defstruct)))
 	      `((setf (structure-class-constructor (sb!xc:find-class ',name))
-		      #',def-con))))
-	;; FIXME: MAKE-LOAD-FORM is supposed to be handled here, too.
-	))))
+		      #',def-con))))))))
 ;;; FIXME: I really would like to make structure accessors less special,
 ;;; just ordinary inline functions. (Or perhaps inline functions with special
 ;;; compact implementations of their expansions, to avoid bloating the system.)
@@ -493,7 +491,7 @@
 	 (cond ((eq type 'funcallable-structure)
 		(setf (dd-type defstruct) type))
 	       ((member type '(list vector))
-		(setf (dd-element-type defstruct) 't)
+		(setf (dd-element-type defstruct) t)
 		(setf (dd-type defstruct) type))
 	       ((and (consp type) (eq (first type) 'vector))
 		(destructuring-bind (vector vtype) type
@@ -606,6 +604,7 @@
 
     (let* ((accname (symbolicate (or (dd-conc-name defstruct) "") name))
 	   (existing (info :function :accessor-for accname)))
+      (declare (notinline find)) ; to avoid bug 117 bogowarnings
       (if (and (structure-class-p existing)
 	       (not (eq (sb!xc:class-name existing) (dd-name defstruct)))
 	       (string= (dsd-%name (find accname
@@ -621,7 +620,7 @@
       (setf (dsd-default islot) default))
     (when type-p
       (setf (dsd-type islot)
-	    (if (eq (dsd-type islot) 't)
+	    (if (eq (dsd-type islot) t)
 		type
 		`(and ,(dsd-type islot) ,type))))
     (when ro-p
@@ -1168,7 +1167,7 @@
        (t
 	(dsd-index slot)))
      (cond
-      ((eq rtype 't) object)
+      ((eq rtype t) object)
       (data)
       (t
        `(truly-the (simple-array (unsigned-byte 32) (*))
@@ -1269,8 +1268,7 @@
     (dolist (slot (dd-slots defstruct))
       (let ((dum (gensym))
 	    (name (dsd-name slot)))
-	(arglist `((,(intern (string name) "KEYWORD") ,dum)
-		   ,(dsd-default slot)))
+	(arglist `((,(keywordicate name) ,dum) ,(dsd-default slot)))
 	(types (dsd-type slot))
 	(vals dum)))
     (funcall creator