[cl-store-cvs] CVS update: cl-store/lispworks/custom-xml.lisp cl-store/lispworks/custom.lisp

[Sean Ross]

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