;;;; files for more information.
(in-package "SB!IMPL")
-
-(file-comment
- "$Header$")
\f
;;;; exported printer control variables
(write-char #\: stream))
;; Otherwise, if the symbol's home package is the current
;; one, then a prefix is never necessary.
- ((eq package *package*))
+ ((eq package (sane-package)))
;; Uninterned symbols print with a leading #:.
((null package)
(when (or *print-gensym* *print-readably*)
(write-string "#:" stream)))
(t
- (multiple-value-bind (symbol accessible) (find-symbol name *package*)
+ (multiple-value-bind (symbol accessible)
+ (find-symbol name (sane-package))
;; If we can find the symbol by looking it up, it need not
;; be qualified. This can happen if the symbol has been
;; inherited from a package other than its home package.
(declaim (type (simple-array (unsigned-byte 16) (#.char-code-limit))
*character-attributes*))
-(eval-when (:compile-toplevel :load-toplevel :execute)
-
;;; Constants which are a bit-mask for each interesting character attribute.
(defconstant other-attribute (ash 1 0)) ; Anything else legal.
(defconstant number-attribute (ash 1 1)) ; A numeric digit.
(defconstant slash-attribute (ash 1 7)) ; /
(defconstant funny-attribute (ash 1 8)) ; Anything illegal.
-;;; LETTER-ATTRIBUTE is a local of SYMBOL-QUOTEP. It matches letters that
-;;; don't need to be escaped (according to READTABLE-CASE.)
-(defconstant attribute-names
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+;;; LETTER-ATTRIBUTE is a local of SYMBOL-QUOTEP. It matches letters
+;;; that don't need to be escaped (according to READTABLE-CASE.)
+(defparameter *attribute-names*
`((number . number-attribute) (lowercase . lowercase-attribute)
(uppercase . uppercase-attribute) (letter . letter-attribute)
(sign . sign-attribute) (extension . extension-attribute)
(the fixnum
(logand
(logior ,@(mapcar
- #'(lambda (x)
- (or (cdr (assoc x attribute-names))
- (error "Blast!")))
+ (lambda (x)
+ (or (cdr (assoc x
+ *attribute-names*))
+ (error "Blast!")))
attributes))
bits)))))
(digitp ()
(let ((length 0)
(list list))
(loop
- (punt-if-too-long length stream)
+ (punt-print-if-too-long length stream)
(output-object (pop list) stream)
(unless list
(return))
(dotimes (i (length vector))
(unless (zerop i)
(write-char #\space stream))
- (punt-if-too-long i stream)
+ (punt-print-if-too-long i stream)
(output-object (aref vector i) stream))
(write-string ")" stream)))))
(dotimes (i dimension)
(unless (zerop i)
(write-char #\space stream))
- (punt-if-too-long i stream)
+ (punt-print-if-too-long i stream)
(sub-output-array-guts array dimensions stream index)
(incf index count)))
(write-char #\) stream)))))
-;;; a trivial non-generic-function placeholder for PRINT-OBJECT, for use
-;;; until CLOS is set up (at which time it will be replaced with
+;;; a trivial non-generic-function placeholder for PRINT-OBJECT, for
+;;; use until CLOS is set up (at which time it will be replaced with
;;; the real generic function implementation)
(defun print-object (instance stream)
(default-structure-print instance stream *current-level*))
(defun output-integer (integer stream)
;; FIXME: This UNLESS form should be pulled out into something like
- ;; GET-REASONABLE-PRINT-BASE, along the lines of GET-REASONABLE-PACKAGE
- ;; for the *PACKAGE* variable.
+ ;; (SANE-PRINT-BASE), along the lines of (SANE-PACKAGE) for the
+ ;; *PACKAGE* variable.
(unless (and (fixnump *print-base*)
(< 1 *print-base* 37))
(let ((obase *print-base*))