0.pre7.88:

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

diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp
index b9b3c85..27d2b3a 100644 (file)
--- a/src/code/late-format.lisp
+++ b/src/code/late-format.lisp
@@ -32,10 +32,10 @@
          (format-error-offset condition)))
 \f
 (def!struct format-directive
-  (string (required-argument) :type simple-string)
-  (start (required-argument) :type (and unsigned-byte fixnum))
-  (end (required-argument) :type (and unsigned-byte fixnum))
-  (character (required-argument) :type base-char)
+  (string (missing-arg) :type simple-string)
+  (start (missing-arg) :type (and unsigned-byte fixnum))
+  (end (missing-arg) :type (and unsigned-byte fixnum))
+  (character (missing-arg) :type base-char)
   (colonp nil :type (member t nil))
   (atsignp nil :type (member t nil))
   (params nil :type list))
@@ -263,7 +263,7 @@
                             (error
                              'format-error
                              :complaint
-                             "too many parameters, expected no more than ~D"
+                             "too many parameters, expected no more than ~W"
                              :arguments (list ,(length specs))
                              :offset (caar ,params)))
                       ,,@body)))
@@ -286,14 +286,10 @@
     `(progn
        (defun ,defun-name (,directive ,directives)
         ,@(if lambda-list
-              `((let ,(mapcar #'(lambda (var)
-                                  `(,var
-                                    (,(intern (concatenate
-                                               'string
-                                               "FORMAT-DIRECTIVE-"
-                                               (symbol-name var))
-                                              (symbol-package 'foo))
-                                     ,directive)))
+              `((let ,(mapcar (lambda (var)
+                                `(,var
+                                  (,(symbolicate "FORMAT-DIRECTIVE-" var)
+                                   ,directive)))
                               (butlast lambda-list))
                   ,@body))
               `((declare (ignore ,directive ,directives))
@@ -464,6 +460,7 @@
                          :complaint "no previous argument"))
                 (caar *simple-args*))
                (t
+                (/show0 "THROWing NEED-ORIG-ARGS from tilde-P")
                 (throw 'need-orig-args nil)))))
       (if atsignp
          `(write-string (if (eql ,arg 1) "y" "ies") stream)
@@ -615,17 +612,19 @@
                 "both colon and atsign modifiers used simultaneously")
          (expand-bind-defaults ((posn 0)) params
            (unless *orig-args-available*
+             (/show0 "THROWing NEED-ORIG-ARGS from tilde-@*")
              (throw 'need-orig-args nil))
            `(if (<= 0 ,posn (length orig-args))
                 (setf args (nthcdr ,posn orig-args))
                 (error 'format-error
-                       :complaint "Index ~D out of bounds. Should have been ~
-                                   between 0 and ~D."
+                       :complaint "Index ~W out of bounds. Should have been ~
+                                   between 0 and ~W."
                        :arguments (list ,posn (length orig-args))
                        :offset ,(1- end)))))
       (if colonp
          (expand-bind-defaults ((n 1)) params
            (unless *orig-args-available*
+             (/show0 "THROWing NEED-ORIG-ARGS from tilde-:*")
              (throw 'need-orig-args nil))
            `(do ((cur-posn 0 (1+ cur-posn))
                  (arg-ptr orig-args (cdr arg-ptr)))
@@ -635,8 +634,8 @@
                        (setf args (nthcdr new-posn orig-args))
                        (error 'format-error
                               :complaint
-                              "Index ~D is out of bounds; should have been ~
-                               between 0 and ~D."
+                              "Index ~W is out of bounds; should have been ~
+                               between 0 and ~W."
                               :arguments
                               (list new-posn (length orig-args))
                               :offset ,(1- end)))))))
@@ -1120,7 +1119,7 @@
 ;;;; format directive and support function for user-defined method
 
 (def-format-directive #\/ (string start end colonp atsignp params)
-  (let ((symbol (extract-user-function-name string start end)))
+  (let ((symbol (extract-user-fun-name string start end)))
     (collect ((param-names) (bindings))
       (dolist (param-and-offset params)
        (let ((param (cdr param-and-offset)))
@@ -1135,7 +1134,7 @@
         (,symbol stream ,(expand-next-arg) ,colonp ,atsignp
                  ,@(param-names))))))
 
-(defun extract-user-function-name (string start end)
+(defun extract-user-fun-name (string start end)
   (let ((slash (position #\/ string :start start :end (1- end)
                         :from-end t)))
     (unless slash