(exception:string-contains-nul): New exception pattern.

[bpt/guile.git] / ice-9 / format.scm

diff --git a/ice-9/format.scm b/ice-9/format.scm
index 2a92cbf..4bf6237 100644 (file)
--- a/ice-9/format.scm
+++ b/ice-9/format.scm
@@ -13,7 +13,6 @@
 
 (define-module (ice-9 format)
   :use-module (ice-9 and-let-star)
-  :use-module (ice-9 threads)
   :autoload (ice-9 pretty-print) (pretty-print)
   :replace (format)
   :export (format:symbol-case-conv
@@ -1373,44 +1372,49 @@
                  (width (format:par pars l 2 0 "width"))
                  (padch (format:par pars l 3 format:space-ch #f)))
 
-             (format:parse-float
-              (if (string? number) number (number->string number)) #t 0)
-             (if (<= (- format:fn-len format:fn-dot) digits)
-                 (format:fn-zfill #f (- digits (- format:fn-len format:fn-dot)))
-                 (format:fn-round digits))
-             (let ((numlen (+ format:fn-len 1)))
-               (if (or (not format:fn-pos?) (memq modifier '(at colon-at)))
-                   (set! numlen (+ numlen 1)))
+             (cond
+              ((or (inf? number) (nan? number))
+               (format:out-inf-nan number width digits #f #f padch))
+
+              (else
+               (format:parse-float
+                (if (string? number) number (number->string number)) #t 0)
+               (if (<= (- format:fn-len format:fn-dot) digits)
+                   (format:fn-zfill #f (- digits (- format:fn-len format:fn-dot)))
+                   (format:fn-round digits))
+               (let ((numlen (+ format:fn-len 1)))
+                 (if (or (not format:fn-pos?) (memq modifier '(at colon-at)))
+                     (set! numlen (+ numlen 1)))
+                 (if (and mindig (> mindig format:fn-dot))
+                     (set! numlen (+ numlen (- mindig format:fn-dot))))
+                 (if (and (= format:fn-dot 0) (not mindig))
+                     (set! numlen (+ numlen 1)))
+                 (if (< numlen width)
+                     (case modifier
+                       ((colon)
+                        (if (not format:fn-pos?)
+                            (format:out-char #\-))
+                        (format:out-fill (- width numlen) (integer->char padch)))
+                       ((at)
+                        (format:out-fill (- width numlen) (integer->char padch))
+                        (format:out-char (if format:fn-pos? #\+ #\-)))
+                       ((colon-at)
+                        (format:out-char (if format:fn-pos? #\+ #\-))
+                        (format:out-fill (- width numlen) (integer->char padch)))
+                       (else
+                        (format:out-fill (- width numlen) (integer->char padch))
+                        (if (not format:fn-pos?)
+                            (format:out-char #\-))))
+                     (if format:fn-pos?
+                         (if (memq modifier '(at colon-at)) (format:out-char #\+))
+                         (format:out-char #\-))))
                (if (and mindig (> mindig format:fn-dot))
-                   (set! numlen (+ numlen (- mindig format:fn-dot))))
+                   (format:out-fill (- mindig format:fn-dot) #\0))
                (if (and (= format:fn-dot 0) (not mindig))
-                   (set! numlen (+ numlen 1)))
-               (if (< numlen width)
-                   (case modifier
-                     ((colon)
-                      (if (not format:fn-pos?)
-                          (format:out-char #\-))
-                      (format:out-fill (- width numlen) (integer->char padch)))
-                     ((at)
-                      (format:out-fill (- width numlen) (integer->char padch))
-                      (format:out-char (if format:fn-pos? #\+ #\-)))
-                     ((colon-at)
-                      (format:out-char (if format:fn-pos? #\+ #\-))
-                      (format:out-fill (- width numlen) (integer->char padch)))
-                     (else
-                      (format:out-fill (- width numlen) (integer->char padch))
-                      (if (not format:fn-pos?)
-                          (format:out-char #\-))))
-                   (if format:fn-pos?
-                       (if (memq modifier '(at colon-at)) (format:out-char #\+))
-                       (format:out-char #\-))))
-             (if (and mindig (> mindig format:fn-dot))
-                 (format:out-fill (- mindig format:fn-dot) #\0))
-             (if (and (= format:fn-dot 0) (not mindig))
-                 (format:out-char #\0))
-             (format:out-substr format:fn-str 0 format:fn-dot)
-             (format:out-char #\.)
-             (format:out-substr format:fn-str format:fn-dot format:fn-len)))))
+                   (format:out-char #\0))
+               (format:out-substr format:fn-str 0 format:fn-dot)
+               (format:out-char #\.)
+               (format:out-substr format:fn-str format:fn-dot format:fn-len)))))))
 
                                        ; the flonum buffers
 
@@ -1456,8 +1460,8 @@
                                (if (> format:fn-dot left-zeros) 
                                    (begin              ; norm 0{0}nn.mm to nn.mm
                                      (format:fn-shiftleft left-zeros)
-                                     (set! left-zeros 0)
-                                     (set! format:fn-dot (- format:fn-dot left-zeros)))
+                                     (set! format:fn-dot (- format:fn-dot left-zeros))
+                                     (set! left-zeros 0))
                                    (begin              ; normalize 0{0}.nnn to .nnn
                                      (format:fn-shiftleft format:fn-dot)
                                      (set! left-zeros (- left-zeros format:fn-dot))