[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