X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-defstruct.lisp;h=bad8d9554e6265b4a97a2e442a0cfa751c8b13bc;hb=860543cc7ba0266e41e1d41ac9b6a208f3795f1a;hp=71c9c68d038650e57c5a4ec149bbb39a03501aa7;hpb=086927c64682b73e00cb5090ec72e1a72fb30ece;p=sbcl.git diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp index 71c9c68..bad8d95 100644 --- a/src/code/target-defstruct.lisp +++ b/src/code/target-defstruct.lisp @@ -395,7 +395,7 @@ res)) -;;; default PRINT-OBJECT and MAKE-LOAD-FORM methods +;;; default PRINT-OBJECT method (defun %default-structure-pretty-print (structure stream) (let* ((layout (%instance-layout structure)) @@ -422,7 +422,7 @@ (pprint-pop) (let ((slot (pop remaining-slots))) (write-char #\: stream) - (output-symbol-name (dsd-%name slot) stream) + (output-symbol-name (symbol-name (dsd-name slot)) stream) (write-char #\space stream) (pprint-newline :miser stream) (output-object (funcall (fdefinition (dsd-accessor-name slot)) @@ -452,7 +452,7 @@ (write-char #\space stream) (write-char #\: stream) (let ((slot (first remaining-slots))) - (output-symbol-name (dsd-%name slot) stream) + (output-symbol-name (symbol-name (dsd-name slot)) stream) (write-char #\space stream) (output-object (funcall (fdefinition (dsd-accessor-name slot)) @@ -468,12 +468,6 @@ (%default-structure-ugly-print structure stream)))) (def!method print-object ((x structure-object) stream) (default-structure-print x stream *current-level-in-print*)) - -(defun make-load-form-saving-slots (object &key slot-names environment) - (declare (ignore object environment)) - (if slot-names - (error "stub: MAKE-LOAD-FORM-SAVING-SLOTS :SLOT-NAMES not implemented") ; KLUDGE - :sb-just-dump-it-normally)) ;;;; testing structure types @@ -535,7 +529,7 @@ ,x ,(compiler-layout-or-lose class-name))) ((vector) - (let ((xx (gensym "X"))) + (with-unique-names (xx) `(let ((,xx ,x)) (declare (type vector ,xx)) ,@(when (dd-named dd) @@ -550,7 +544,7 @@ :format-arguments (list ',class-name ,xx))))) (values)))) ((list) - (let ((xx (gensym "X"))) + (with-unique-names (xx) `(let ((,xx ,x)) (declare (type list ,xx)) ,@(when (dd-named dd)