From 7ccc14dfb44255d54efb2cec1bbedb9e779509b6 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Sun, 14 Jun 1992 07:41:22 +0000 Subject: [PATCH] Changed the DEFPRINTER expansion to error if *PRINT-READABLY* is set and to print an atomic version of the structure (just its type and address) if the depth is below *PRINT-LEVEL*. Also, use DESCEND-INTO in the non-pretty case to parallel the DESCEND-INTO inside the PPRINT-LOGICAL-BLOCK in the pretty case. --- compiler/macros.lisp | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/compiler/macros.lisp b/compiler/macros.lisp index 2d96903c6..dd584ddfc 100644 --- a/compiler/macros.lisp +++ b/compiler/macros.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/macros.lisp,v 1.30 1992/03/24 20:35:35 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/macros.lisp,v 1.31 1992/06/14 07:41:22 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -858,11 +858,16 @@ (first option))))))))) `(defun ,(symbolicate "%PRINT-" name) (structure stream depth) - (declare (ignore depth)) (flet ((do-prints (stream) (declare (ignorable stream)) ,@(prints))) - (cond (*print-pretty* + (cond (*print-readably* + (error "~S cannot be printed readably." structure)) + ((and *print-level* (>= depth *print-level*)) + (format stream "#<~S ~X>" + ',name + (get-lisp-obj-address structure))) + (*print-pretty* (pprint-logical-block (stream nil :prefix "#<" :suffix ">") (pprint-indent :current 2 stream) (prin1 ',name stream) @@ -872,11 +877,12 @@ (prin1 (get-lisp-obj-address structure) stream)) (do-prints stream))) (t - (format stream "#<~S ~X" - ',name - (get-lisp-obj-address structure)) - (do-prints stream) - (format stream ">")))) + (descend-into (stream) + (format stream "#<~S ~X" + ',name + (get-lisp-obj-address structure)) + (do-prints stream) + (format stream ">"))))) nil)))) -- GitLab