[cl-store-cvs] CVS update: cl-store/ChangeLog cl-store/README cl-store/circularities.lisp cl-store/default-backend.lisp cl-store/package.lisp cl-store/tests.lisp cl-store/xml-backend.lisp
Sean Ross
sross at common-lisp.net
Mon Aug 30 15:10:22 UTC 2004
Update of /project/cl-store/cvsroot/cl-store
In directory common-lisp.net:/tmp/cvs-serv8063
Modified Files:
ChangeLog README circularities.lisp default-backend.lisp
package.lisp tests.lisp xml-backend.lisp
Log Message:
Moved implementation specific storing to own files.
Structure storing for lispworks (Alain Parsis)
Date: Mon Aug 30 17:10:20 2004
Author: sross
Index: cl-store/ChangeLog
diff -u cl-store/ChangeLog:1.5 cl-store/ChangeLog:1.6
--- cl-store/ChangeLog:1.5 Tue Aug 17 13:12:43 2004
+++ cl-store/ChangeLog Mon Aug 30 17:10:20 2004
@@ -1,4 +1,11 @@
2004-07-29 Sean Ross <sdr at jhb.ucs.co.za>
+ * sbcl/custom.lisp, sbcl/custom-xml.lisp: Custom structure storing.
+ * cmucl/custom.lisp, cmucl/custom-xml.lisp: Custom structure storing.
+ * lispworks/custom.lisp, lispworks/custom-xml.lisp: Custom structure storing
+ for Lispworks from Alain Picard.
+ * test.lisp: Enabled structure tests for Lispworks.
+
+2004-07-29 Sean Ross <sdr at jhb.ucs.co.za>
* cl-store.asd: New version (0.2)
* sbcl/sockets.lisp: Removed.
* store.lisp: Removed.
Index: cl-store/README
diff -u cl-store/README:1.5 cl-store/README:1.6
--- cl-store/README:1.5 Tue Aug 17 14:07:37 2004
+++ cl-store/README Mon Aug 30 17:10:20 2004
@@ -94,7 +94,7 @@
- Functions, closures and anything remotely funcallable is unserializable.
- MOP classes are largely unsupported at the moment.
- - Structure instances are not supported in anything but CMUCL and SBCL.
+ - Structure instances are not supported in MCL, OpenMCL and Clisp.
- Structure definitions aren't supported at all.
- No documentation.
- Older cmucl versions, where (eq 'cl:class 'pcl::class)
Index: cl-store/circularities.lisp
diff -u cl-store/circularities.lisp:1.5 cl-store/circularities.lisp:1.6
--- cl-store/circularities.lisp:1.5 Tue Aug 17 13:12:43 2004
+++ cl-store/circularities.lisp Mon Aug 30 17:10:20 2004
@@ -130,6 +130,8 @@
(incf *stored-counter*)
(gethash obj *stored-values*))
+(declaim (inline update-seen))
+
(defun update-seen (obj)
"Register OBJ as having been stored."
(setf (gethash obj *stored-values*) *stored-counter*)
Index: cl-store/default-backend.lisp
diff -u cl-store/default-backend.lisp:1.3 cl-store/default-backend.lisp:1.4
--- cl-store/default-backend.lisp:1.3 Tue Aug 17 17:11:30 2004
+++ cl-store/default-backend.lisp Mon Aug 30 17:10:20 2004
@@ -3,6 +3,7 @@
;; The cl-store backend.
+;; cater for unicode characters in symbol names
;; Outstanding objects.
;; functions, methods
;; closures (once done add initform, and default-initargs)
@@ -203,10 +204,8 @@
(defrestore-cl-store (symbol stream)
(let ((package (restore-simple-standard-string stream))
(name (restore-simple-standard-string stream)))
- (multiple-value-bind (a b)
- (intern name package)
- (declare (ignore b))
- a)))
+ (values (intern name package))))
+
;; lists
(defstore-cl-store (obj cons stream)
@@ -297,11 +296,6 @@
(output-type-code +condition-code+ stream)
(store-type-object obj stream))
-#+(or sbcl cmu)
-(defstore-cl-store (obj structure-object stream)
- (output-type-code +structure-object-code+ stream)
- (store-type-object obj stream))
-
(defun restore-type-object (stream)
(let* ((class (find-class (restore-object stream)))
(length (restore-object stream))
@@ -314,15 +308,14 @@
(setting (slot-value slot-name) (restore-object stream)))))
new-instance))
-#+(or sbcl cmu)
-(defrestore-cl-store (structure-object stream)
- (restore-type-object stream))
-
(defrestore-cl-store (condition stream)
(restore-type-object stream))
(defrestore-cl-store (standard-object stream)
(restore-type-object stream))
+
+
+
;; classes
(defstore-cl-store (obj standard-class stream)
Index: cl-store/package.lisp
diff -u cl-store/package.lisp:1.8 cl-store/package.lisp:1.9
--- cl-store/package.lisp:1.8 Tue Aug 17 13:12:43 2004
+++ cl-store/package.lisp Mon Aug 30 17:10:20 2004
@@ -4,7 +4,6 @@
(defpackage #:cl-store
(:use #:cl)
(:export #:backend
- #:name
#:magic-number
#:stream-type
#:restorer-funs
Index: cl-store/tests.lisp
diff -u cl-store/tests.lisp:1.4 cl-store/tests.lisp:1.5
--- cl-store/tests.lisp:1.4 Tue Aug 17 13:12:43 2004
+++ cl-store/tests.lisp Mon Aug 30 17:10:20 2004
@@ -253,11 +253,11 @@
(defstruct (b (:include a))
d e f)
-#+(or sbcl cmu)
+#+(or sbcl cmu lispworks)
(deftestit structure-object.1 (make-a :a 1 :b 2 :c 3))
-#+(or sbcl cmu)
+#+(or sbcl cmu lispworks)
(deftestit structure-object.2 (make-b :a 1 :b 2 :c 3 :d 4 :e 5 :f 6))
-#+(or sbcl cmu)
+#+(or sbcl cmu lispworks)
(deftestit structure-object.3 (make-b :a 1 :b (make-a :a 1 :b 3 :c 2)
:c #\Space :d #(1 2 3) :e (list 1 2 3)
:f (make-hash-table)))
@@ -348,7 +348,7 @@
(defvar circ7 (let ((x (make-a)))
(setf (a-a x) x)))
-#+(or sbcl cmu)
+#+(or sbcl cmu lispworks)
(deftest circ.7 (progn (store circ7 *test-file*)
(let ((x (restore *test-file*)))
(eq (a-a x) x)))
@@ -359,6 +359,7 @@
;; clisp apparently creates a copy of the strings in a pathname
+;; so a test for eqness is pointless.
#-clisp
(deftest circ.8 (progn (store circ.8 *test-file*)
(let ((x (restore *test-file*)))
Index: cl-store/xml-backend.lisp
diff -u cl-store/xml-backend.lisp:1.2 cl-store/xml-backend.lisp:1.3
--- cl-store/xml-backend.lisp:1.2 Tue Aug 17 17:11:29 2004
+++ cl-store/xml-backend.lisp Mon Aug 30 17:10:20 2004
@@ -92,9 +92,6 @@
obj)))
-
-
-
;; referrer, Required for a resolving backend
(defmethod store-referrer (ref stream (backend xml-backend))
(princ-xml "REFERRER" ref stream))
@@ -279,13 +276,6 @@
(princ-and-store "CLASS" (type-of obj) stream)
(xml-dump-type-object obj stream)))
-
-#+(or sbcl cmu)
-(defstore-xml (obj structure-object stream)
- (with-tag ("STRUCTURE-OBJECT" stream)
- (princ-and-store "CLASS" (type-of obj) stream)
- (xml-dump-type-object obj stream)))
-
(defun restore-xml-type-object (place)
(let* ((class (find-class (restore-first (get-child "CLASS" place))))
(new-instance (allocate-instance class)))
@@ -301,11 +291,6 @@
(defrestore-xml (condition place)
(restore-xml-type-object place))
-
-#+(or sbcl cmu)
-(defrestore-xml (structure-object place)
- (restore-xml-type-object place))
-
;; classes
(defun store-slot (slot stream)
More information about the Cl-store-cvs
mailing list