From b53e458e3f68ed6515eb044c8b89c27d8511144b Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 6 Sep 2012 10:30:04 -0600
Subject: [PATCH] add `racket/format'

The new library is Ryan's `unstable/cat', but the names have been
changed. (The task of removing `unstable/cat' remains.)
---
 collects/racket/format.rkt                   | 391 ++++++++++++++++++
 collects/racket/main.rkt                     |   4 +-
 collects/scribblings/reference/format.scrbl  | 405 +++++++++++++++++++
 collects/scribblings/reference/strings.scrbl |   3 +
 collects/tests/racket/format.rkt             | 274 +++++++++++++
 doc/release-notes/racket/HISTORY.txt         |   1 +
 6 files changed, 1077 insertions(+), 1 deletion(-)
 create mode 100644 collects/racket/format.rkt
 create mode 100644 collects/scribblings/reference/format.scrbl
 create mode 100644 collects/tests/racket/format.rkt

diff --git a/collects/racket/format.rkt b/collects/racket/format.rkt
new file mode 100644
index 0000000000..5cfb7d1306
--- /dev/null
+++ b/collects/racket/format.rkt
@@ -0,0 +1,391 @@
+#lang racket/base
+(require racket/contract/base
+         racket/list)
+
+;; TO DO:
+;;  - avoid unnecessary intermediate strings
+;;  - see "Printing Floating-Point Numbers Quickly and Accurately"
+;;    by Berger & Dybvig, PLDI 1996 for ideas
+
+;; MAYBE TO DO:
+;;  - recur into lists, vectors, etc?
+;;  - decimal separators (see "man 7 locale", lconv numeric fields)
+;;  - something for monetary amounts (see strfmon)?
+;;    (perhaps as separate library)
+;;  - prop:..., separate from prop:custom-write?
+
+(define (non-empty-string? x)
+  (and (string? x) (positive? (string-length x))))
+
+(define align-mode/c
+  (or/c 'left 'right 'center))
+(define padding/c non-empty-string?)
+
+(define sign-mode/c
+  (or/c #f '+ '++ 'parens
+        (let ([ind/c (or/c string? (list/c string? string?))])
+          (list/c ind/c ind/c ind/c))))
+
+(define base/c
+  (or/c (integer-in 2 36)
+        (list/c 'up (integer-in 2 36))))
+
+;; Precision is one of
+;;  - Nat, for "up to N"
+;;  - '(= N), for "exactly N"
+(define precision/c
+  (or/c exact-nonnegative-integer?
+        (list/c '= exact-nonnegative-integer?)))
+
+(define format/c
+  (->* ()
+       (#:separator string?
+        #:width (or/c exact-nonnegative-integer? #f)
+        #:max-width (or/c exact-nonnegative-integer? +inf.0)
+        #:min-width exact-nonnegative-integer?
+        #:limit-marker string?
+        #:align align-mode/c
+        #:pad-string padding/c
+        #:left-pad-string padding/c
+        #:right-pad-string padding/c)
+       #:rest list?
+       string?))
+
+(provide/contract
+ [~a format/c]
+ [~s format/c]
+ [~v format/c]
+ [~e format/c]
+ [~.a format/c]
+ [~.s format/c]
+ [~.v format/c]
+ [~r (->* (rational?)
+          (#:exponential? any/c
+           #:sign sign-mode/c
+           #:base base/c
+           #:precision precision/c
+           #:format-exponent (or/c #f string? (-> exact-integer? string?))
+           #:min-width exact-positive-integer?
+           #:pad-string padding/c)
+          string?)])
+
+;; ----------------------------------------
+
+(define (%limit #:limit limit
+                #:limit-marker limit-marker
+                s)
+  (cond [(> (string-length s) limit)
+         (string-append (substring s 0 (- limit (string-length limit-marker)))
+                        limit-marker)]
+        [else s]))
+
+(define (%pad #:pad-to pad-to
+              #:align align-mode
+              #:left-padding left-padding
+              #:right-padding right-padding
+              s)
+  (cond [(< (string-length s) pad-to)
+         (let* ([s-length (string-length s)]
+                [to-pad-length (max 0 (- pad-to s-length))])
+           (let-values ([(left-pad-length right-pad-length)
+                         (case align-mode
+                           ((left) (values 0 to-pad-length))
+                           ((right) (values to-pad-length 0))
+                           ((center)
+                            (values (floor (/ to-pad-length 2))
+                                    (ceiling (/ to-pad-length 2)))))])
+             (string-append
+              (build-padding 'left left-padding left-pad-length)
+              s
+              (build-padding 'right right-padding right-pad-length))))]
+        [else s]))
+
+(define (build-padding side padding pad-length)
+  (cond [(zero? pad-length) ""]
+        [(char? padding)
+         (make-string pad-length padding)]
+        [(and (string? padding) (= (string-length padding) 1))
+         (make-string pad-length (string-ref padding 0))]
+        [(string? padding)
+         (let* ([pattern padding]
+                [pattern-length (string-length pattern)]
+                [whole-copies (quotient pad-length pattern-length)]
+                [part-length (remainder pad-length pattern-length)]
+                [pattern-copies (for/list ([i (in-range whole-copies)]) pattern)])
+           (apply string-append
+                  ;; For left, start at start of string
+                  ;; For right, end at end of string.
+                  (case side
+                    ((left)
+                     (append pattern-copies
+                             (list (substring pattern 0 part-length))))
+                    ((right)
+                     (cons (substring pattern (- pattern-length part-length) pattern-length)
+                           pattern-copies)))))]))
+
+(define (do-checks who limit limit-marker width)
+  (when (> width limit)
+    (error who "pad-to length greater than limit (~s): ~s" limit width))
+  (when (> (string-length limit-marker) limit)
+    (error who "limit-marker string longer than limit (~s): ~e"
+           limit limit-marker)))
+
+;; ----------------------------------------
+
+(define ((%cat who fmt [default-sep " "] [default-limit-marker "..."])
+         #:width [width #f]
+         #:max-width [limit (or width +inf.0)]
+         #:limit-marker [limit-marker default-limit-marker]
+         #:min-width [pad-to (or width 0)]
+         #:align [align 'left]
+         #:pad-string [padding " "]
+         #:right-pad-string [right-padding padding]
+         #:left-pad-string [left-padding padding]
+         #:separator [sep default-sep]
+         . s)
+  (do-checks who limit limit-marker pad-to)
+  (%pad (%limit (if (and (pair? s) (null? (cdr s)))
+                    (fmt (car s))
+                    (apply string-append 
+                           (let ([s (map fmt s)])
+                             (if (equal? sep "")
+                                 s
+                                 (add-between s sep)))))
+                #:limit limit
+                #:limit-marker limit-marker)
+        #:pad-to pad-to
+        #:align align
+        #:left-padding left-padding
+        #:right-padding right-padding))
+
+(define ~a (%cat '~a (lambda (v) (if (string? v) v (format "~a" v))) "" ""))
+(define ~s (%cat '~s (lambda (v) (format "~s" v))))
+(define ~v (%cat '~v (lambda (v) (format "~v" v))))
+(define ~e (%cat '~e (lambda (v) (format "~e" v))))
+
+(define ~.a (%cat '~.a (lambda (v) (format "~.a" v)) "" ""))
+(define ~.s (%cat '~.s (lambda (v) (format "~.s" v))))
+(define ~.v (%cat '~.v (lambda (v) (format "~.v" v))))
+
+;; ----
+
+(define not-supplied (gensym))
+
+(define (extract p) (if (list? p) (cadr p) p))
+
+(define (~r N
+            #:sign [sign-mode #f]
+            #:base [base 10]
+            #:precision [precision 6]
+            #:exponential? [exponential? (not (or (zero? N)
+                                                  (< (expt (extract base) (- (extract precision)))
+                                                     (abs N) 
+                                                     (expt (extract base) (extract precision)))))]
+            #:format-exponent [exp-format-exponent #f]
+            #:min-width [pad-digits-to 1]
+            #:pad-string [digits-padding " "])
+  (if exponential?
+      (catne N
+             #:who 'catn
+             #:sign sign-mode
+             #:base base
+             #:precision precision
+             #:format-exponent exp-format-exponent
+             #:pad-digits-to pad-digits-to
+             #:digits-padding digits-padding)
+      (catnp N
+             #:who 'catn
+             #:sign sign-mode
+             #:base base
+             #:precision precision
+             #:pad-digits-to pad-digits-to
+             #:digits-padding digits-padding)))
+
+(define (catnp N
+               #:who [who 'catnp]
+               #:sign [sign-mode #f]
+               #:base [base 10]
+               #:precision [precision 3]
+               #:pad-digits-to [pad-digits-to 1]
+               #:digits-padding [digits-padding " "])
+  ;; precision: up to (or exactly) this many digits after decimal point
+  ;;   precision = 0 means no decimal point
+  ;;   precision = '(= 0) means keep decimal point
+  ;; pad-digits-to: includes decimal point, doesn't include sign
+  (let*-values ([(upper? base) (normalize-base base)]
+                [(exactly? precision) (normalize-precision precision)])
+    (let* ([N-abs (abs N)]
+           [digits-part (%positional N-abs base upper? precision exactly?)]
+           [padded-digits-part
+            (%pad digits-part
+                  #:pad-to pad-digits-to
+                  #:align 'right
+                  #:left-padding digits-padding
+                  #:right-padding #f)])
+      (let-values ([(pre-sign-part post-sign-part) (get-sign-parts N sign-mode)])
+        (string-append pre-sign-part padded-digits-part post-sign-part)))))
+
+(define (catne N
+               #:who [who 'catne]
+               #:sign [sign-mode #f]
+               #:base [base 10]
+               #:precision [precision 5]
+               #:format-exponent [format-exponent #f]
+               #:pad-digits-to [pad-digits-to 1]
+               #:digits-padding [digits-padding " "])
+  (let*-values ([(upper? base) (normalize-base base)]
+                [(exactly? precision) (normalize-precision precision)])
+    (let* ([N-abs (abs N)]
+           [digits-part
+            (%exponential N-abs base upper? format-exponent precision exactly?)]
+           [padded-digits-part
+            (%pad digits-part
+                  #:pad-to pad-digits-to
+                  #:align 'right
+                  #:left-padding digits-padding
+                  #:right-padding #f)])
+      (let-values ([(pre-sign-part post-sign-part) (get-sign-parts N sign-mode)])
+        (string-append pre-sign-part padded-digits-part post-sign-part)))))
+
+(define (normalize-base base)
+  (if (pair? base)
+      (values (eq? (car base) 'up) (cadr base))
+      (values #f base)))
+
+(define (normalize-precision precision)
+  (if (pair? precision)
+      (values #t (cadr precision))
+      (values #f precision)))
+
+(define (%positional N-abs base upper? precision exactly?)
+  (let* ([Nw (inexact->exact (floor N-abs))]
+         [Nf (- N-abs Nw)]
+         [whole-part (number->string* Nw base upper?)]
+         [frac-part
+          (let* ([Nf* (inexact->exact (round (* Nf (expt base precision))))])
+            (cond [(and exactly? (= precision 0)) ""]
+                  [exactly? (number->fraction-string Nf* base upper? precision)]
+                  [(= Nf* 0) #f]
+                  [else
+                   (let-values ([(needed-precision Nf**)
+                                 (let loop ([np precision] [Nf* Nf*])
+                                   (let-values ([(q r) (quotient/remainder Nf* base)])
+                                     (cond [(zero? r) (loop (sub1 np) q)]
+                                           [else (values np Nf*)])))])
+                     (number->fraction-string Nf** base upper? needed-precision))]))]
+         [digits-part
+          (cond [frac-part (string-append whole-part "." frac-part)]
+                [else whole-part])])
+    digits-part))
+
+(define (%exponential N-abs base upper? format-exponent significand-precision exactly?)
+  (define-values (N* e-adjust actual-precision)
+    (scale N-abs base significand-precision exactly?))
+  ;; hack: from 1234 want "1.234"; convert to "1234", mutate to ".234" after saving "1"
+  (let* ([digits (number->string* N* base upper?)]
+         [leading-digit (string (string-ref digits 0))]
+         [exponent (- significand-precision e-adjust)])
+    (string-set! digits 0 #\.)
+    (string-append leading-digit
+                   (if (or exactly? (positive? actual-precision)) digits "")
+                   (cond [(procedure? format-exponent)
+                          (format-exponent exponent)]
+                         [else
+                          (string-append
+                           (cond [(string? format-exponent) format-exponent]
+                                 [(= base 10) "e"]
+                                 [else (format "×~s^" base)])
+                           (if (negative? exponent) "-" "+")
+                           (%pad (number->string (abs exponent))
+                                 #:pad-to 2
+                                 #:align 'right
+                                 #:left-padding "0"
+                                 #:right-padding #f))]))))
+
+(define (scale N-abs base significand-precision exactly?)
+  (if (zero? N-abs)
+      (values 0 0 (if exactly? significand-precision 0))
+      (scale/nz N-abs base significand-precision exactly?)))
+
+(define (scale/nz N-abs base significand-precision exactly?)
+  (let* ([N (inexact->exact N-abs)]
+         [normalized-min (expt base significand-precision)]
+         [normalized-max (* base normalized-min)])
+    (let*-values ([(N*0 e-adjust0)
+                   (let ([e-est (- significand-precision
+                                   (inexact->exact (floor (/ (log N-abs) (log base)))))])
+                     (values (* N (expt base e-est)) e-est))]
+                  [(N* e-adjust)
+                   (let loop ([N N*0] [e e-adjust0] [r #f])
+                     ;; if r != #f, then N is integer
+                     (cond [(< N normalized-min)
+                            (loop (* N base) (add1 e) #f)]
+                           [(>= N normalized-max)
+                            (let-values ([(q r) (quotient/remainder (floor N) base)])
+                              (loop q (sub1 e) r))]
+                           [else
+                            (let ([N* (if r
+                                          (if (>= (* 2 r) base) (add1 N) N)
+                                          (round* N))])
+                              (cond [(< N* normalized-max)
+                                     (values N* e)]
+                                    [else (loop N* e #f)]))]))]
+                  [(N* actual-precision)
+                   (if exactly?
+                       (values N* significand-precision)
+                       (let loop ([N N*] [p significand-precision])
+                         (let-values ([(q r) (quotient/remainder N base)])
+                           (cond [(zero? r) (loop q (sub1 p))]
+                                 [else (values N p)]))))])
+      (values N* e-adjust actual-precision))))
+
+;; ----
+
+(define (get-sign-parts N sign-mode)
+  (define (get indicator)
+    (if (string? indicator)
+        (values indicator "")
+        (values (car indicator) (cadr indicator))))
+  (let ([indicator-table
+         (case sign-mode
+           ((#f) '(""  ""  "-"))
+           ((+)  '("+" ""  "-"))
+           ((++) '("+" "+" "-"))
+           ((parens) '("" "" ("(" ")")))
+           (else sign-mode))])
+    (cond [(or (negative? N) (eqv? -0.0 N))
+           (get (caddr indicator-table))]
+          [(zero? N)
+           (get (cadr indicator-table))]
+          [else ;; positive
+           (get (car indicator-table))])))
+
+(define (number->string* N base upper?)
+  (cond [(memv base '(2 8 10 16))
+         (let ([s (number->string N base)])
+           (if (and (= base 16) upper?)
+               (string-upcase s)
+               s))]
+        [(zero? N)
+         (string #\0)]
+        [else
+         (apply string
+                (let loop ([N N] [digits null])
+                  (cond [(zero? N) (reverse digits)]
+                        [else (let-values ([(q r) (quotient/remainder N base)])
+                                (loop q (cons (get-digit r upper?) digits)))])))]))
+
+(define (number->fraction-string N base upper? precision)
+  (let ([s (number->string* N base upper?)])
+    (string-append (make-string (- precision (string-length s)) #\0) s)))
+
+;; Allow base up to 36!
+(define (get-digit d upper?)
+  (cond [(< d 10) (integer->char (+ d (char->integer #\0)))]
+        [else (integer->char (+ (- d 10) (char->integer (if upper? #\A #\a))))]))
+
+(define (round* x) ;; round is round-to-even :(
+  (if (integer? x)
+      x
+      (+ (truncate x)
+         (if (even? (truncate (+ x x))) 0 1))))
diff --git a/collects/racket/main.rkt b/collects/racket/main.rkt
index 71a6329147..c5a77f684b 100644
--- a/collects/racket/main.rkt
+++ b/collects/racket/main.rkt
@@ -30,6 +30,7 @@
          racket/sequence
          racket/local
          racket/system
+         racket/format
          (for-syntax racket/base))
 
 (provide (all-from-out racket/contract
@@ -61,5 +62,6 @@
                        racket/stream
                        racket/sequence
                        racket/local
-                       racket/system)
+                       racket/system
+                       racket/format)
          (for-syntax (all-from-out racket/base)))
diff --git a/collects/scribblings/reference/format.scrbl b/collects/scribblings/reference/format.scrbl
new file mode 100644
index 0000000000..0413160de7
--- /dev/null
+++ b/collects/scribblings/reference/format.scrbl
@@ -0,0 +1,405 @@
+#lang scribble/doc
+@(require scribble/manual
+          scribble/struct
+          scribble/eval
+          "mz.rkt"
+          (for-label racket/contract
+                     racket/math
+                     racket/format))
+
+@(begin
+  (define the-eval (make-base-eval))
+  (the-eval '(require racket/math racket/format)))
+
+@title[#:tag "format"]{Converting Values to Strings}
+@author[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]]
+
+@note-lib[racket/format]
+
+The @racketmodname[racket/format] library provides functions for
+converting Racket values to strings. In addition to features like
+padding and numeric formatting, the functions have the virtue of being
+shorter than @racket[format] (with format string),
+@racket[number->string], or @racket[string-append].
+
+@defproc[(~a [v any/c] ...
+             [#:separator separator string? ""]
+             [#:width width (or/c exact-nonnegative-integer? #f) #f]
+             [#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
+             [#:min-width min-width exact-nonnegative-integer? (or width 0)]
+             [#:limit-marker limit-marker string? ""]
+             [#:align align (or/c 'left 'center 'right) 'left]
+             [#:pad-string pad-string non-empty-string? " "]
+             [#:left-pad-string left-pad-string non-empty-string? pad-string]
+             [#:right-pad-string right-pad-string non-empty-string? pad-string])
+         string?]{
+
+Converts each @racket[v] to a string in @racket[display] mode---that
+is, like @racket[(format "~a" v)]---then concatentates the results
+with @racket[separator] between consecutive items, and then pads or
+truncates the string to be at least @racket[min-width] characters and
+at most @racket[max-width] characters.
+
+@interaction[#:eval the-eval
+(~a "north")
+(~a 'south)
+(~a #"east")
+(~a #\w "e" 'st)
+(~a (list "red" 'green #"blue"))
+(~a 17)
+(~a #e1e20)
+(~a pi)
+(~a (expt 6.1 87))
+]
+
+The @racket[~a] function is primarily useful for strings, numbers, and other
+atomic data. The @racket[~v] and @racket[~s] functions are better suited to
+compound data.
+
+Let @racket[_s] be the concatenated string forms of the @racket[v]s
+plus separators. If @racket[_s] is longer than @racket[max-width]
+characters, it is truncated to exactly @racket[max-width]
+characters. If @racket[_s] is shorter than @racket[min-width]
+characters, it is padded to exactly @racket[min-width]
+characters. Otherwise @racket[_s] is returned unchanged. If
+@racket[min-width] is greater than @racket[max-width], an exception is
+raised.
+
+If @racket[_s] is longer than @racket[max-width] characters, it is
+truncated and the end of the string is replaced with
+@racket[limit-marker]. If @racket[limit-marker] is longer than
+@racket[max-width], an exception is raised.
+
+@interaction[#:eval the-eval
+(~a "abcde" #:max-width 5)
+(~a "abcde" #:max-width 4)
+(~a "abcde" #:max-width 4 #:limit-marker "*")
+(~a "abcde" #:max-width 4 #:limit-marker "...")
+(~a "The quick brown fox" #:max-width 15 #:limit-marker "")
+(~a "The quick brown fox" #:max-width 15 #:limit-marker "...")
+]
+
+If @racket[_s] is shorter than @racket[min-width], it is padded to at
+least @racket[min-width] characters. If @racket[align] is
+@racket['left], then only right padding is added; if @racket[align]
+is @racket['right], then only left padding is added; and if
+@racket[align] is @racket['center], then roughly equal amounts of
+left padding and right padding are added.
+
+Padding is specified as a non-empty string. Left padding consists of
+@racket[left-pad-string] repeated in its entirety as many times as
+possible followed by a @emph{prefix} of @racket[left-pad-string] to fill
+the remaining space. In contrast, right padding consists of a
+@emph{suffix} of @racket[right-pad-string] followed by a number of copies
+of @racket[right-pad-string] in its entirety. Thus left padding starts
+with the start of @racket[left-pad-string] and right padding ends with
+the end of @racket[right-pad-string].
+
+@interaction[#:eval the-eval
+(~a "apple" #:min-width 20 #:align 'left)
+(~a "pear" #:min-width 20 #:align 'left #:right-pad-string " .")
+(~a "plum" #:min-width 20 #:align 'right #:left-pad-string ". ")
+(~a "orange" #:min-width 20 #:align 'center
+              #:left-pad-string "- " #:right-pad-string " -")
+]
+
+Use @racket[width] to set both @racket[max-width] and @racket[min-width]
+simultaneously, ensuring that the resulting string is exactly
+@racket[width] characters long:
+
+@interaction[#:eval the-eval
+(~a "terse" #:width 6)
+(~a "loquacious" #:width 6)
+]
+}
+
+@;{----------------------------------------}
+
+@defproc[(~v [v any/c] ...
+             [#:separator separator string? " "]
+             [#:width width (or/c exact-nonnegative-integer? #f) #f]
+             [#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
+             [#:min-width min-width exact-nonnegative-integer? (or width 0)]
+             [#:limit-marker limit-marker string? "..."]
+             [#:align align (or/c 'left 'center 'right) 'left]
+             [#:pad-string pad-string non-empty-string? " "]
+             [#:left-pad-string left-pad-string non-empty-string? pad-string]
+             [#:right-pad-string right-pad-string non-empty-string? pad-string])
+         string?]{
+
+Like @racket[~a], but each value is converted like @racket[(format
+"~v" v)], the default separator is @racket[" "], and the default limit
+marker is @racket["..."].
+
+@interaction[#:eval the-eval
+(~v "north")
+(~v 'south)
+(~v #"east")
+(~v #\w)
+(~v (list "red" 'green #"blue"))
+]
+
+Use @racket[~v] to produce text that talks about Racket values.
+
+@interaction[#:eval the-eval
+(let ([nums (for/list ([i 10]) i)])
+  (~a "The even numbers in " (~v nums) 
+      " are " (~v (filter even? nums)) "."))
+]}
+
+@;{----------------------------------------}
+
+@defproc[(~s [v any/c] ...
+             [#:separator separator string? " "]
+             [#:width width (or/c exact-nonnegative-integer? #f) #f]
+             [#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
+             [#:min-width min-width exact-nonnegative-integer? (or width 0)]
+             [#:limit-marker limit-marker string? "..."]
+             [#:align align (or/c 'left 'center 'right) 'left]
+             [#:pad-string pad-string non-empty-string? " "]
+             [#:left-pad-string left-pad-string non-empty-string? pad-string]
+             [#:right-pad-string right-pad-string non-empty-string? pad-string])
+         string?]{
+
+Like @racket[~a], but each value is converted like @racket[(format
+"~s" v)], the default separator is @racket[" "], and the default limit
+marker is @racket["..."].
+
+@interaction[#:eval the-eval
+(~s "north")
+(~s 'south)
+(~s #"east")
+(~s #\w)
+(~s (list "red" 'green #"blue"))
+]
+}
+
+@;{----------------------------------------}
+
+@defproc[(~r   [x rational?]
+               [#:sign sign
+                       (or/c #f '+ '++ 'parens
+                             (let ([ind (or/c string? (list/c string? string?))])
+                               (list/c ind ind ind)))
+                       #f]
+               [#:base base
+                       (or/c (integer-in 2 36) (list/c 'up (integer-in 2 36)))
+                       10]
+               [#:precision precision
+                            (or/c exact-nonnegative-integer?
+                                  (list/c '= exact-nonnegative-integer?)) 
+                            3]
+               [#:exponential? exponential
+                               any/c
+                               (let ([num (lambda (n) (if (list? n) (cadr n) n))])
+                                 (not (or (zero? x)
+                                          (< (expt (num base) (- (num precision)))
+                                             (abs x) 
+                                             (expt (num base) (num precision))))))]
+               [#:exp-precision exp-precision
+                                (or/c exact-nonnegative-integer?
+                                      (list/c '= exact-nonnegative-integer?))
+                                5]
+               [#:format-exponent format-exponent
+                (or/c #f string? (-> exact-integer? string?))
+                #f]
+               [#:min-width min-width exact-positive-integer? 1]
+               [#:pad-string pad-string non-empty-string? " "])
+         string?]{
+
+Converts the rational number @racket[x] to a string in either
+positional or exponential notation, depending on
+@racket[exponential?]. The exactness or inexactness of @racket[x] does
+not affect its formatting.
+
+The optional arguments control number formatting:
+
+@itemize[
+
+@item{@racket[precision] --- controls the number of digits after the decimal point
+(or more accurately, the
+@hyperlink["http://en.wikipedia.org/wiki/Radix_point"]{radix point}). When @racket[x]
+is converted to exponential form, @racket[precision] applies only to the significand.
+
+If @racket[precision] is a natural number, then up to @racket[precision] digits are
+displayed, but trailing zeroes are dropped, and if all digits after the decimal
+point are dropped the decimal point is also dropped. If @racket[precision] is
+@racket[(list '= _digits)], then exactly @racket[_digits] digits after the
+decimal point are used, and the decimal point is never dropped.
+
+@interaction[#:eval the-eval
+(~r pi)
+(~r pi #:precision 4)
+(~r pi #:precision 0)
+(~r 1.5 #:precision 4)
+(~r 1.5 #:precision '(= 4))
+(~r 50 #:precision 2)
+(~r 50 #:precision '(= 2))
+(~r 50 #:precision '(= 0))
+]}
+
+@item{@racket[min-width] --- if @racket[x] would normally be printed
+with fewer than @racket[min-width] digits (including the decimal
+point but not including the sign indicator), the output is left-padded
+using @racket[pad-string].
+
+@interaction[#:eval the-eval
+(~r 17)
+(~r 17 #:min-width 4)
+(~r -42 #:min-width 4)
+(~r 1.5 #:min-width 4)
+(~r 1.5 #:precision 4 #:min-width 10)
+(~r 1.5 #:precision '(= 4) #:min-width 10)
+(~r 1e10 #:min-width 6)
+]}
+
+@item{@racket[pad-string] --- specifies the string used to pad the
+number to at least @racket[min-width] characters (not including the
+sign indicator). The padding is placed between the sign and the normal
+digits of @racket[x].
+
+@interaction[#:eval the-eval
+(~r 17 #:min-width 4 #:pad-string "0")
+(~r -42 #:min-width 4 #:pad-string "0")
+]}
+
+@item{@racket[sign] --- controls how the sign of the number is
+indicated:
+  @itemlist[
+
+  @item{If @racket[sign] is @racket[#f] (the default), no sign output is
+  generated if @racket[x] is either positive or zero, and a minus sign is
+  prefixed if @racket[x] is negative.
+
+  @interaction[#:eval the-eval
+  (for/list ([x '(17 0 -42)]) (~r x))
+  ]}
+
+  @item{If @racket[sign] is @racket['+], no sign output is generated if
+  @racket[x] is zero, a plus sign is prefixed if @racket[x] is positive, and a
+  minus sign is prefixed if @racket[x] is negative.
+
+  @interaction[#:eval the-eval
+  (for/list ([x '(17 0 -42)]) (~r x #:sign '+))
+  ]}
+
+  @item{If @racket[sign] is @racket['++], a plus sign is prefixed if @racket[x]
+  is zero or positive, and a minus sign is prefixed if @racket[x] is negative.
+
+  @interaction[#:eval the-eval
+  (for/list ([x '(17 0 -42)]) (~r x #:sign '++))
+  ]}
+
+  @item{If @racket[sign] is @racket['parens], no sign output is generated if
+  @racket[x] is zero or positive, and the number is enclosed in parentheses if
+  @racket[x] is negative.
+
+  @interaction[#:eval the-eval
+  (for/list ([x '(17 0 -42)]) (~r x #:sign 'parens))
+  ]}
+
+  @item{If @racket[sign] is @racket[(list _pos-ind _zero-ind _neg-ind)], then
+  @racket[_pos-ind], @racket[_zero-ind], and @racket[_neg-ind] are used to
+  indicate positive, zero, and negative numbers, respectively. Each indicator is
+  either a string to be used as a prefix or a list containing two strings: a
+  prefix and a suffix.
+
+  @interaction[#:eval the-eval
+  (let ([sign-table '(("" " up") "an even " ("" " down"))])
+    (for/list ([x '(17 0 -42)]) (~r x #:sign sign-table)))
+  ]
+
+  The default behavior is equivalent to @racket['("" "" "-")]; the
+  @racket['parens] mode is equivalent to @racket['("" "" ("(" ")"))].
+  }
+]}
+
+@item{@racket[base] --- controls the base that @racket[x] is formatted in. If
+@racket[base] is a number greater than @racket[10], then lower-case letters are
+used. If @racket[base] is @racket[(list 'up _base*)] and @racket[_base*] is
+greater than @racket[10], then upper-case letters are used.
+
+@interaction[#:eval the-eval
+(~r 100 #:base 7)
+(~r 4.5 #:base 2)
+(~r 3735928559 #:base 16)
+(~r 3735928559 #:base '(up 16))
+]}
+
+@item{@racket[format-exponent] --- determines how the exponent is displayed. 
+
+If @racket[format-exponent] is a string, the exponent is displayed with an
+explicit sign (as with a @racket[sign-mode] of @racket['++]) and at least two
+digits, separated from the significand by the ``exponent marker''
+@racket[format-exponent]:
+
+@interaction[#:eval the-eval
+(~r 1234 #:exponential? #t #:format-exponent "E")
+]
+
+If @racket[format-exponent] is @racket[#f], the ``exponent marker'' is
+@racket["e"] if @racket[base] is @racket[10] and a string involving
+@racket[base] otherwise:
+
+@interaction[#:eval the-eval
+(~r 1234 #:exponential? #t)
+(~r 1234 #:exponential? #t #:base 8)
+]
+
+If @racket[format-exponent] is a procedure, it is applied to the exponent and
+the resulting string is appended to the significand:
+
+@interaction[#:eval the-eval
+(~r 1234 #:exponential? #t 
+         #:format-exponent (lambda (e) (format "E~a" e)))
+]}
+
+]
+}
+
+@; ----------------------------------------
+
+@deftogether[(
+@defproc[(~.a [v any/c] ...
+              [#:separator separator string? ""]
+              [#:width width (or/c exact-nonnegative-integer? #f) #f]
+              [#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
+              [#:min-width min-width exact-nonnegative-integer? (or width 0)]
+              [#:limit-marker limit-marker string? ""]
+              [#:align align (or/c 'left 'center 'right) 'left]
+              [#:pad-string pad-string non-empty-string? " "]
+              [#:left-pad-string left-pad-string non-empty-string? pad-string]
+              [#:right-pad-string right-pad-string non-empty-string? pad-string])
+         string?]
+@defproc[(~.v [v any/c] ...
+              [#:separator separator string? " "]
+              [#:width width (or/c exact-nonnegative-integer? #f) #f]
+              [#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
+              [#:min-width min-width exact-nonnegative-integer? (or width 0)]
+              [#:limit-marker limit-marker string? "..."]
+              [#:align align (or/c 'left 'center 'right) 'left]
+              [#:pad-string pad-string non-empty-string? " "]
+              [#:left-pad-string left-pad-string non-empty-string? pad-string]
+              [#:right-pad-string right-pad-string non-empty-string? pad-string])
+         string?]
+@defproc[(~.s [v any/c] ...
+              [#:separator separator string? " "]
+              [#:width width (or/c exact-nonnegative-integer? #f) #f]
+              [#:max-width max-width (or/c exact-nonnegative-integer? +inf.0) (or width +inf.0)]
+              [#:min-width min-width exact-nonnegative-integer? (or width 0)]
+              [#:limit-marker limit-marker string? "..."]
+              [#:align align (or/c 'left 'center 'right) 'left]
+              [#:pad-string pad-string non-empty-string? " "]
+              [#:left-pad-string left-pad-string non-empty-string? pad-string]
+              [#:right-pad-string right-pad-string non-empty-string? pad-string])
+         string?]
+)]{
+
+Like @racket[~a], @racket[~v], and @racket[~s], but each @racket[v] is
+formatted like @racket[(format "~.a" v)], @racket[(format "~.v" v)],
+and @racket[(format "~.s" v)], respectively.}
+
+
+@; ----------------------------------------
+
+@(close-eval the-eval)
diff --git a/collects/scribblings/reference/strings.scrbl b/collects/scribblings/reference/strings.scrbl
index 8e1d87a25e..af83e5aff5 100644
--- a/collects/scribblings/reference/strings.scrbl
+++ b/collects/scribblings/reference/strings.scrbl
@@ -500,5 +500,8 @@ trimmed (which is an alternative to using a @tech{regular expression}
   (string-trim "aaaxaayaa" "aa")
 ]}
 
+@; ----------------------------------------
+@include-section["format.scrbl"]
 
+@; ----------------------------------------
 @close-eval[string-eval]
diff --git a/collects/tests/racket/format.rkt b/collects/tests/racket/format.rkt
new file mode 100644
index 0000000000..4d8ba536bd
--- /dev/null
+++ b/collects/tests/racket/format.rkt
@@ -0,0 +1,274 @@
+#lang racket/base
+(require rackunit
+         racket/math
+         racket/format)
+
+(define-syntax-rule (tc expr expected)
+  (test-equal? (format "~s" 'expr) expr expected))
+
+(define-syntax-rule (tcrx expr len rx)
+  (test-case (format "~s" 'expr)
+    (let ([v expr])
+      (when len (check-equal? (string-length v) len))
+      (check-regexp-match rx v))))
+
+;; ~a
+
+(tc (~a "north")
+    "north")
+(tc (~a 'south)
+    "south")
+(tc (~a #"east")
+    "east")
+(tc (~a #\w "e" 'st)
+    "west")
+(tc (~a (list "red" 'green #"blue"))
+    "(red green blue)")
+(tc (~a 17)
+    "17")
+(tc (~a #e1e20)
+    (number->string #e1e20))
+(tc (~a pi)
+    (number->string pi))
+(tc (~a (expt 6.1 87))
+    (number->string (expt 6.1 87)))
+
+(tc (~a "a" "b" "c" #:width 5)
+    "abc  ")
+
+(tc (~a "abcde" #:max-width 5)
+    "abcde")
+(tc (~a "abcde" #:max-width 4)
+    "abcd")
+(tc (~a "abcde" #:max-width 4 #:limit-marker "...")
+    "a...")
+(tc (~a "abcde" #:max-width 4 #:limit-marker "*")
+    "abc*")
+(tc (~a "abcde" #:max-width 4 #:limit-marker "")
+    "abcd")
+(tc (~a "The quick brown fox" #:max-width 15 #:limit-marker "")
+    "The quick brown")
+(tc (~a "The quick brown fox" #:max-width 15 #:limit-marker "...")
+    "The quick br...")
+
+(tcrx (~a "apple" #:min-width 20 #:align 'left)
+      20 #rx"^apple( )*$")
+(tcrx (~a "pear" #:min-width 20 #:align 'left #:right-pad-string " x")
+      20 #rx"^pear(x)?( x)*$")
+(tcrx (~a "plum" #:min-width 20 #:align 'right #:left-pad-string "x ")
+      20 #rx"^(x )*(x)?plum$")
+(tcrx (~a "orange" #:min-width 20 #:align 'center
+           #:left-pad-string "- " #:right-pad-string " -")
+      20 #rx"^(- )*(-)?orange(-)?( -)*$")
+
+(tc (~a "short" #:width 6)
+    "short ")
+(tc (~a "loquacious" #:width 6 #:limit-marker "...")
+    "loq...")
+
+;; ~v
+
+(tc (~v "north")
+    "\"north\"")
+(tc (~v 'south)
+    "'south")
+(tc (~v #"east")
+    "#\"east\"")
+(tc (~v #\w)
+    "#\\w")
+(tc (~v (list "red" 'green #"blue"))
+    "'(\"red\" green #\"blue\")")
+
+(tc (~v '(123456) #:max-width 5)
+    "'(...")
+
+;; ~s
+
+(tc (~s "north")
+    "\"north\"")
+(tc (~s 'south)
+    "south")
+(tc (~s #"east")
+    "#\"east\"")
+(tc (~s #\w)
+    "#\\w")
+(tc (~s (list "red" 'green #"blue"))
+    "(\"red\" green #\"blue\")")
+
+(tc (~s 123456 #:max-width 5)
+    "12...")
+
+;; ~r
+
+(tc (~r 0)
+    "0")
+(tc (~r pi)
+    "3.141593")
+(tc (~r pi #:precision 4)
+    "3.1416")
+(tc (~r pi #:precision 0 #:exponential? #f)
+    "3")
+(tc (~r 1.5 #:precision 4)
+    "1.5")
+(tc (~r 1.5 #:precision '(= 4))
+    "1.5000")
+(tc (~r 50 #:precision 2)
+    "50")
+(tc (~r 50 #:precision '(= 2))
+    "50.00")
+(tc (~r 50 #:precision '(= 0) #:exponential? #f)
+    "50.")
+
+(tc (~r 17)
+    "17")
+(tc (~r 17 #:min-width 4)
+    "  17")
+(tc (~r -42 #:min-width 4)
+    "-  42")
+(tc (~r 1.5 #:min-width 4)
+    " 1.5")
+(tc (~r 1.5 #:precision 4 #:min-width 10)
+    "       1.5")
+(tc (~r 1.5 #:precision '(= 4) #:min-width 10)
+    "    1.5000")
+
+(tc (~r -42 #:min-width 4 #:pad-string "0")
+    "-0042")
+
+(tc (~r 17 #:min-width 4 #:pad-string "0")
+    "0017")
+(tc (~r -42 #:min-width 4 #:pad-string "0")
+    "-0042")
+
+(tc (for/list ([x '(17 0 -42)]) (~r x))
+    '("17" "0" "-42"))
+(tc (for/list ([x '(17 0 -42)]) (~r x #:sign '+))
+    '("+17" "0" "-42"))
+(tc (for/list ([x '(17 0 -42)]) (~r x #:sign '++))
+    '("+17" "+0" "-42"))
+(tc (for/list ([x '(17 0 -42)]) (~r x #:sign 'parens))
+    '("17" "0" "(42)"))
+(tc (let ([sign-table '(("" " up") "an even " ("" " down"))])
+      (for/list ([x '(17 0 -42)]) (~r x #:sign sign-table)))
+    '("17 up" "an even 0" "42 down"))
+
+(tc (~r 100 #:base 7)
+    "202")
+(tc (~r 4.5 #:base 2)
+    "100.1")
+(tc (~r 3735928559 #:base 16 #:precision 10)
+    "deadbeef")
+(tc (~r 3735928559 #:base '(up 16) #:precision 10)
+    "DEADBEEF")
+
+(tc (~r 999 #:precision 3)
+    "999")
+(tc (~r 1000 #:precision 3)
+    "1e+03")
+(tc (~r 0.9876 #:exponential? #t #:precision 3)
+    "9.876e-01")
+
+(tc (~r 100 #:base 2 #:precision 3)
+    "1.101×2^+06")
+
+(tc (~r 1234 #:precision 3 #:format-exponent "E")
+    "1.234E+03")
+
+(tc (~r 12345 #:precision 3)
+    "1.235e+04")
+(tc (~r 12345 #:precision 2)
+    "1.23e+04")
+(tc (~r 10000 #:precision 2)
+    "1e+04")
+(tc (~r 10000 #:precision '(= 2))
+    "1.00e+04")
+
+(tc (~r 12345 #:precision 4
+          #:min-width 12)
+    "  1.2345e+04")
+
+;; ~r #:exponential? #f
+
+(tc (~r #:exponential? #f pi)
+    "3.141593")
+(tc (~r #:exponential? #f pi #:precision 4)
+    "3.1416")
+(tc (~r #:exponential? #f pi #:precision 0)
+    "3")
+(tc (~r #:exponential? #f 1.5 #:precision 4)
+    "1.5")
+(tc (~r #:exponential? #f 1.5 #:precision '(= 4))
+    "1.5000")
+(tc (~r #:exponential? #f 50 #:precision 2)
+    "50")
+(tc (~r #:exponential? #f 50 #:precision '(= 2))
+    "50.00")
+(tc (~r #:exponential? #f 50 #:precision '(= 0))
+    "50.")
+
+(tc (~r #:exponential? #f 17)
+    "17")
+(tc (~r #:exponential? #f 17 #:min-width 4)
+    "  17")
+(tc (~r #:exponential? #f -42 #:min-width 4)
+    "-  42")
+(tc (~r #:exponential? #f 1.5 #:min-width 4)
+    " 1.5")
+(tc (~r #:exponential? #f 1.5 #:precision 4 #:min-width 10)
+    "       1.5")
+(tc (~r #:exponential? #f 1.5 #:precision '(= 4) #:min-width 10)
+    "    1.5000")
+
+(tc (~r #:exponential? #f -42 #:min-width 4 #:pad-string "0")
+    "-0042")
+
+(tc (~r #:exponential? #f 17 #:min-width 4 #:pad-string "0")
+    "0017")
+(tc (~r #:exponential? #f -42 #:min-width 4 #:pad-string "0")
+    "-0042")
+
+(tc (for/list ([x '(17 0 -42)]) (~r #:exponential? #f x))
+    '("17" "0" "-42"))
+(tc (for/list ([x '(17 0 -42)]) (~r #:exponential? #f x #:sign '+))
+    '("+17" "0" "-42"))
+(tc (for/list ([x '(17 0 -42)]) (~r #:exponential? #f x #:sign '++))
+    '("+17" "+0" "-42"))
+(tc (for/list ([x '(17 0 -42)]) (~r #:exponential? #f x #:sign 'parens))
+    '("17" "0" "(42)"))
+(tc (let ([sign-table '(("" " up") "an even " ("" " down"))])
+      (for/list ([x '(17 0 -42)]) (~r #:exponential? #f x #:sign sign-table)))
+    '("17 up" "an even 0" "42 down"))
+
+(tc (~r #:exponential? #f 100 #:base 7)
+    "202")
+(tc (~r #:exponential? #f 4.5 #:base 2)
+    "100.1")
+(tc (~r #:exponential? #f 3735928559 #:base 16)
+    "deadbeef")
+(tc (~r #:exponential? #f 3735928559 #:base '(up 16))
+    "DEADBEEF")
+
+;; ~r #:exponential? #t
+
+(tc (~r #:exponential? #t 1000)
+    "1e+03")
+(tc (~r #:exponential? #t 0.9876)
+    "9.876e-01")
+
+(tc (~r #:exponential? #t 100 #:base 2)
+    "1.1001×2^+06")
+
+(tc (~r #:exponential? #t 1234 #:format-exponent "E")
+    "1.234E+03")
+
+(tc (~r #:exponential? #t 12345 #:precision 3)
+    "1.235e+04")
+(tc (~r #:exponential? #t 12345 #:precision 2)
+    "1.23e+04")
+(tc (~r #:exponential? #t 10000 #:precision 2)
+    "1e+04")
+(tc (~r #:exponential? #t 10000 #:precision '(= 2))
+    "1.00e+04")
+
+(tc (~r #:exponential? #t 12345 #:min-width 12)
+    "  1.2345e+04")
diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt
index 31f84364ae..a7f739ca04 100644
--- a/doc/release-notes/racket/HISTORY.txt
+++ b/doc/release-notes/racket/HISTORY.txt
@@ -1,6 +1,7 @@
 Version 5.3.0.22
 Changed a thread's initial prompt to use the default handler
  (instead of accepting and ignoring abort arguments)
+Added racket/format, which is re-exported by racket
 ffi/unsafe: added cpointer-gcable?
 racket/class: added dynamic-get-field and dynamic-set-field!