[cl-store-cvs] CVS cl-store/acl
sross
sross at common-lisp.net
Thu Dec 14 18:15:42 UTC 2006
Update of /project/cl-store/cvsroot/cl-store/acl
In directory clnet:/tmp/cvs-serv7536/acl
Modified Files:
custom.lisp
Log Message:
Changelog 2006-12-13
--- /project/cl-store/cvsroot/cl-store/acl/custom.lisp 2005/02/11 12:00:35 1.3
+++ /project/cl-store/cvsroot/cl-store/acl/custom.lisp 2006/12/14 18:15:41 1.4
@@ -4,24 +4,12 @@
(in-package :cl-store)
-;; setup special floats
-(defvar +single-positive-infinity+ (expt most-positive-single-float 2))
-(defvar +single-negative-infinity+ (expt most-negative-single-float 3))
-(defvar +single-nan+ (/ +single-negative-infinity+ +single-negative-infinity+))
-
-(defvar +double-positive-infinity+ (expt most-positive-double-float 2))
-(defvar +double-negative-infinity+ (expt most-negative-double-float 3))
-(defvar +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)))
;; EOF
More information about the Cl-store-cvs
mailing list