(error 'format-error
:complaint
"too many parameters, expected no more than ~W"
- :arguments (list ,(length specs))
+ :args (list ,(length specs))
:offset (caar ,params)))
,@body))))
(t commaed))))
;; colinc = 1, minpad = 0, padleft = t
(format-write-field stream signed mincol 1 0 padchar t))
- (princ number))))
+ (princ number stream))))
(defun format-add-commas (string commachar commainterval)
(let ((length (length string)))
;;; errors. As for now, we let the user get away with it, and merely guarantee
;;; that at least one significant digit will appear.
-;;; toy@rtp.ericsson.se: The Hyperspec seems to say that the exponent
+;;; Raymond Toy writes: The Hyperspec seems to say that the exponent
;;; marker is always printed. Make it so. Also, the original version
;;; causes errors when printing infinities or NaN's. The Hyperspec is
;;; silent here, so let's just print out infinities and NaN's instead
w 1 0 #\space t)))
(format-princ stream number nil nil w 1 0 pad)))
-;;; toy@rtp.ericsson.se: Same change as for format-exp-aux.
+;;; Raymond Toy writes: same change as for format-exp-aux
(defun format-general-aux (stream number w d e k ovf pad marker atsign)
(if (and (floatp number)
(or (float-infinity-p number)
(format-dollars stream (next-arg) d n w pad colonp atsignp)))
(defun format-dollars (stream number d n w pad colon atsign)
- (if (rationalp number) (setq number (coerce number 'single-float)))
+ (when (rationalp number)
+ ;; This coercion to SINGLE-FLOAT seems as though it gratuitously
+ ;; loses precision (why not LONG-FLOAT?) but it's the default
+ ;; behavior in the ANSI spec, so in some sense it's the right
+ ;; thing, and at least the user shouldn't be surprised.
+ (setq number (coerce number 'single-float)))
(if (floatp number)
(let* ((signstr (if (minusp number) "-" (if atsign "+" "")))
(signlen (length signstr)))
(multiple-value-bind (str strlen ig2 ig3 pointplace)
- (sb!impl::flonum-to-string number nil d nil)
- (declare (ignore ig2 ig3))
- (when colon (write-string signstr stream))
- (dotimes (i (- w signlen (- n pointplace) strlen))
+ (sb!impl::flonum-to-string number nil d nil)
+ (declare (ignore ig2 ig3 strlen))
+ (when colon
+ (write-string signstr stream))
+ (dotimes (i (- w signlen (max n pointplace) 1 d))
(write-char pad stream))
- (unless colon (write-string signstr stream))
- (dotimes (i (- n pointplace)) (write-char #\0 stream))
+ (unless colon
+ (write-string signstr stream))
+ (dotimes (i (- n pointplace))
+ (write-char #\0 stream))
(write-string str stream)))
(format-write-field stream
(decimal-string number)
w 1 0 #\space t)))
\f
-;;;; format interpreters and support functions for line/page breaks etc.
+;;;; FORMAT interpreters and support functions for line/page breaks etc.
(def-format-interpreter #\% (colonp atsignp params)
(when (or colonp atsignp)
(error 'format-error
:complaint "Index ~W is out of bounds. (It should ~
have been between 0 and ~W.)"
- :arguments (list posn (length orig-args))))))
+ :args (list posn (length orig-args))))))
(if colonp
(interpret-bind-defaults ((n 1)) params
(do ((cur-posn 0 (1+ cur-posn))
:complaint
"Index ~W is out of bounds. (It should
have been between 0 and ~W.)"
- :arguments
+ :args
(list new-posn (length orig-args))))))))
(interpret-bind-defaults ((n 1)) params
(dotimes (i n)
(interpret-bind-defaults () params
(handler-bind
((format-error
- #'(lambda (condition)
- (error 'format-error
- :complaint
- "~A~%while processing indirect format string:"
- :arguments (list condition)
- :print-banner nil
- :control-string string
- :offset (1- end)))))
+ (lambda (condition)
+ (error 'format-error
+ :complaint
+ "~A~%while processing indirect format string:"
+ :args (list condition)
+ :print-banner nil
+ :control-string string
+ :offset (1- end)))))
(if atsignp
(setf args (%format stream (next-arg) orig-args args))
(%format stream (next-arg) (next-arg))))))
(if (zerop posn)
(handler-bind
((format-error
- #'(lambda (condition)
- (error 'format-error
- :complaint
+ (lambda (condition)
+ (error
+ 'format-error
+ :complaint
"~A~%while processing indirect format string:"
- :arguments (list condition)
- :print-banner nil
- :control-string string
- :offset (1- end)))))
+ :args (list condition)
+ :print-banner nil
+ :control-string string
+ :offset (1- end)))))
(%format stream insides orig-args args))
(interpret-directive-list stream insides
orig-args args)))
(interpret-format-logical-block stream orig-args args
prefix per-line-p insides
suffix atsignp))
- (interpret-format-justification stream orig-args args
- segments colonp atsignp
- first-semi params)))
+ (let ((count (apply #'+ (mapcar (lambda (x) (count-if #'illegal-inside-justification-p x)) segments))))
+ (when (> count 0)
+ ;; ANSI specifies that "an error is signalled" in this
+ ;; situation.
+ (error 'format-error
+ :complaint "~D illegal directive~:P found inside justification block"
+ :args (list count)))
+ (interpret-format-justification stream orig-args args
+ segments colonp atsignp
+ first-semi params))))
remaining))
(defun interpret-format-justification
(if per-line-p
(pprint-logical-block
(stream arg :per-line-prefix prefix :suffix suffix)
- (let ((*logical-block-popper* #'(lambda () (pprint-pop))))
+ (let ((*logical-block-popper* (lambda () (pprint-pop))))
(catch 'up-and-out
(interpret-directive-list stream insides
(if atsignp orig-args arg)
arg))))
(pprint-logical-block (stream arg :prefix prefix :suffix suffix)
- (let ((*logical-block-popper* #'(lambda () (pprint-pop))))
+ (let ((*logical-block-popper* (lambda () (pprint-pop))))
(catch 'up-and-out
(interpret-directive-list stream insides
(if atsignp orig-args arg)