(defun ,defun-name (stream ,directive ,directives orig-args args)
(declare (ignorable stream orig-args args))
,@(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))
(values (progn ,@body) args)))
`((declare (ignore ,directive ,directives))
(write-string string stream))
(dotimes (i minpad)
(write-char padchar stream))
- (do ((chars (+ (length string) minpad) (+ chars colinc)))
- ((>= chars mincol))
- (dotimes (i colinc)
- (write-char padchar stream)))
+ ;; As of sbcl-0.6.12.34, we could end up here when someone tries to
+ ;; print e.g. (FORMAT T "~F" "NOTFLOAT"), in which case ANSI says
+ ;; we're supposed to soldier on bravely, and so we have to deal with
+ ;; the unsupplied-MINCOL-and-COLINC case without blowing up.
+ (when (and mincol colinc)
+ (do ((chars (+ (length string) minpad) (+ chars colinc)))
+ ((>= chars mincol))
+ (dotimes (i colinc)
+ (write-char padchar stream))))
(when padleft
(write-string string stream)))