Update of /project/cl-store/cvsroot/cl-store/lispworks In directory common-lisp.net:/tmp/cvs-serv6638/lispworks Modified Files: custom-xml.lisp Added Files: .cvsignore Log Message: Changelog 2004-10-06 Date: Wed Oct 6 16:41:40 2004 Author: sross Index: cl-store/lispworks/custom-xml.lisp diff -u cl-store/lispworks/custom-xml.lisp:1.1 cl-store/lispworks/custom-xml.lisp:1.2 --- cl-store/lispworks/custom-xml.lisp:1.1 Mon Aug 30 17:10:23 2004 +++ cl-store/lispworks/custom-xml.lisp Wed Oct 6 16:41:40 2004 @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;; See the file LICENCE for licence information. -(in-package :cl-store) +(in-package :cl-store-xml) (defstore-xml (obj structure-object stream) (with-tag ("STRUCTURE-OBJECT" stream) @@ -23,4 +23,35 @@ (restore-first (get-child "VALUE" slot)))))))) -;; EOF \ No newline at end of file + +(defstore-xml (obj float stream) + (block body + (handler-bind ((simple-error + #'(lambda (err) + (declare (ignore err)) + (cond + ((positive-infinity-p obj) + (with-tag ("POSITIVE-INFINITY" stream)) + (return-from body)) + ((negative-infinity-p obj) + (with-tag ("NEGATIVE-INFINITY" stream)) + (return-from body)) + (t nil))))) + (multiple-value-bind (signif exp sign) + (integer-decode-float obj) + (with-tag ("FLOAT" stream) + (princ-and-store "SIGNIFICAND" signif stream) + (princ-and-store "EXPONENT" exp stream) + (princ-and-store "SIGN" sign stream) + (princ-and-store "TYPE" (float-type obj) stream)))))) + +(defrestore-xml (positive-infinity stream) + (declare (ignore stream)) + +positive-infinity+) + +(defrestore-xml (negative-infinity stream) + (declare (ignore stream)) + +negative-infinity+) + + +;; EOF