[cl-store-cvs] CVS update: cl-store/ChangeLog cl-store/cl-store.asd cl-store/default-backend.lisp cl-store/package.lisp cl-store/utils.lisp
Sean Ross
sross at common-lisp.net
Thu Feb 17 08:23:54 UTC 2005
Update of /project/cl-store/cvsroot/cl-store
In directory common-lisp.net:/tmp/cvs-serv24114
Modified Files:
ChangeLog cl-store.asd default-backend.lisp package.lisp
utils.lisp
Log Message:
Changelog 2005-02-17
Date: Thu Feb 17 09:23:49 2005
Author: sross
Index: cl-store/ChangeLog
diff -u cl-store/ChangeLog:1.22 cl-store/ChangeLog:1.23
--- cl-store/ChangeLog:1.22 Wed Feb 16 13:40:24 2005
+++ cl-store/ChangeLog Thu Feb 17 09:23:48 2005
@@ -1,3 +1,11 @@
+2005-02-17 Sean Ross <sross at common-lisp.net>
+ * package.lisp, utils.lisp, default-backend.lisp: Patch
+ from Thomas Stenhaug which changed get-slot-details to
+ a generic-function so that it can be customized.
+ Added serializable-slots (returns a list of slot-definitions)
+ which can be overridden to customize which slots are
+ serialized when storing clos instances.
+
2005-02-16 Sean Ross <sross at common-lisp.net>
* default-backend.lisp, package.lisp, plumbing.lisp: Patch
from Thomas Stenhaug which adds more comprehensive package
Index: cl-store/cl-store.asd
diff -u cl-store/cl-store.asd:1.21 cl-store/cl-store.asd:1.22
--- cl-store/cl-store.asd:1.21 Wed Feb 16 13:40:24 2005
+++ cl-store/cl-store.asd Thu Feb 17 09:23:48 2005
@@ -40,7 +40,7 @@
:name "CL-STORE"
:author "Sean Ross <sdr at jhb.ucs.co.za>"
:maintainer "Sean Ross <sdr at jhb.ucs.co.za>"
- :version "0.4.15"
+ :version "0.4.17"
:description "Serialization package"
:long-description "Portable CL Package to serialize data types"
:licence "MIT"
Index: cl-store/default-backend.lisp
diff -u cl-store/default-backend.lisp:1.20 cl-store/default-backend.lisp:1.21
--- cl-store/default-backend.lisp:1.20 Wed Feb 16 13:40:24 2005
+++ cl-store/default-backend.lisp Thu Feb 17 09:23:48 2005
@@ -101,8 +101,8 @@
;; so we we have a little optimization for it
;; We need this for circularity stuff.
-(defmethod int-sym-or-char-p ((backend cl-store) (fn symbol))
- (find fn '(integer character 32-bit-integer symbol)))
+(defmethod int-sym-or-char-p ((backend cl-store) (type symbol))
+ (find type '(integer character 32-bit-integer symbol)))
(defstore-cl-store (obj integer stream)
(if (typep obj 'sb32)
@@ -335,7 +335,7 @@
(defun store-type-object (obj stream)
(let* ((all-slots (remove-if-not (lambda (x)
(slot-boundp obj (slot-definition-name x)))
- (compute-slots (class-of obj))))
+ (serializable-slots obj)))
(slots (if *store-class-slots*
all-slots
(remove-if #'(lambda (x) (eql (slot-definition-allocation x)
Index: cl-store/package.lisp
diff -u cl-store/package.lisp:1.18 cl-store/package.lisp:1.19
--- cl-store/package.lisp:1.18 Wed Feb 16 13:40:24 2005
+++ cl-store/package.lisp Thu Feb 17 09:23:48 2005
@@ -14,20 +14,21 @@
#:backend-store-object #:get-class-details #:get-array-values
#:restore #:backend-restore #:cl-store #:referrerp
#:check-magic-number #:get-next-reader #:int-sym-or-char-p
- #:restore-object #:backend-restore-object
+ #:restore-object #:backend-restore-object #:serializable-slots
#:defstore-cl-store #:defrestore-cl-store #:register-code
#:output-type-code #:store-referrer #:resolving-object
#:internal-store-object #:setting #:simple-standard-string
#:float-type #:get-float-type #:make-referrer #:setting-hash
#:multiple-value-store #:*postfix-setters* #:caused-by
#:store-32-bit #:read-32-bit #:*check-for-circs*
- #:*store-hash-size* #:*restore-hash-size*
+ #:*store-hash-size* #:*restore-hash-size* #:get-slot-details
#:*store-used-packages* #:*nuke-existing-packages*)
#+sbcl (:import-from #:sb-mop
#:generic-function-name
#:slot-definition-name
#:slot-definition-allocation
+ #:slot-definition
#:compute-slots
#:slot-definition-initform
#:slot-definition-initargs
@@ -55,6 +56,7 @@
#:slot-definition-name
#:slot-definition-allocation
#:compute-slots
+ #:slot-definition
#:slot-definition-initform
#:slot-definition-initargs
#:slot-definition-name
@@ -78,6 +80,7 @@
#:slot-definition-name
#:slot-definition-allocation
#:compute-slots
+ #:slot-definition
#:slot-definition-initform
#:slot-definition-initargs
#:slot-definition-name
@@ -105,6 +108,7 @@
#:generic-function-name
#:slot-definition-allocation
#:compute-slots
+ #:slot-definition
#:slot-definition-initform
#:slot-definition-initargs
#:slot-definition-name
@@ -121,6 +125,7 @@
#:slot-definition-name
#:generic-function-name
#:slot-definition-allocation
+ #:slot-definition
#:compute-slots
#:slot-definition-initform
#:slot-definition-initargs
Index: cl-store/utils.lisp
diff -u cl-store/utils.lisp:1.11 cl-store/utils.lisp:1.12
--- cl-store/utils.lisp:1.11 Fri Feb 11 13:00:31 2005
+++ cl-store/utils.lisp Thu Feb 17 09:23:48 2005
@@ -15,18 +15,33 @@
(defun mappend (fn &rest lsts)
(apply #'append (apply #'mapcar fn lsts)))
+(defgeneric serializable-slots (object)
+ (:documentation
+ "Return a list of slot-definitions to serialize. The default
+ is to call compute-slots on the objects class")
+ (:method ((object standard-object))
+ (compute-slots (class-of object)))
+#+(or sbcl cmu)
+ (:method ((object structure-object))
+ (compute-slots (class-of object)))
+ (:method ((object condition))
+ (compute-slots (class-of object))))
-(defun get-slot-details (slot-definition)
- "Return a list of slot details which can be
- used as an argument to ensure-class"
- (list :name (slot-definition-name slot-definition)
- :allocation (slot-definition-allocation slot-definition)
- :initargs (slot-definition-initargs slot-definition)
- ;; :initform. dont use initform until we can
- ;; serialize functions
- :readers (slot-definition-readers slot-definition)
- :type (slot-definition-type slot-definition)
- :writers (slot-definition-writers slot-definition)))
+; Generify get-slot-details for customization (from Thomas Stenhaug)
+(defgeneric get-slot-details (slot-definition)
+ (:documentation
+ "Return a list of slot details which can be used
+ as an argument to ensure-class")
+ (:method ((slot-definition #+(or ecl clisp) t
+ #-(or ecl clisp) slot-definition))
+ (list :name (slot-definition-name slot-definition)
+ :allocation (slot-definition-allocation slot-definition)
+ :initargs (slot-definition-initargs slot-definition)
+ ;; :initform. dont use initform until we can
+ ;; serialize functions
+ :readers (slot-definition-readers slot-definition)
+ :type (slot-definition-type slot-definition)
+ :writers (slot-definition-writers slot-definition))))
(defmacro awhen (test &body body)
`(aif ,test
More information about the Cl-store-cvs
mailing list