[cl-store-cvs] CVS update: cl-store/lispworks/.cvsignore cl-store/lispworks/custom-xml.lisp

[Sean Ross]

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