package local nicknames

[sbcl.git] / src / code / print.lisp

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 43f379f..f17f4f6 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -584,7 +584,8 @@ variable: an unreadable object representing the error is printed instead.")
 (defun output-symbol (object stream)
   (if (or *print-escape* *print-readably*)
       (let ((package (symbol-package object))
-            (name (symbol-name object)))
+            (name (symbol-name object))
+            (current (sane-package)))
         (cond
          ;; The ANSI spec "22.1.3.3.1 Package Prefixes for Symbols"
          ;; requires that keywords be printed with preceding colons
@@ -593,19 +594,24 @@ variable: an unreadable object representing the error is printed instead.")
           (write-char #\: stream))
          ;; Otherwise, if the symbol's home package is the current
          ;; one, then a prefix is never necessary.
-         ((eq package (sane-package)))
+         ((eq package current))
          ;; 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 (sane-package))
+              (find-symbol name current)
             ;; 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.
+            ;;
+            ;; To preserve read/print consistency, use the local nickname if
+            ;; one exists.
             (unless (and accessible (eq symbol object))
-              (output-symbol-name (package-name package) stream)
+              (let ((prefix (or (car (rassoc package (package-%local-nicknames current)))
+                                (package-name package))))
+                (output-symbol-name prefix stream))
               (multiple-value-bind (symbol externalp)
                   (find-external-symbol name package)
                 (declare (ignore symbol))