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)