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@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@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)