mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-12 20:31:55 -08:00
Make OUTPUT-FLOAT-INFINITY and OUTPUT-FLOAT-NAN more robust against *print-circle* and other variables.
This commit is contained in:
parent
0bf0cfbbae
commit
3412355a5c
2 changed files with 25 additions and 3 deletions
|
|
@ -11,6 +11,8 @@ ECL 9.6.3:
|
|||
- The compiler now uses cl_core to efficiently access certain lisp
|
||||
constants (standard packages, standard readtables, etc)
|
||||
|
||||
- EXT:OUTPUT-FLOAT-INFINITY works now fine when *print-circle* is T.
|
||||
|
||||
ECL 9.6.2:
|
||||
==========
|
||||
|
||||
|
|
|
|||
|
|
@ -155,11 +155,31 @@ printer and we should rather use MAKE-LOAD-FORM."
|
|||
m)
|
||||
|
||||
(defun ext::output-float-nan (x stream)
|
||||
(format stream "#<~A quiet NaN>" (type-of x)))
|
||||
(print-unreadable-object (x stream :type t)
|
||||
(princ "quiet NaN" stream)))
|
||||
|
||||
(defun ext::output-float-infinity (x stream)
|
||||
(format stream "#.EXT::~A-~A-INFINITY" (symbol-name (type-of x))
|
||||
(if (plusp x) "POSITIVE" "NEGATIVE")))
|
||||
(when (and *print-readably* (null *read-eval*))
|
||||
(error 'print-not-readable :object x))
|
||||
(let ((*print-circle* nil)
|
||||
(*print-package* #.(find-package :keyword))
|
||||
(infinities '((#.ext::single-float-negative-infinity .
|
||||
ext::single-float-negative-infinity)
|
||||
(#.ext::double-float-negative-infinity .
|
||||
ext::double-float-negative-infinity)
|
||||
(#.ext::short-float-negative-infinity .
|
||||
ext::short-float-negative-infinity)
|
||||
(#.ext::long-float-negative-infinity .
|
||||
ext::long-float-negative-infinity)
|
||||
(#.ext::single-float-positive-infinity .
|
||||
ext::single-float-positive-infinity)
|
||||
(#.ext::double-float-positive-infinity .
|
||||
ext::double-float-positive-infinity)
|
||||
(#.ext::short-float-positive-infinity .
|
||||
ext::short-float-positive-infinity)
|
||||
(#.ext::long-float-positive-infinity .
|
||||
ext::long-float-positive-infinity))))
|
||||
(format stream "#.~S" (cdr (assoc x infinities)))))
|
||||
|
||||
;;; ----------------------------------------------------------------------
|
||||
;;; Describe
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue