mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-12 20:31:55 -08:00
Code Issues Projects Releases Packages Wiki Activity

printer: coerce float infinity more roboustly

Browse source 
Basically use C function instead of a generic Lisp one.

Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
This commit is contained in:
Daniel Kochmański 2015-09-03 08:47:00 +02:00
parent d15c42d2a1
commit 527be2a017
2 changed files with 4 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/c/printer/float_to_string.d
View file

@ -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);

6
src/clos/print.lsp
View file

@ -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