[cl-store-cvs] CVS cl-store/lispworks

[sross]

Update of /project/cl-store/cvsroot/cl-store/lispworks
In directory clnet:/tmp/cvs-serv14422/lispworks

Modified Files:
	custom.lisp 
Log Message:


--- /project/cl-store/cvsroot/cl-store/lispworks/custom.lisp	2005/02/11 12:00:41	1.6
+++ /project/cl-store/cvsroot/cl-store/lispworks/custom.lisp	2006/08/03 19:42:09	1.7
@@ -4,18 +4,29 @@
 (in-package :cl-store)
 
 ;; Setup special floats
-(defvar +positive-infinity+ (expt most-positive-double-float 2))
-(defvar +negative-infinity+ (expt most-negative-double-float 3))
-(defvar +nan-float+ (/ +negative-infinity+ +negative-infinity+))
+(defvar +single-positive-infinity+ most-positive-single-float)
+(defvar +single-negative-infinity+ most-negative-single-float)
+(defvar +single-nan+)
+
+(defvar +double-positive-infinity+ most-positive-double-float)
+(defvar +double-negative-infinity+ most-negative-double-float)
+(defvar +double-nan+)
+
+(setf +single-positive-infinity+ (expt +single-positive-infinity+ 2))
+(setf +single-negative-infinity+ (expt +single-negative-infinity+ 3))
+(setf +single-nan+ (/ +single-negative-infinity+ +single-negative-infinity+))
+(setf +double-positive-infinity+ (expt +double-positive-infinity+ 2))
+(setf +double-negative-infinity+ (expt +double-negative-infinity+ 3))
+(setf +double-nan+ (/ +double-negative-infinity+ +double-negative-infinity+))
 
 (setf *special-floats*
-  (list (cons +positive-infinity+ +positive-double-infinity-code+)
-        (cons +positive-infinity+ +positive-infinity-code+)
-        (cons +negative-infinity+ +negative-double-infinity-code+)
-        (cons +negative-infinity+ +negative-infinity-code+)
-        (cons +nan-float+ +float-double-nan-code+)
-        (cons +nan-float+ +float-nan-code+)))
-
+      (list (cons +double-positive-infinity+ +positive-double-infinity-code+)
+            (cons +single-positive-infinity+ +positive-infinity-code+)
+            
+            (cons +single-negative-infinity+ +negative-infinity-code+)
+            (cons +double-negative-infinity+ +negative-double-infinity-code+)
+            (cons +single-nan+ +float-nan-code+)
+            (cons +double-nan+ +float-double-nan-code+)))
 
 ;; Custom structure storing from Alain Picard.
 (defstore-cl-store (obj structure-object stream)