1.0.47.9: Oh very funny

[sbcl.git] / src / code / target-format.lisp

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index f119459..bbf357d 100644 (file)
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -51,6 +51,12 @@
      (%format destination control-string format-arguments)
      nil)))
 
+(define-compiler-macro format (&whole form destination control &rest args)
+  (declare (ignore control args))
+  (when (stringp destination)
+    (warn "Literal string as destination in FORMAT:~%  ~S" form))
+  form)
+
 (defun %format (stream string-or-fun orig-args &optional (args orig-args))
   (if (functionp string-or-fun)
       (apply string-or-fun stream args)
@@ -78,8 +84,7 @@
                       (function
                        (typecase character
                          (base-char
-                          (svref *format-directive-interpreters* (char-code character)))
-                         (character nil)))
+                          (svref *format-directive-interpreters* (char-code character)))))
                       (*default-format-error-offset*
                        (1- (format-directive-end directive))))
                  (unless function
@@ -116,8 +121,8 @@
             (intern (format nil
                             "~:@(~:C~)-FORMAT-DIRECTIVE-INTERPRETER"
                             char)))
-        (directive (gensym))
-        (directives (if lambda-list (car (last lambda-list)) (gensym))))
+        (directive (sb!xc:gensym "DIRECTIVE"))
+        (directives (if lambda-list (car (last lambda-list)) (sb!xc:gensym "DIRECTIVES"))))
     `(progn
        (defun ,defun-name (stream ,directive ,directives orig-args args)
          (declare (ignorable stream orig-args args))
@@ -133,7 +138,7 @@
        (%set-format-directive-interpreter ,char #',defun-name))))
 
 (sb!xc:defmacro def-format-interpreter (char lambda-list &body body)
-  (let ((directives (gensym)))
+  (let ((directives (sb!xc:gensym "DIRECTIVES")))
     `(def-complex-format-interpreter ,char (,@lambda-list ,directives)
        ,@body
        ,directives)))
@@ -281,9 +286,8 @@
                    :start2 src :end2 (+ src commainterval)))
         new-string))))
 
-;;; FIXME: This is only needed in this file, could be defined with
-;;; SB!XC:DEFMACRO inside EVAL-WHEN
-(defmacro interpret-format-integer (base)
+(eval-when (:compile-toplevel :execute)
+(sb!xc:defmacro interpret-format-integer (base)
   `(if (or colonp atsignp params)
        (interpret-bind-defaults
            ((mincol 0) (padchar #\space) (commachar #\,) (commainterval 3))
@@ -294,6 +298,7 @@
              (*print-radix* nil)
              (*print-escape* nil))
          (output-object (next-arg) stream))))
+) ; EVAL-WHEN
 
 (def-format-interpreter #\D (colonp atsignp params)
   (interpret-format-integer 10))