X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-pprint.lisp;h=25d976321899ec589bf6a1ccc58a0379f521f18f;hb=0d3d3a78055fa485985cda2df688f3cd7e9adb18;hp=c68d6b23089014d844e2595d186d7f20844f8735;hpb=62d333e05a6ae7de4e7b5c918d67608a457b3da7;p=sbcl.git

diff --git a/src/code/early-pprint.lisp b/src/code/early-pprint.lisp
index c68d6b2..25d9763 100644
--- a/src/code/early-pprint.lisp
+++ b/src/code/early-pprint.lisp
@@ -36,7 +36,8 @@
 				 (prefix nil prefixp)
 				 (per-line-prefix nil per-line-prefix-p)
 				 (suffix "" suffixp))
-				&body body)
+				&body body
+                                &environment env)
   #!+sb-doc
   "Group some output into a logical block. STREAM-SYMBOL should be either a
    stream, T (for *TERMINAL-IO*), or NIL (for *STANDARD-OUTPUT*). The printer
@@ -74,12 +75,18 @@
 	    `(descend-into (,stream-var)
 	       (let ((,count-name 0))
 		 (declare (type index ,count-name) (ignorable ,count-name))
-		 ,@(when (or prefixp per-line-prefix-p)
+		 ,@(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))))
  		     `((unless (typep ,(or prefix per-line-prefix) 'string)
 			 (error 'type-error
 				:datum ,(or prefix per-line-prefix)
 				:expected-type 'string))))
-		 ,@(when suffixp
+		 ,@(when (and suffixp
+                              (not (and (sb!xc:constantp suffix env)
+                                        (typep (eval suffix) 'string))))
 		     `((unless (typep ,suffix 'string)
 			 (error 'type-error
 				:datum ,suffix
@@ -112,6 +119,7 @@
 			    (incf ,count-name)
 			    ,@(when object
 				`((pop ,object-var)))))
+                     (declare (ignorable (function ,pp-pop-name)))
 		     (locally
 			 (declare (disable-package-locks 
 				   pprint-pop pprint-exit-if-list-exhausted))
@@ -144,7 +152,7 @@
    PPRINT-LOGICAL-BLOCK, and only when the LIST argument to
    PPRINT-LOGICAL-BLOCK is supplied."
   (error "PPRINT-EXIT-IF-LIST-EXHAUSTED must be lexically inside ~
-	  PPRINT-LOGICAL-BLOCK."))
+          PPRINT-LOGICAL-BLOCK."))
 
 (defmacro pprint-pop ()
   #!+sb-doc