This page is part of the web mail archives of SRFI 54 from before July 7th, 2015. The new archives for SRFI 54 contain all messages, not just those from before July 7th, 2015.
* From: Paul Schlie <schlie@xxxxxxxxxxx>
* Date: Tue, 30 Mar 2004 09:32:21 -0500
* Subj: Re: feedback
| Please consider:
| - personally believe fmt-xxx should produce a string (or lazy stream) where
a quoted scheme object, when displayed and then read back, would would be
equivalent, if not quoted, it's simply evaluated and then correspondingly
treated. which I suspect would be more generally useful and intuitive:
I agree.
| - the value of fmt-xxx potentially yielding/consuming ports (or streams),
is that it enables lazily evaluated arbitrary length hierarchically
specified format specifications; which would likely be otherwise
potentially physically impractical to achieve.
(which format does not enable)
Do you mean that <show> parameter should be allowed to be any procedure of
two arguments (object and string-port)?
If so, I agree.
| And while I'm at it, how about accepting arbitrary hierarchical lists of
| format specifiers such they may be composed without requiring their splicing
| into the format specifier list:
| (let ((sign-fmt '(-t s: +)))
(let ((field-fmt '(w: 10 f: 3)))
(fmt-num 12 sign-fmt field-fmt)))
| => " #e+12.000"
If it is positively necessary, I think the above also can be expressed as
(apply fmt-num 12 (append sign-fmt field-fmt)).
| Last few observations, in hope they may be helpful:
| - the \ escapes in the resulting formatted strings I presume are not
| literally present, but merely print that way; as (string #\a #\" #\b) =>
| "a\"b" although 3 characters long.
| - The fmt-string (or whatever name, as not differentiating between string,
| number, etc format routines seems to lead to ambiguities, as noted by
| others; as (fmt 12 10 3 '+) => "12 10 3 +" would seem perfectly legitimate);
| who's behavior suggested below is similar to your cat procedure example
| (unless I'm missing something), except it would basically (eval) and (write)
| all objects with the exception of string and character arguments, which will
| use (display) if not quoted; implying it's necessity to be implemented as a
| macro/syntax-def, as otherwise it wouldn't be possible to differentiate
| between quoted and unquoted string and character arguments; which basically
| eliminates the necessity to explicitly identify write format attributes,
| enabling write and display formatted objects to be intermixed relatively
| easily and reasonably intuitively.
Suppose that we have two procedure, fmt/number and fmt/others, and we don't
know the values and the types of a and b:
(define a 12)
(define b "str")
(cat (if (number? a) (fmt/number a 10 2 '+) (fmt/others a 10 'u))
(if (number? b) (fmt/number a 10 2 '+) (fmt/others a 10 'u)))
(cat (if (number? a) (fmt a 10 2 '+) (fmt a 10 'u))
(if (number? b) (fmt a 10 2 '+) (fmt a 10 'u)))
What is the difference between the aboves?
I think the solution of this problem is for FMT to hold the parameters of
number type and those of others type in common.
So, I've modified the definition of FMT (I change this into FORMATTER).
Now we can use it, like this:
(cancat (formatter a 10 2 'sign 'up) (formatter b 10 2 'sign 'up))
The following is a simple spec of FORMATTER to show the changes.
(FORMATTER <object> [[<width@>] [<precision%>] [<char@>] [<writer@>] [<radix%>]
[<plus%>] [<exactness%>] [<count$>] [<case$>]
[<string@>] ...])
* suffix @ : effective in all type of <object>.
% : effective only if <object> is the number type.
$ : effective in all type except the number type of <object>.
* <width> is an exact integer whose absolute value specifies the width of
the resulting string. When the resulting string has fewer characters
than the absolute value of <width>, it is padded with <char>s, either
on the left if <width> is positive, or on the right if <width> is
negative. On the other hand, when the resulting string has more
characters than the absolute value of <width>, the <width> is ignored.
* <precision> is a exact integer whose absolute value specifies the
number of decimal digits after decimal point. If <precision> is
non-negative integer, an exact sign (#e) can be prefixed to the
resulting string.
* <char> is a padding character.
* <writer> is a procedure of two arguments, object and string port.
* <radix> is a symbol: binary, decimal, octal, hexadecimal.
* If <plus> is a symbol, sign, and <object> is a positive number without a
positive sign, the positive sign is prefixed to the resulting string.
* <exactness> is a symbol: exact, inexact.
* <count> is a list whose elements are exact integers, and the number of
elements of the list is 1 or 2. If the absolute value of the first
element is n, the resulting string takes n-characters if it is positive
or the remains except n-characters if it is negative, on the left. The
process is also same in case of the second element except in the right.
* <case> is a symbol: up (upcase), down (downcase), title (titlecase)
* <string>s are strings that are appended to the resulting string.
The order of optional arguments is ignored except that <precision> can be
defined only after <width> is defined.
*** 2 general procedures
(define (concat . objects)
(get-output-string
(let ((string-port (open-output-string)))
(for-each (lambda (object)
((or (and (or (number? object)
(string? object)
(char? object)
(boolean? object))
display)
write)
object string-port))
objects)
string-port)))
(define (print . objects)
(for-each (lambda (object)
((or (and (or (number? object)
(string? object)
(char? object)
(boolean? object))
display)
write)
object))
objects))
(define (formatter object . rest)
(receive (width precision char writer radix plus exactness count
case . str-list)
(opt-values rest
(cons #f (lambda (x) (and (integer? x) (exact? x))))
(cons #f (lambda (x) (and (integer? x) (exact? x))))
(cons #f char?)
(cons #f procedure?)
(list 'decimal 'binary 'octal 'hexadecimal)
(cons #f (lambda (x) (eq? x 'sign)))
(cons #f (lambda (x) (memq x '(exact inexact))))
(cons #f (lambda (x)
(and (list? x)
(<= 1 (length x) 2)
(every (lambda (x)
(and (integer? x) (exact? x)))
x))))
(cons #f (lambda (x) (memq x '(up down title)))))
(arg-ors ("formatter: bad argument" str-list
(not (every string? str-list)))
("formatter: unnecessary padding character" char
(and char (not width))))
(cond
((number? object)
(arg-ors ("formatter: non-decimal cannot be inexact" radix
(and (memq radix '(binary octal hexadecimal))
(or precision
(and (inexact? object) (not (eq? exactness 'exact)))
(eq? exactness 'inexact))))
("formatter: you didn't choose exact sign" precision
(and precision (< precision 0) (eq? exactness 'exact)))
("formatter: you didn't choose default writer" writer
(and writer
(not (memq writer (list display write)))
(or precision
exactness
(memq radix '(binary octal hexadecimal))))))
(let* ((width (or width 0))
(char (or char #\space))
(sign (if (< width 0) '- '+))
(exact-sign (and (and precision
(<= 0 precision)
(or (eq? exactness 'exact)
(and (exact? object)
(not (eq? exactness 'inexact)))))
"#e"))
(str
(if (or (not writer) (eq? writer display) (eq? writer write))
(let ((str
(number->string
(if (or (not precision) (<= 0 precision))
(if exact-sign
(if (exact? object)
(exact->inexact object) object)
(if exactness
(if (eq? exactness 'exact)
(if (inexact? object)
(inexact->exact object) object)
(if (exact? object)
(exact->inexact object) object))
object))
(if exactness
(if (eq? exactness 'exact)
(if (inexact? object)
(inexact->exact object) object)
(if (exact? object)
(exact->inexact object) object))
(if (and precision (exact? object))
(exact->inexact object) object)))
(cdr (assq radix
'((decimal . 10) (binary . 2) (octal . 8)
(hexadecimal . 16)))))))
(if precision
(let ((precision (abs precision))
(e-index (or (string-index str #\e)
(string-index str #\E)))
(+-index (string-index str #\+ 1))
(--index (string-index str #\- 1)))
(define (mold str pre)
(let ((len (string-length str))
(index (string-index str #\.)))
(if index
(let ((d-len (- len (+ index 1))))
(if (<= d-len pre)
(string-append str (make-string
(- pre d-len) #\0))
(mold
(number->string
(let ((num
(string->number
(substring str 0
(+ (if (= pre 0)
0 1)
index pre)))))
((if (< num 0) - +)
num
(if (< 4 (string->number
(string (string-ref
str
(+ 1 index
pre)))))
(expt 0.1 pre) 0))))
pre)))
(string-append str "."
(make-string pre #\0)))))
(cond
(e-index
(string-append
(mold (substring str 0 e-index) precision)
(substring str e-index (string-length str))))
(+-index
(string-append
(mold (substring str 0 +-index) precision)
"+"
(mold (substring str (+ 1 +-index)
(- (string-length str) 1))
precision)
(string (string-ref str
(- (string-length str) 1)))))
(--index
(string-append
(mold (substring str 0 --index) precision)
"-"
(mold (substring str (+ 1 --index)
(- (string-length str) 1))
precision)
(string (string-ref str
(- (string-length str) 1)))))
(else
(mold str precision))))
str))
(get-output-string
(let ((str-port (open-output-string)))
(writer object str-port)
str-port))))
(str (if (and (< 0 (real-part object))
(not (eqv? #\+ (string-ref str 0)))
plus)
(string-append "+" str)
str))
(len (string-length str))
(pad (- (abs width) (+ len (if exact-sign 2 0)))))
(apply string-append
(cond
((<= pad 0)
(string-append (or exact-sign "") str))
((eq? sign '+)
(if (and (eqv? char #\0)
(or (eqv? #\+ (string-ref str 0))
(eqv? #\- (string-ref str 0))))
(string-append (or exact-sign "")
(string (string-ref str 0))
(make-string pad char)
(substring str 1 len))
(string-append (make-string pad char)
(or exact-sign "")
str)))
(else
(string-append (or exact-sign "")
str
(make-string pad char))))
str-list)))
(else
(let* ((width (or width 0))
(char (or char #\space))
(sign (if (< width 0) '- '+))
(str (get-output-string
(let ((str-port (open-output-string)))
((or writer
(and (or (string? object)
(char? object)
(boolean? object))
display)
write)
object str-port)
str-port)))
(str
(if count
(let ((len (string-length str))
(left (car count))
(right (if (not (null? (cdr count))) (cadr count) 0)))
(string-append (if (< left 0)
(substring str (if (< len (abs left))
len (abs left))
len)
(substring str 0 (if (< len left)
len left)))
(if (< right 0)
(substring str 0
(if (< len (abs right))
0 (- len (abs right))))
(substring str
(if (< len right)
len (- len right))
len))))
str))
(str (if case
((cdr (assq case `((down . ,string-downcase)
(up . ,string-upcase)
(title . ,string-titlecase)))) str)
str))
(pad (- (abs width) (string-length str))))
(apply string-append
(cond
((<= pad 0) str)
((eq? sign '+) (string-append (make-string pad char) str))
(else (string-append str (make-string pad char))))
str-list))))))
Thanks.
--
INITERM