Update of /project/cl-store/cvsroot/cl-store/lispworks In directory common-lisp.net:/tmp/cvs-serv10507/lispworks
Modified Files: custom-xml.lisp custom.lisp Log Message: Changelogs 2004-10-07 to 2004-10-13 Date: Wed Oct 13 14:36:03 2004 Author: sross
Index: cl-store/lispworks/custom-xml.lisp diff -u cl-store/lispworks/custom-xml.lisp:1.2 cl-store/lispworks/custom-xml.lisp:1.3 --- cl-store/lispworks/custom-xml.lisp:1.2 Wed Oct 6 16:41:40 2004 +++ cl-store/lispworks/custom-xml.lisp Wed Oct 13 14:36:03 2004 @@ -30,12 +30,15 @@ #'(lambda (err) (declare (ignore err)) (cond - ((positive-infinity-p obj) + ((cl-store::positive-infinity-p obj) (with-tag ("POSITIVE-INFINITY" stream)) (return-from body)) - ((negative-infinity-p obj) + ((cl-store::negative-infinity-p obj) (with-tag ("NEGATIVE-INFINITY" stream)) (return-from body)) + ((cl-store::float-nan-p obj) + (with-tag ("FLOAT-NAN" stream)) + (return-from body)) (t nil))))) (multiple-value-bind (signif exp sign) (integer-decode-float obj) @@ -47,11 +50,14 @@
(defrestore-xml (positive-infinity stream) (declare (ignore stream)) - +positive-infinity+) + cl-store::+positive-infinity+)
(defrestore-xml (negative-infinity stream) (declare (ignore stream)) - +negative-infinity+) + cl-store::+negative-infinity+)
+(defrestore-xml (float-nan stream) + (declare (ignore stream)) + cl-store::+nan-float+)
;; EOF
Index: cl-store/lispworks/custom.lisp diff -u cl-store/lispworks/custom.lisp:1.2 cl-store/lispworks/custom.lisp:1.3 --- cl-store/lispworks/custom.lisp:1.2 Fri Oct 1 10:49:47 2004 +++ cl-store/lispworks/custom.lisp Wed Oct 13 14:36:03 2004 @@ -6,6 +6,8 @@ ;; custom support for infinite floats from Alain Picard. (defconstant +positive-infinity+ (expt most-positive-double-float 2)) (defconstant +negative-infinity+ (expt most-negative-double-float 3)) +(defconstant +nan-float+ (/ (expt most-positive-double-float 2) + (expt most-positive-double-float 2)))
(defun positive-infinity-p (number) (> number most-positive-double-float)) @@ -13,6 +15,9 @@ (defun negative-infinity-p (number) (< number most-negative-double-float))
+(defun float-nan-p (number) + (eql number +nan-float+)) + ;; Attempt at fixing broken storing infinity problem (defstore-cl-store (obj float stream) (block body @@ -27,6 +32,9 @@ ((negative-infinity-p obj) (output-type-code +negative-infinity-code+ stream) (return-from body)) ; success + ((float-nan-p obj) + (output-type-code +float-nan-code+ stream) + (return-from body)) (t ;; Unclear what _other_ sort of error we can ;; get by failing to decode a float, but, @@ -49,6 +57,10 @@ (declare (ignore stream)) +positive-infinity+)
+(defrestore-cl-store (nan-float stream) + (declare (ignore stream)) + +nan-float+) +
;; Custom structure storing from Alain Picard. (defstore-cl-store (obj structure-object stream) @@ -72,4 +84,4 @@ (setting (slot-value slot-name) (restore-object stream))))) new-instance))
-;; EOF \ No newline at end of file +;; EOF