Title

Formatting (Converting All Types of Object to A String)

Author

Joo ChurlSoo

Abstract

The SRFI introduces three procedures; one formatter procedure and two general
purpose procedures.  The formatter procedure is the CAT procedure that
converts any object to a string.  It takes one object as the first argument
and accepts a variable number of optional arguments, unlike the procedure
called FORMAT.  One of the two general procedures is the CONCAT procedure with
a variable number of arguments that concatenates the arguments after
converting them to strings.  The other is the PRINT procedure with a variable
number of arguments that prints those arguments on current output port.

Rationale

It is difficult to gain a complete consensus for the design of a generic
formatting procedure that performs a variety of necessary functions in
addition to essential functions provided in C's PRINTF and Common lisp's
FORMAT.  One of such ways would be to devise a free and floating sequence
method that easily handles optional arguments, in contrast to the conventional
fixed sequence method in order to obtain a handy optional and functional
interface.  With the concept of free and floating sequencing, the CAT
procedure is then defined, not to process optional arguments with default
values, but to process default values with optional arguments.

Issues

In converting a number to a string, it has not been tried to uniformly express
the exactness of a number in all implementations as each implementation
supports a varying degree of numerical types in R5RS.  The CAT procedure makes
it possible for the user to prefix exact sign to the resulting string as well
as not to prefix it to the resulting string as conventionally used, when an
exact number is made to have a decimal point, or an inexact number is
converted to an exact number that has a decimal point.

Specification

(CAT <object> [[<width@>] [<char@>] [<precision%>] [<radix%>] [<sign%>]
	       [<exactness%>] [<separator%>] [<override$>] [<writer$>]
	       [<case$>] [<take$>] [<string@>] ...])

     * suffix @ : effective for all types of <object>.
              % : effective only for the number type of <object>.
	      $ : effective for all types except the number type of <object>.
     * <object> is any scheme 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 placed rightmost with the
       rest being padded with <char>s, if <width> is positive, or it is placed
       leftmost with the rest being padded with <char>s, 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.
       The default value is 0.
     * <char> is a padding character.  The default value is #\space.
     * <precision> is an exact integer whose absolute value specifies the
       number of decimal digits after a decimal point.  If <precision> is
       a non-negative integer, an exact sign (#e) is prefixed to the resulting
       string as needed.
     * <radix> is a symbol: binary, decimal, octal, or hexadecimal.
       The default value is decimal.
     * If <sign> is a symbol that takes the form of '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 or inexact.
     * <separator> is a list whose first element is a character serving as a
       separator and second element is a non-negative exact integer.  If the
       integer is n, the resulting string is separated in every n-characters
       of the resulting string.  When the integer is omitted, the default
       value is 3.
     * <override> is a list whose first element is an exact integer that
       overrides <width>, second being a character that overrides <char>, and
       the last being strings that override <string>s.  The character and
       strings can be omitted.  If omitted, the default values of the
       character and strings are <char> and <string>s, respectively.
     * <writer> is a procedure of two arguments; <object> and a string port.
       It writes <object> to the string port.  The default value of <writer>
       is varied according to the type of <object>.  When <object> is a
       self-evaluating constant, it becomes equivalent to DISPLAY procedure,
       otherwise, it becomes WRITE procedure.
     * <case> is a symbol: up (upcase), down (downcase), or title (titlecase).
     * <take> is a list whose elements are two exact integers; n and m.
       First, the resulting string takes from the left n-characters, if it is
       non-negative, or all the characters but n-characters, if negative.
       Second, it takes from the right m-characters, if it is non-negative, or
       all the characters but m-characters, if negative.  Then, it
       concatenates two set of characters taken.
     * <string> is a string that is appended to the resulting string.

In general, the order of optional arguments does not matter except <width>
must be defined prior to defining of <precision>.  The CAT procedure processes
optional arguments in the following order; <exactness>, <radix>, <precision>,
<sign>, <separator>, <char>, <width>, <string>, for the number type of
<object>, or in the following order; <writer>, <case>, <take>, <char>,
<width>, <string>, <override> for all other types.

(CONCAT [<object>] ...)
(PRINT  [<object>] ...)

     * <object> is any scheme object.

CONCAT concatenates <object>s after converting them to strings and PRINT
prints <object>s on current output port.  When <object> is a self-evaluating
constant, they use DISPLAY procedure, otherwise, use WRITE procedure.

Examples

(cat 129.995 -10 2)				"130.00    "
(cat 129.995 10 2)				"    130.00"
(cat 129.995 10 2 'exact)			"  #e130.00"
(cat 129 10 -2)					"    129.00"
(cat 129 10 2)					"  #e129.00"
(cat 129 10 2 #\0)				"#e00129.00"
(cat 129 10 2 #\0 'sign)			"#e+0129.00"
(cat 129 10 2 #\* 'sign)			"*#e+129.00"
(cat 1/3)					"1/3"
(cat 1/3 10 2)					"    #e0.33"
(cat 1/3 10 -2)					"      0.33"
(cat 129.995 10 '(#\, 2))			" 1,29.99,5"
(cat 129995 10 '(#\,) 'sign)			"  +129,995"
(cat 99.5 10 'sign 'octal 'exact)		"    +307/2"
(cat (sqrt -5) 10 2)				"0.00+2.24i"
(cat 3.14159e12 10 2 'sign)			"  +3.14e12"
(cat #x123 'octal 'sign)			"+443"
(cat "#o" (cat #x123 'octal 'sign))		"#o+443"
(cat #x123 -10 2 'sign #\*)			"#e+291.00*"
(cat "string" 10)	     			"    string"
(cat "string" '(2 3))				"sting"
(cat "string" -10 '(-2 0))			"ring      "
(cat "string" -10 #\-)				"string----"
(cat "string" -10 #\- 'up '(10 #\* " "))	"****STRING "
(cat 123456 -10 #\- 'up '(10 #\* " "))		"123456----"
(cat #\a 10)					"         a"
(cat 'symbol 10)				"    symbol"
(cat '#(12 #\a "str" sym '(a)))			"#(12 #\\a \"str\" sym '(a))"
(cat '(12 #\a "str" sym '(a)))			"(12 #\\a \"str\" sym '(a))"
(concat '(12 #\a "str" sym '(a)))		"(12 #\\a \"str\" sym '(a))"
(print '(12 #\a "str" sym '(a)))		(12 #\a "str" sym '(a))
(cat 123 " " (cat #\a) " str " (cat "string" write) " " (cat 'symbol))
						"123 a str \"string\" symbol"
(concat 123 " " #\a " str " (cat "string" write) " " 'symbol)
					        "123 a str \"string\" symbol"
(print 123 " " #\a " str " (cat "string" write) " " 'symbol)
						123 a str "string" symbol

Implementation

The implementation below requires SRFI-1 (List library), SRFI-6 (Basic string
ports), SRFI-8 (Receive), SRFI-13 (String library), and SRFI-51 (Handling rest
list).

(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 (cat object . rest)
  (receive (width char precision radix sign exactness separator override writer
		  case take . str-list)
      (rest-values rest #f
		   (cons 0 (lambda (x) (and (integer? x) (exact? x))))
		   (cons #\space char?)
		   (cons #f (lambda (x) (and (integer? x) (exact? x))))
		   (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)
				   (char? (car x))
				   (or (null? (cdr x))
				       (and (integer? (cadr x))
					    (exact? (cadr x))
					    (< 0 (cadr x)))))))
		   (cons #f (lambda (x)
			      (and (list? x)
				   (not (null? x))
				   (and (integer? (car x)) (exact? (car x)))
				   (or (null? (cdr x))
				       (and (char? (cadr x))
					    (every string? (cddr x)))))))
		   (cons #f procedure?)
		   (cons #f (lambda (x) (memq x '(up down title))))
		   (cons #f (lambda (x)
			      (and (list? x)
				   (= (length x) 2)
				   (every (lambda (x)
					    (and (integer? x) (exact? x)))
					  x)))))
    (arg-or "cat: bad argument" str-list (not (every string? str-list)))
    (cond
     ((number? object)
      (arg-ors ("cat: non-decimal cannot be inexact" radix
		(and (memq radix '(binary octal hexadecimal))
		     (or precision
			 (and (inexact? object)
			      (not (eq? exactness 'exact)))
			 (eq? exactness 'inexact))))
	       ("cat: number cannot be expressed without exact sign" precision
		(and precision
		     (< precision 0)
		     (eq? exactness 'exact))))
      (let* ((exact-sign (and precision
			      (<= 0 precision)
			      (or (eq? exactness 'exact)
				  (and (exact? object)
				       (not (eq? exactness
						 'inexact))))))
	     (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))))))
	     (str (if precision
		      (let ((precision (abs precision))
			    (e-index (or (string-index str #\e)
					 (string-index str #\E)))
			    (+-index (or (string-index str #\+ 1)
					 (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)
			   (string (string-ref str +-index))
			   (mold (substring str (+ 1 +-index)
					    (- (string-length str) 1))
				 precision)
			   (string (string-ref str (- (string-length str)
						      1)))))
			 (else
			  (mold str precision))))
		      str))
	     (str (if (and (< 0 (real-part object))
			   (not (eqv? #\+ (string-ref str 0)))
			   sign)
		      (string-append "+" str) str))
	     (str (if exact-sign (string-append "#e" str) str))
	     (str (if (and separator
			   (not (or (string-index str #\e)
				    (string-index str #\i)
				    (string-index str #\/))))
		      (let ((sep-str (string (car separator)))
			    (sep-num (if (null? (cdr separator))
					 3 (cadr separator)))
			    (+-sign (and (or (eqv? #\- (string-ref str 0))
					     (eqv? #\+ (string-ref str 0)))
					 (string (string-ref str 0)))))
			(define (list->alist slist n)
			  (if (< (length slist) n)
			      (if (null? slist) '() (list slist))
			      (receive (n-list rest) (split-at slist n)
				(cons n-list (list->alist rest n)))))
			(let* ((str (if +-sign
					(substring str 1 (string-length str))
					str))
			       (dot-index (string-index str #\.))
			       (predot-str-list
				(map reverse-list->string
				     (reverse
				      (list->alist
				       (reverse
					(string->list
					 (if dot-index
					     (substring str 0 dot-index)
					     str)))
				       sep-num))))
			       (postdot-str-list
				(map list->string
				     (list->alist
				      (string->list
				       (if dot-index
					   (substring str (+ 1 dot-index)
						      (string-length str))
					   ""))
				      sep-num))))
			  (string-append (or +-sign "")
					 (string-join predot-str-list sep-str)
					 (if dot-index "." "")
					 (string-join postdot-str-list
						      sep-str))))
		      str))
	     (len (string-length str))
	     (pad (- (abs width) len)))
	(apply string-append
	       (cond
		((<= pad 0) str)
		((< 0 width)
		 (cond
		  ((and (eqv? char #\0) exact-sign)
		   (if (or (eqv? #\+ (string-ref str 2))
			   (eqv? #\- (string-ref str 2)))
		       (string-append (substring str 0 3)
				      (make-string pad char)
				      (substring str 3 len))
		       (string-append (substring str 0 2)
				      (make-string pad char)
				      (substring str 2 len))))
		  ((and (eqv? char #\0)
			(or (eqv? #\+ (string-ref str 0))
			    (eqv? #\- (string-ref str 0))))
		   (string-append (substring str 0 1)
				  (make-string pad char)
				  (substring str 1 len)))
		  (else
		   (string-append (make-string pad char) str))))
		(else (string-append str (make-string pad char))))
	       str-list)))
     (else
      (let* ((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 case
		      ((cdr (assq case `((down . ,string-downcase)
					 (up . ,string-upcase)
					 (title . ,string-titlecase)))) str)
		      str))
	     (str
	      (if take
		  (let ((left (car take))
			(right (cadr take)))
		    (string-append (if (< left 0)
				       (string-drop str (abs left))
				       (string-take str left))
				   (if (< right 0)
				       (string-drop-right str (abs right))
				       (string-take-right str right))))
		  str))
	     (width (if override (car override) width))
	     (char (if (and override
			    (not (null? (cdr override))))
		       (cadr override) char))
	     (pad (- (abs width) (string-length str)))
	     (str-list (if (and override
				(not (null? (cdr override)))
				(not (null? (cddr override))))
			   (cddr override)
			   str-list)))
	(apply string-append
	     (cond
	      ((<= pad 0) str)
	      ((< 0 width) (string-append (make-string pad char) str))
	      (else (string-append str (make-string pad char))))
	     str-list))))))

References

[Print] Mark Feeley: Format strings are wrong. Posting in relation to [SRFI 48]
	on 25-Nov-2003.
	http://srfi.schemers.org/srfi-48/mail-archive/msg00000.html

Copyright

Copyright (C) Joo ChurlSoo (2004). All Rights Reserved.

This document and translations of it may be copied and furnished to others, and
derivative works that comment on or otherwise explain it or assist in its
implementation may be prepared, copied, published and distributed, in whole or
in part, without restriction of any kind, provided that the above copyright
notice and this paragraph are included on all such copies and derivative works.
However, this document itself may not be modified in any way, such as by
removing the copyright notice or references to the Scheme Request For
Implementation process or editors, except as needed for the purpose of
developing SRFIs in which case the procedures for copyrights defined in the
SRFI process must be followed, or as required to translate it into languages
other than English.

The limited permissions granted above are perpetual and will not be revoked by
the authors or their successors or assigns.

This document and the information contained herein is provided on an "AS IS"
basis and THE AUTHOR AND THE SRFI EDITORS DISCLAIM ALL WARRANTIES, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE
INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES OF
MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
