Make OUTPUT-FLOAT-INFINITY and OUTPUT-FLOAT-NAN more robust against *print-circle* and other variables.

This commit is contained in:
Juan Jose Garcia Ripoll 2009-06-20 19:12:39 +02:00
parent 0bf0cfbbae
commit 3412355a5c
2 changed files with 25 additions and 3 deletions

View file

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

View file

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