0.pre8.4
[sbcl.git] / src / code / early-print.lisp
1 ;;;; printer stuff which has to be defined early (e.g. DEFMACROs)
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
11
12 (in-package "SB!IMPL")
13 \f
14 ;;;; level and length abbreviations
15
16 ;;; The current level we are printing at, to be compared against
17 ;;; *PRINT-LEVEL*. See the macro DESCEND-INTO for a handy interface to
18 ;;; depth abbreviation.
19 (defvar *current-level-in-print* 0)
20
21 ;;; Automatically handle *PRINT-LEVEL* abbreviation. If we are too
22 ;;; deep, then a #\# is printed to STREAM and BODY is ignored.
23 (defmacro descend-into ((stream) &body body)
24   (let ((flet-name (gensym)))
25     `(flet ((,flet-name ()
26               ,@body))
27        (cond ((and (null *print-readably*)
28                    *print-level*
29                    (>= *current-level-in-print* *print-level*))
30               (write-char #\# ,stream))
31              (t
32               (let ((*current-level-in-print* (1+ *current-level-in-print*)))
33                 (,flet-name)))))))
34
35 ;;; Punt if INDEX is equal or larger then *PRINT-LENGTH* (and
36 ;;; *PRINT-READABLY* is NIL) by outputting \"...\" and returning from
37 ;;; the block named NIL.
38 (defmacro punt-print-if-too-long (index stream)
39   `(when (and (not *print-readably*)
40               *print-length*
41               (>= ,index *print-length*))
42      (write-string "..." ,stream)
43      (return)))