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

[sross]

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

Modified Files:
	.cvsignore custom.lisp 
Log Message:
Changelog 2006-12-11 and 2006-10-01



--- /project/cl-store/cvsroot/cl-store/lispworks/.cvsignore	2004/10/06 14:41:40	1.1
+++ /project/cl-store/cvsroot/cl-store/lispworks/.cvsignore	2006/12/11 21:44:03	1.2
@@ -1 +1,11 @@
+*.fasl
+*.x86f
 *.ufsl
+filetest.cls
+*.fas
+*.lib
+clean.sh
+wc.sh
+*.fsl
+*.ofasl
+*.ufasl
--- /project/cl-store/cvsroot/cl-store/lispworks/custom.lisp	2006/08/03 19:42:09	1.7
+++ /project/cl-store/cvsroot/cl-store/lispworks/custom.lisp	2006/12/11 21:44:03	1.8
@@ -4,29 +4,19 @@
 (in-package :cl-store)
 
 ;; Setup special floats
-(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 +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+)))
+(defun create-float-values (value &rest codes)
+  (let ((neg-inf (expt value 3)))
+    (mapcar 'cons
+            (list (expt (abs value) 2)
+                  neg-inf
+                  (/ neg-inf neg-inf))
+            codes)))
+
+(defparameter *special-floats*
+  (nconc (create-float-values most-negative-single-float +positive-infinity-code+
+                              +negative-infinity-code+ +float-nan-code+)
+         (create-float-values most-negative-double-float +positive-double-infinity-code+
+                              +negative-double-infinity-code+ +float-double-nan-code+)))
 
 ;; Custom structure storing from Alain Picard.
 (defstore-cl-store (obj structure-object stream)