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

Simplify ext:float-infinity-string

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-11-01 23:40:51 +01:00
parent 7838cb5897
commit be5b27367f
1 changed files with 21 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

41
src/clos/print.lsp
View file

@ -166,26 +166,27 @@ printer and we should rather use MAKE-LOAD-FORM."
(defun ext::float-infinity-string (x)
(when (and *print-readably* (null *read-eval*))
(error 'print-not-readable :object x))
(let ((*print-circle* nil)
(*print-package* #.(find-package :keyword))
(negative-infinities '((single-float .
"#.ext::single-float-negative-infinity")
(double-float .
"#.ext::double-float-negative-infinity")
(long-float .
"#.ext::long-float-negative-infinity")
(short-float .
"#.ext::short-float-negative-infinity")))
(positive-infinities '((single-float .
"#.ext::single-float-positive-infinity")
(double-float .
"#.ext::double-float-positive-infinity")
(long-float .
"#.ext::long-float-positive-infinity")
(short-float .
"#.ext::short-float-positive-infinity"))))
(cdr (assoc (type-of x)
(if (plusp x) positive-infinities negative-infinities)))))
(let* ((negative-infinities '((single-float .
"#.ext::single-float-negative-infinity")
(double-float .
"#.ext::double-float-negative-infinity")
(long-float .
"#.ext::long-float-negative-infinity")
(short-float .
"#.ext::short-float-negative-infinity")))
(positive-infinities '((single-float .
"#.ext::single-float-positive-infinity")
(double-float .
"#.ext::double-float-positive-infinity")
(long-float .
"#.ext::long-float-positive-infinity")
(short-float .
"#.ext::short-float-positive-infinity")))
(record (assoc (type-of x)
(if (plusp x) positive-infinities negative-infinities))))
(unless record
(error "Not an infinity"))
(cdr record)))
;;; ----------------------------------------------------------------------
;;; Describe