Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 9720adf)
printer: float infinity/nan: coerce printed form to base-string
authorDaniel Kochmański <daniel@turtleware.eu>
Thu, 3 Sep 2015 06:12:08 +0000 (08:12 +0200)
committerDaniel Kochmański <daniel@turtleware.eu>
Thu, 3 Sep 2015 06:12:08 +0000 (08:12 +0200)
CLOS printer uses normal strings while float_to_string.d calls
push_base_string to cache printable form of infinity (and nan). Coerce
clos strings to base-string. Fixes #153. Related to #114.

Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
src/clos/print.lsp patch | blob | blame | history

diff --git a/src/clos/print.lsp b/src/clos/print.lsp
index defa929..b7c6518 100644 (file)
--- a/src/clos/print.lsp
+++ b/src/clos/print.lsp
@@ -207,11 +207,13 @@ printer and we should rather use MAKE-LOAD-FORM."
 (defun ext::float-nan-string (x)
   (when *print-readably*
     (error 'print-not-readable :object x))
-  (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>")))))
+  (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))
 
 (defun ext::float-infinity-string (x)
   (when (and *print-readably* (null *read-eval*))
@@ -236,7 +238,7 @@ printer and we should rather use MAKE-LOAD-FORM."
                         (if (plusp x) positive-infinities negative-infinities))))
     (unless record
       (error "Not an infinity"))
-    (cdr record)))
+    (coerce (cdr record) 'base-string)))
 
 ;;; ----------------------------------------------------------------------
 ;;; Describe
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)