From e1ce4942277d5412e6918dcd93e03eb701fc9a6f Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Sun, 3 Feb 1991 11:07:06 +0000 Subject: [PATCH] Fixed default-structure-print to work when *print-circle* is T. --- code/defstruct.lisp | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/code/defstruct.lisp b/code/defstruct.lisp index 42fdf49e1..9b3f3babc 100644 --- a/code/defstruct.lisp +++ b/code/defstruct.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.20 1991/01/03 13:14:47 ram Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.21 1991/02/03 11:07:06 wlott Exp $ ;;; ;;; Defstruct structure definition package (Mark II). ;;; Written by Skef Wholey and Rob MacLachlan. @@ -648,20 +648,23 @@ (let* ((type (structure-ref structure 0)) (dd (info type defined-structure-info type))) (cond (*print-pretty* - (let ((index 0)) - (declare (type structure-index index)) - (xp:pprint-logical-block (stream (cons type (dd-slots dd)) - :prefix "#S(" - :suffix ")") - (prin1 (xp:pprint-pop) stream) + (let ((slots (dd-slots dd))) + (xp:pprint-logical-block (stream + (mapcar + #'(lambda (dsd) + (structure-ref structure + (dsd-index dsd))) + slots) + :prefix "#S(" :suffix ")") + (prin1 type stream) (xp:pprint-exit-if-list-exhausted) (write-char #\space stream) (xp:pprint-indent :current 0 stream) (loop - (prin1 (dsd-name (xp:pprint-pop)) stream) + (prin1 (dsd-name (pop slots)) stream) (write-char #\space stream) (xp:pprint-newline :miser stream) - (prin1 (structure-ref structure (incf index)) stream) + (prin1 (xp:pprint-pop) stream) (xp:pprint-exit-if-list-exhausted) (write-char #\space stream) (xp:pprint-newline :linear stream))))) -- GitLab