;;;; 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 ()
(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*))