X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-pprint.lisp;h=04c42b792930aba679064b278fc7a2aa878d2762;hb=65b5ab7e713d04e0d76bc0ee196374f6e57b922f;hp=e620d16bf29fd8ce95546e621042317ba0454a2d;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/src/code/early-pprint.lisp b/src/code/early-pprint.lisp
index e620d16..04c42b7 100644
--- a/src/code/early-pprint.lisp
+++ b/src/code/early-pprint.lisp
@@ -16,7 +16,7 @@
 (defmacro with-pretty-stream ((stream-var
                                &optional (stream-expression stream-var))
                               &body body)
-  (let ((flet-name (gensym "WITH-PRETTY-STREAM-")))
+  (let ((flet-name (sb!xc:gensym "WITH-PRETTY-STREAM")))
     `(flet ((,flet-name (,stream-var)
               ,@body))
        (let ((stream ,stream-expression))
@@ -58,9 +58,9 @@
                       ((t) *terminal-io*)
                       (t ,stream))))))
     (let* ((object-var (if object (gensym) nil))
-           (block-name (gensym "PPRINT-LOGICAL-BLOCK-"))
+           (block-name (sb!xc:gensym "PPRINT-LOGICAL-BLOCK-"))
            (count-name (gensym "PPRINT-LOGICAL-BLOCK-LENGTH-"))
-           (pp-pop-name (gensym "PPRINT-POP-"))
+           (pp-pop-name (sb!xc:gensym "PPRINT-POP-"))
            (body
             ;; FIXME: It looks as though PPRINT-LOGICAL-BLOCK might
             ;; expand into a boatload of code, since DESCEND-INTO is a
@@ -76,17 +76,16 @@
                (let ((,count-name 0))
                  (declare (type index ,count-name) (ignorable ,count-name))
                  ,@(when (and (or prefixp per-line-prefix-p)
-                              (not (and (sb!xc:constantp (or prefix per-line-prefix) env)
-                                        ;; KLUDGE: EVAL-IN-ENV would
-                                        ;; be useful here.
-                                        (typep (eval (or prefix per-line-prefix)) 'string))))
+                              (not (sb!int:constant-typep
+                                    (or prefix per-line-prefix)
+                                    'string
+                                    env)))
                      `((unless (typep ,(or prefix per-line-prefix) 'string)
                          (error 'type-error
                                 :datum ,(or prefix per-line-prefix)
                                 :expected-type 'string))))
                  ,@(when (and suffixp
-                              (not (and (sb!xc:constantp suffix env)
-                                        (typep (eval suffix) 'string))))
+                              (not (sb!int:constant-typep suffix 'string env)))
                      `((unless (typep ,suffix 'string)
                          (error 'type-error
                                 :datum ,suffix