X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefstruct.lisp;h=2a81fb3d226b36f4f2c165c3e4d7db10e3297457;hb=5edd74f6911093805a009a152b32216b3dba59f7;hp=d06c83930a5e9f51c4a5160087a75b04b14105a8;hpb=08307967c71c580058a503d46aa087cfefcf8c69;p=sbcl.git

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index d06c839..2a81fb3 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -50,21 +50,25 @@
 	     (:conc-name dd-)
 	     (:make-load-form-fun just-dump-it-normally)
 	     #-sb-xc-host (:pure t)
-	     (:constructor make-defstruct-description (name)))
+	     (:constructor make-defstruct-description
+			   (name &aux
+				 (conc-name (symbolicate name "-"))
+				 (copier-name (symbolicate "COPY-" name))
+				 (predicate-name (symbolicate name "-P")))))
   ;; name of the structure
-  (name (missing-arg) :type symbol)
+  (name (missing-arg) :type symbol :read-only t)
   ;; documentation on the structure
   (doc nil :type (or string null))
   ;; prefix for slot names. If NIL, none.
-  (conc-name (symbolicate name "-") :type (or symbol null))
+  (conc-name nil :type (or symbol null))
   ;; the name of the primary standard keyword constructor, or NIL if none
   (default-constructor nil :type (or symbol null))
   ;; all the explicit :CONSTRUCTOR specs, with name defaulted
   (constructors () :type list)
   ;; name of copying function
-  (copier-name (symbolicate "COPY-" name) :type (or symbol null))
+  (copier-name nil :type (or symbol null))
   ;; name of type predicate
-  (predicate-name (symbolicate name "-P") :type (or symbol null))
+  (predicate-name nil :type (or symbol null))
   ;; the arguments to the :INCLUDE option, or NIL if no included
   ;; structure
   (include nil :type list)
@@ -274,7 +278,10 @@
 		       fun-name)))
 	      (cond ((not (eql pf 0))
 		     `((def!method print-object ((,x ,name) ,s)
-			 (funcall #',(farg pf) ,x ,s *current-level*))))
+			 (funcall #',(farg pf)
+				  ,x
+				  ,s
+				  *current-level-in-print*))))
 		    ((not (eql po 0))
 		     `((def!method print-object ((,x ,name) ,s)
 			 (funcall #',(farg po) ,x ,s))))