generally expand into additional text to be output, usually consuming one
or more of the FORMAT-ARGUMENTS in the process. A few useful directives
are:
- ~A or ~nA Prints one argument as if by PRINC
- ~S or ~nS Prints one argument as if by PRIN1
- ~D or ~nD Prints one argument as a decimal integer
- ~% Does a TERPRI
- ~& Does a FRESH-LINE
-
- where n is the width of the field in which the object is printed.
+ ~A or ~nA Prints one argument as if by PRINC
+ ~S or ~nS Prints one argument as if by PRIN1
+ ~D or ~nD Prints one argument as a decimal integer
+ ~% Does a TERPRI
+ ~& Does a FRESH-LINE
+ where n is the width of the field in which the object is printed.
DESTINATION controls where the result will go. If DESTINATION is T, then
the output is sent to the standard output stream. If it is NIL, then the
(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))
(when ,params
(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))))
(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)))
(cond (name
(write-string (string-capitalize name) stream))
((<= 0 (char-code char) 31)
- ;; Print control characters as "^"<char>
+ ;; Print control characters as "^"<char>. (This seems to be
+ ;; old pre-ANSI behavior, but ANSI just says that the "#^"
+ ;; sequence is undefined and not reserved for the user, so
+ ;; this behavior should be ANSI-compliant.)
(write-char #\^ stream)
(write-char (code-char (+ 64 (char-code char))) stream))
(t
(format-print-ordinal stream (next-arg))
(format-print-cardinal stream (next-arg))))))
-(defconstant cardinal-ones
+(defparameter *cardinal-ones*
#(nil "one" "two" "three" "four" "five" "six" "seven" "eight" "nine"))
-(defconstant cardinal-tens
+(defparameter *cardinal-tens*
#(nil nil "twenty" "thirty" "forty"
"fifty" "sixty" "seventy" "eighty" "ninety"))
-(defconstant cardinal-teens
+(defparameter *cardinal-teens*
#("ten" "eleven" "twelve" "thirteen" "fourteen" ;;; RAD
"fifteen" "sixteen" "seventeen" "eighteen" "nineteen"))
-(defconstant cardinal-periods
+(defparameter *cardinal-periods*
#("" " thousand" " million" " billion" " trillion" " quadrillion"
" quintillion" " sextillion" " septillion" " octillion" " nonillion"
" decillion" " undecillion" " duodecillion" " tredecillion"
" quattuordecillion" " quindecillion" " sexdecillion" " septendecillion"
" octodecillion" " novemdecillion" " vigintillion"))
-(defconstant ordinal-ones
+(defparameter *ordinal-ones*
#(nil "first" "second" "third" "fourth"
- "fifth" "sixth" "seventh" "eighth" "ninth")
- #!+sb-doc
- "Table of ordinal ones-place digits in English")
+ "fifth" "sixth" "seventh" "eighth" "ninth"))
-(defconstant ordinal-tens
+(defparameter *ordinal-tens*
#(nil "tenth" "twentieth" "thirtieth" "fortieth"
- "fiftieth" "sixtieth" "seventieth" "eightieth" "ninetieth")
- #!+sb-doc
- "Table of ordinal tens-place digits in English")
+ "fiftieth" "sixtieth" "seventieth" "eightieth" "ninetieth"))
(defun format-print-small-cardinal (stream n)
(multiple-value-bind (hundreds rem) (truncate n 100)
(when (plusp hundreds)
- (write-string (svref cardinal-ones hundreds) stream)
+ (write-string (svref *cardinal-ones* hundreds) stream)
(write-string " hundred" stream)
(when (plusp rem)
(write-char #\space stream)))
(when (plusp rem)
(multiple-value-bind (tens ones) (truncate rem 10)
(cond ((< 1 tens)
- (write-string (svref cardinal-tens tens) stream)
+ (write-string (svref *cardinal-tens* tens) stream)
(when (plusp ones)
(write-char #\- stream)
- (write-string (svref cardinal-ones ones) stream)))
+ (write-string (svref *cardinal-ones* ones) stream)))
((= tens 1)
- (write-string (svref cardinal-teens ones) stream))
+ (write-string (svref *cardinal-teens* ones) stream))
((plusp ones)
- (write-string (svref cardinal-ones ones) stream)))))))
+ (write-string (svref *cardinal-ones* ones) stream)))))))
(defun format-print-cardinal (stream n)
(cond ((minusp n)
(unless (zerop beyond)
(write-char #\space stream))
(format-print-small-cardinal stream here)
- (write-string (svref cardinal-periods period) stream))))
+ (write-string (svref *cardinal-periods* period) stream))))
(defun format-print-ordinal (stream n)
(when (minusp n)
(multiple-value-bind (tens ones) (truncate bot 10)
(cond ((= bot 12) (write-string "twelfth" stream))
((= tens 1)
- (write-string (svref cardinal-teens ones) stream);;;RAD
+ (write-string (svref *cardinal-teens* ones) stream);;;RAD
(write-string "th" stream))
((and (zerop tens) (plusp ones))
- (write-string (svref ordinal-ones ones) stream))
+ (write-string (svref *ordinal-ones* ones) stream))
((and (zerop ones)(plusp tens))
- (write-string (svref ordinal-tens tens) stream))
+ (write-string (svref *ordinal-tens* tens) stream))
((plusp bot)
- (write-string (svref cardinal-tens tens) stream)
+ (write-string (svref *cardinal-tens* tens) stream)
(write-char #\- stream)
- (write-string (svref ordinal-ones ones) stream))
+ (write-string (svref *ordinal-ones* ones) stream))
((plusp number)
(write-string "th" stream))
(t
(if (<= 0 posn (length orig-args))
(setf args (nthcdr posn orig-args))
(error 'format-error
- :complaint "Index ~D is out of bounds. (It should ~
- have been between 0 and ~D.)"
+ :complaint "Index ~W is out of bounds. (It should ~
+ have been between 0 and ~W.)"
:arguments (list posn (length orig-args))))))
(if colonp
(interpret-bind-defaults ((n 1)) params
(setf args (nthcdr new-posn orig-args))
(error 'format-error
:complaint
- "Index ~D is out of bounds. (It should
- have been between 0 and ~D.)"
+ "Index ~W is out of bounds. (It should
+ have been between 0 and ~W.)"
:arguments
(list new-posn (length orig-args))))))))
(interpret-bind-defaults ((n 1)) params
;;;; format interpreter and support functions for user-defined method
(def-format-interpreter #\/ (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 ((args))
(dolist (param-and-offset params)
(let ((param (cdr param-and-offset)))
projects / sbcl.git / blobdiff