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

ieee-floats: fix printing of NaN's

Browse source 
Add readable print if the feature :ieee-floating-point is present.
This commit is contained in:
Daniel Kochmański 2016-08-12 08:48:36 +02:00
parent bc567e0c3f
commit 9874b6e53a
1 changed files with 18 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

25
src/clos/print.lsp
View file

@ -208,13 +208,24 @@ printer and we should rather use MAKE-LOAD-FORM."
m)
(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>")))))
(unless (ext:float-nan-p x)
(signal 'type-error :datum x :expected-type 'float-nan))
(cond
((null *print-readably*)
(etypecase 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>")))
#+ieee-floating-point
(*read-eval*
(etypecase x
(single-float "#.(coerce (si:nan) 'single-float)")
(double-float "#.(coerce (si:nan) 'double-float)")
(long-float "#.(coerce (si:nan) 'long-float)")
(short-float "#.(coerce (si:nan) 'short-float)")))
(t (error 'print-not-readable :object x))))
(defun ext::float-infinity-string (x)
(unless (ext:float-infinity-p x)