[cl-store-cvs] CVS update: cl-store/ChangeLog cl-store/backends.lisp cl-store/cl-store.asd cl-store/default-backend.lisp cl-store/plumbing.lisp cl-store/tests.lisp cl-store/utils.lisp
Sean Ross
sross at common-lisp.net
Wed May 18 15:34:13 UTC 2005
Update of /project/cl-store/cvsroot/cl-store
In directory common-lisp.net:/tmp/cvs-serv6678
Modified Files:
ChangeLog backends.lisp cl-store.asd default-backend.lisp
plumbing.lisp tests.lisp utils.lisp
Log Message:
Changelog 2005-05-18
Date: Wed May 18 17:34:10 2005
Author: sross
Index: cl-store/ChangeLog
diff -u cl-store/ChangeLog:1.32 cl-store/ChangeLog:1.33
--- cl-store/ChangeLog:1.32 Fri May 6 16:19:29 2005
+++ cl-store/ChangeLog Wed May 18 17:34:09 2005
@@ -1,3 +1,9 @@
+2005-05-18 Sean Ross <sross at common-lisp.net>
+ * utils.lisp: Removed awhen
+ * backends.lisp: Added a compatible-magic-numbers slot.
+ * default-backend.lisp: misc cleanups.
+ New magic number (can still restore previous versions files).
+
2005-05-06 Sean Ross <sross at common-lisp.net>
* backends.lisp: Added optional errorp argument
to find-backend (default false).
Index: cl-store/backends.lisp
diff -u cl-store/backends.lisp:1.10 cl-store/backends.lisp:1.11
--- cl-store/backends.lisp:1.10 Fri May 6 16:19:29 2005
+++ cl-store/backends.lisp Wed May 18 17:34:09 2005
@@ -14,6 +14,8 @@
(defclass backend ()
((name :accessor name :initform "Unknown" :initarg :name :type symbol)
(magic-number :accessor magic-number :initarg :magic-number :type integer)
+ (compatible-magic-numbers :accessor compatible-magic-numbers
+ :initarg :compatible-magic-numbers :type integer)
(old-magic-numbers :accessor old-magic-numbers :initarg :old-magic-numbers
:type cons)
(stream-type :accessor stream-type :initarg :stream-type :type (or symbol cons)
@@ -38,8 +40,7 @@
(defun backend-designator->backend (designator)
(check-type designator backend-designator)
(etypecase designator
- (symbol (or (find-backend designator)
- (error "~A does not designate a backend." designator)))
+ (symbol (find-backend designator t))
(backend designator)))
(defun get-store-macro (name)
@@ -65,12 +66,14 @@
(declare (ignorable ,gbackend ,gtype))
, at body)))))
-(defun register-backend (name class magic-number stream-type old-magic-numbers)
+(defun register-backend (name class magic-number stream-type old-magic-numbers
+ compatible-magic-numbers)
(declare (type symbol name))
(let ((instance (make-instance class
:name name
:magic-number magic-number
:old-magic-numbers old-magic-numbers
+ :compatible-magic-numbers compatible-magic-numbers
:stream-type stream-type)))
(if (assoc name *registered-backends*)
(cerror "Redefine backend" "Backend ~A is already defined." name)
@@ -86,7 +89,7 @@
(defmacro defbackend (name &key (stream-type ''(unsigned-byte 8))
(magic-number nil) fields (extends '(backend))
- (old-magic-numbers nil))
+ (old-magic-numbers nil) (compatible-magic-numbers nil))
"Defines a new backend called NAME. Stream type must be either 'char or 'binary.
FIELDS is a list of legal slots for defclass. MAGIC-NUMBER, when supplied, will
be written down stream as verification and checked on restoration.
@@ -99,15 +102,11 @@
,(get-store-macro name)
,(get-restore-macro name))
(register-backend ',name ',name ,magic-number
- ,stream-type ',old-magic-numbers)))
+ ,stream-type ',old-magic-numbers ',compatible-magic-numbers)))
(defmacro with-backend (backend &body body)
"Run BODY with *default-backend* bound to BACKEND"
- (with-gensyms (gbackend)
- `(let* ((,gbackend ,backend)
- (*default-backend* (or (backend-designator->backend ,gbackend)
- (error "~A is not a legal backend"
- ,gbackend))))
- , at body)))
+ `(let* ((*default-backend* (backend-designator->backend ,backend)))
+ , at body))
;; EOF
Index: cl-store/cl-store.asd
diff -u cl-store/cl-store.asd:1.29 cl-store/cl-store.asd:1.30
--- cl-store/cl-store.asd:1.29 Fri May 6 16:19:29 2005
+++ cl-store/cl-store.asd Wed May 18 17:34:09 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.5.12"
+ :version "0.5.15"
:description "Serialization package"
:long-description "Portable CL Package to serialize data"
:licence "MIT"
Index: cl-store/default-backend.lisp
diff -u cl-store/default-backend.lisp:1.28 cl-store/default-backend.lisp:1.29
--- cl-store/default-backend.lisp:1.28 Fri May 6 16:19:29 2005
+++ cl-store/default-backend.lisp Wed May 18 17:34:09 2005
@@ -4,8 +4,9 @@
;; The cl-store backend.
(in-package :cl-store)
-(defbackend cl-store :magic-number 1349740876
+(defbackend cl-store :magic-number 1414745155
:stream-type '(unsigned-byte 8)
+ :compatible-magic-numbers (1349740876)
:old-magic-numbers (1912923 1886611788 1347635532 1886611820
1884506444 1347643724 1349732684)
:extends (resolving-backend)
@@ -177,8 +178,8 @@
(handler-bind ((simple-error
#'(lambda (err)
(declare (ignore err))
- (awhen (cdr (assoc obj *special-floats*))
- (output-type-code it stream)
+ (when-let (type (cdr (assoc obj *special-floats*)))
+ (output-type-code type stream)
(return-from body)))))
(multiple-value-setq (significand exponent sign)
(integer-decode-float obj))
@@ -316,7 +317,7 @@
(store-object (hash-table-test obj) stream)
(store-object (hash-table-count obj) stream)
(loop for key being the hash-keys of obj
- for value being the hash-values of obj do
+ using (hash-value value) do
(store-object key stream)
(store-object value stream)))
@@ -349,7 +350,7 @@
(serializable-slots obj)))
(slots (if *store-class-slots*
all-slots
- (remove-if #'(lambda (x) (eql (slot-definition-allocation x)
+ (delete-if #'(lambda (x) (eql (slot-definition-allocation x)
:class))
all-slots))))
(declare (type list slots))
@@ -459,7 +460,7 @@
(dolist (x (multiple-value-list (array-displacement obj)))
(store-object x stream))
(store-object (array-total-size obj) stream)
- (loop for x from 0 to (1- (array-total-size obj)) do
+ (loop for x from 0 below (array-total-size obj) do
(store-object (row-major-aref obj x) stream)))
(defrestore-cl-store (array stream)
@@ -480,7 +481,7 @@
(adjust-array res dimensions :displaced-to displaced-to
:displaced-index-offset displaced-offset))
(resolving-object (obj res)
- (loop for x from 0 to (1- size) do
+ (loop for x from 0 below size do
(let ((pos x))
(setting (row-major-aref obj pos) (restore-object stream)))))))
@@ -488,10 +489,9 @@
(declare (optimize speed (safety 1) (debug 0))
(type simple-vector obj))
(output-type-code +simple-vector-code+ stream)
- (let ((size (length obj)))
- (store-object size stream)
- (loop for x across obj do
- (store-object x stream))))
+ (store-object (length obj) stream)
+ (loop for x across obj do
+ (store-object x stream)))
(defrestore-cl-store (simple-vector stream)
(declare (optimize speed (safety 1) (debug 0)))
@@ -508,7 +508,7 @@
;; Dumping (unsigned-byte 32) for each character seems
;; like a bit much when most of them will be
-;; standard-chars. So we try to cater for them.
+;; base-chars. So we try to cater for them.
(defvar *char-marker* (code-char 255)
"Largest character that can be represented in 8 bits")
Index: cl-store/plumbing.lisp
diff -u cl-store/plumbing.lisp:1.15 cl-store/plumbing.lisp:1.16
--- cl-store/plumbing.lisp:1.15 Thu May 5 14:58:54 2005
+++ cl-store/plumbing.lisp Wed May 18 17:34:09 2005
@@ -100,8 +100,8 @@
(defgeneric store-backend-code (backend stream)
(:method ((backend backend) (stream t))
(declare (optimize speed))
- (awhen (magic-number backend)
- (store-32-bit it stream)))
+ (when-let (magic (magic-number backend))
+ (store-32-bit magic stream)))
(:documentation
"Store magic-number of BACKEND, when present, into STREAM."))
@@ -166,8 +166,8 @@
(with-open-file (s place :element-type element-type :direction :input)
(backend-restore backend s))))
-(defun (setf restore) (new-val place)
- (store new-val place))
+(defun (setf restore) (new-val place &optional (backend *default-backend*))
+ (store new-val place backend))
(defgeneric check-magic-number (backend stream)
(:method ((backend backend) (stream t))
@@ -177,7 +177,9 @@
(let ((val (read-32-bit stream nil)))
(declare (type ub32 val))
(cond ((= val magic-number) nil)
- ((member val (old-magic-numbers backend) :test #'=)
+ ((member val (compatible-magic-numbers backend))
+ nil)
+ ((member val (old-magic-numbers backend))
(restore-error "Stream contains an object stored with an ~
incompatible version of backend ~A." (name backend)))
(t (restore-error "Stream does not contain a stored object~
Index: cl-store/tests.lisp
diff -u cl-store/tests.lisp:1.21 cl-store/tests.lisp:1.22
--- cl-store/tests.lisp:1.21 Fri May 6 16:19:29 2005
+++ cl-store/tests.lisp Wed May 18 17:34:09 2005
@@ -157,6 +157,8 @@
(deftestit symbol.3 :foo)
(deftestit symbol.4 'cl-store-tests::foo)
(deftestit symbol.5 'make-hash-table)
+(deftestit symbol.6 '|foo bar|)
+(deftestit symbol.7 'foo\ bar\ baz)
(deftest gensym.1 (progn
(store (gensym "Foobar") *test-file*)
Index: cl-store/utils.lisp
diff -u cl-store/utils.lisp:1.16 cl-store/utils.lisp:1.17
--- cl-store/utils.lisp:1.16 Thu May 5 14:58:54 2005
+++ cl-store/utils.lisp Wed May 18 17:34:09 2005
@@ -65,9 +65,10 @@
:type (slot-definition-type slot-definition)
:writers (slot-definition-writers slot-definition))))
-(defmacro awhen (test &body body)
- `(aif ,test
- (progn , at body)))
+(defmacro when-let ((var test) &body body)
+ `(let ((,var ,test))
+ (when ,var
+ , at body)))
;; because clisp doesn't have the class single-float or double-float.
@@ -145,5 +146,6 @@
(defun symbolicate (&rest syms)
"Concatenate all symbol names into one big symbol"
(values (intern (apply #'mkstr syms))))
+
;; EOF
More information about the Cl-store-cvs
mailing list