From: Daniel Kochmański <daniel@turtleware.eu>
Date: Thu, 3 Sep 2015 06:47:00 +0000 (+0200)
Subject: printer: coerce float infinity more roboustly
X-Git-Url: http://git.pulsar-zone.net/?a=commitdiff_plain;h=527be2a01774173449d53710cf179d601ebf7c5a;p=ecl.git

printer: coerce float infinity more roboustly

Basically use C function instead of a generic Lisp one.

Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
---

diff --git a/src/c/printer/float_to_string.d b/src/c/printer/float_to_string.d
index 5aad427..ecde3db 100644
--- a/src/c/printer/float_to_string.d
+++ b/src/c/printer/float_to_string.d
@@ -95,10 +95,10 @@ si_float_to_string_free(cl_object buffer_or_nil, cl_object number,
 
         if (ecl_float_nan_p(number)) {
                 cl_object s = funcall(2, @'ext::float-nan-string', number);
-                @(return push_base_string(buffer_or_nil, s));
+                @(return push_base_string(buffer_or_nil, si_coerce_to_base_string(s)));
         } else if (ecl_float_infinity_p(number)) {
                 cl_object s = funcall(2, @'ext::float-infinity-string', number);
-                @(return push_base_string(buffer_or_nil, s));
+                @(return push_base_string(buffer_or_nil, si_coerce_to_base_string(s)));
         }
         base = ecl_length(buffer_or_nil);
         exp = si_float_to_digits(buffer_or_nil, number, ECL_NIL, ECL_NIL);
diff --git a/src/clos/print.lsp b/src/clos/print.lsp
index b7c6518..0f7f866 100644
--- a/src/clos/print.lsp
+++ b/src/clos/print.lsp
@@ -207,13 +207,11 @@ printer and we should rather use MAKE-LOAD-FORM."
 (defun ext::float-nan-string (x)
   (when *print-readably*
     (error 'print-not-readable :object x))
-  (coerce
    (cdr (assoc (type-of x)
                '((single-float . "#<single-float quiet NaN>")
                  (double-float . "#<double-float quiet NaN>")
                  (long-float . "#<long-float quiet NaN>")
-                 (short-float . "#<short-float quiet NaN>"))))
-   'base-string))
+                 (short-float . "#<short-float quiet NaN>")))))
 
 (defun ext::float-infinity-string (x)
   (when (and *print-readably* (null *read-eval*))
@@ -238,7 +236,7 @@ printer and we should rather use MAKE-LOAD-FORM."
                         (if (plusp x) positive-infinities negative-infinities))))
     (unless record
       (error "Not an infinity"))
-    (coerce (cdr record) 'base-string)))
+    (cdr record)))
 
 ;;; ----------------------------------------------------------------------
 ;;; Describe