[cl-store-cvs] CVS update: cl-store/xml-backend.lisp cl-store/test.lisp cl-store/plumbing.lisp cl-store/default-backend.lisp cl-store/backends.lisp cl-store/utils.lisp cl-store/tests.lisp cl-store/package.lisp cl-store/cl-store.asd cl-store/circularities.lisp cl-store/README cl-store/ChangeLog cl-store/.cvsignore cl-store/store.lisp cl-store/fast-io.lisp
Sean Ross
sross at common-lisp.net
Tue Aug 17 11:12:47 UTC 2004
Update of /project/cl-store/cvsroot/cl-store
In directory common-lisp.net:/tmp/cvs-serv9569
Modified Files:
utils.lisp tests.lisp package.lisp cl-store.asd
circularities.lisp README ChangeLog .cvsignore
Added Files:
xml-backend.lisp test.lisp plumbing.lisp default-backend.lisp
backends.lisp
Removed Files:
store.lisp fast-io.lisp
Log Message:
Changelog 2004-07-29
Date: Tue Aug 17 04:12:43 2004
Author: sross
Index: cl-store/utils.lisp
diff -u cl-store/utils.lisp:1.2 cl-store/utils.lisp:1.3
--- cl-store/utils.lisp:1.2 Fri May 21 07:14:40 2004
+++ cl-store/utils.lisp Tue Aug 17 04:12:43 2004
@@ -1,77 +1,27 @@
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;; See the file LICENCE for licence information.
+;; Miscellaneous utilities used throughout the package.
(in-package :cl-store)
-(defmacro aif (test conseq &optional (else nil))
+(declaim (optimize (speed 3) (safety 0) (debug 0)))
+
+
+
+(defmacro aif (test then &optional else)
`(let ((it ,test))
- (declare (ignorable it))
- (if it ,conseq
- (macrolet ((setf-it (val) (list 'setf ',test val)))
- ,else))))
+ (if it ,then ,else)))
(defmacro with-gensyms (names &body body)
`(let ,(mapcar #'(lambda (x) `(,x (gensym))) names)
- , at body))
+ , at body))
(defun mappend (fn &rest lsts)
(apply #'append (apply #'mapcar fn lsts)))
-(defvar *store-class-slots* t
- "Whether or not to serialize class allocation slots.")
-
-(defun object-slot-and-vals (object)
- "Create a plist containing slot names and values
-for all bound slots in OBJECT. If *store-class-slots* is not
-null then include slots which are class allocated."
- (remove-if
- #'null
- (mapcar #'(lambda (x)
- (let ((slot-name (slot-definition-name x)))
- (when (and (slot-boundp object slot-name)
- (or *store-class-slots*
- (and (not *store-class-slots*)
- (eq (slot-definition-allocation x)
- :class))))
- (list slot-name
- (slot-value object slot-name)))))
- (compute-slots (class-of object)))))
-
-
-(defun group (source n)
- "Group from Paul Graham's on Lisp."
- (declare (fixnum n))
- (if (zerop n) (error "N is zero, must be a positive fixnum."))
- (labels ((rec (source acc)
- (let ((rest (nthcdr n source)))
- (if (consp rest)
- (rec rest (cons (subseq source 0 n) acc))
- (nreverse (cons source acc))))))
- (rec source nil)))
-
-(defun group-array (values subscripts)
- "Group VALUES, a flattened list of array values, into a suitable
-list to be used as :initial-contents to make-array according to SUBSCRIPTS."
- (if (cdr subscripts)
- (group-array (group values (car subscripts)) (cdr subscripts))
- values))
-
-(defun get-array-values (array)
- "Returns a suitable list to be used for :initial-contents
-or :initial-element to make-array"
- (when (zerop (array-total-size array))
- (return-from get-array-values nil))
- (let ((val (loop for x from 0 to (1- (array-total-size array))
- collect (row-major-aref array x))))
- (declare (type list val))
- (if (every #'(lambda (x) (equal x (car val))) val)
- `(:initial-element ,(car val))
- `(:initial-contents ,(group-array
- val
- (nreverse (array-dimensions array)))))))
-
-
(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)
@@ -82,23 +32,20 @@
:writers (slot-definition-writers slot-definition)))
(defun get-class-details (x)
+ "Return a list of class details which can be
+ used as arguments to ensure-class"
(list (class-name x)
- (class-direct-default-initargs x)
+ ;; can't use this value either (see get-slot-details)
+ ;;(class-direct-default-initargs x)
(mapcar #'get-slot-details (class-direct-slots x))
(mapcar #'class-name
(class-direct-superclasses x))
(type-of x)))
-;; where this package seems to spend a large portion of its time
-(defun circular-listp (x)
- (handler-case (not (list-length x))
- (type-error (c) (declare (ignore c)) nil)))
-
-
(defmacro awhen (test &body body)
`(aif ,test
- (progn , at body)))
+ (progn , at body)))
;; because clisp doesn't have the class single-float or double-float.
@@ -114,4 +61,35 @@
(1 1.0d0)))
-;; EOF
+(defun store-32-byte (obj stream)
+ "Write OBJ down STREAM as a 32 byte integer."
+ (write-byte (ldb (byte 8 0) obj) stream)
+ (write-byte (ldb (byte 8 8) obj) stream)
+ (write-byte (ldb (byte 8 16) obj) stream)
+ (write-byte (+ 0 (ldb (byte 8 24) obj)) stream))
+
+
+(defun read-32-byte (buf &optional (signed t))
+ "Read a signed or unsigned byte off STREAM."
+ (let ((byte1 (read-byte buf))
+ (byte2 (read-byte buf))
+ (byte3 (read-byte buf))
+ (byte4 (read-byte buf)))
+ (declare (type (mod 256) byte1 byte2 byte3 byte4))
+ (let ((ret (+ byte1 (* 256 (+ byte2 (* 256 (+ byte3 (* 256 byte4))))))))
+ (if (and signed (> byte1 127))
+ (logior (ash -1 32) ret)
+ ret))))
+
+
+(defun store-string-code (string stream)
+ "Write length of STRING then STRING into stream"
+ (declare (type simple-string string))
+ (format stream "~S" string))
+
+(defun retrieve-string-code (stream)
+ "Retrieve a String written by store-string-code from STREAM"
+ (read stream))
+
+
+;; EOF
\ No newline at end of file
Index: cl-store/tests.lisp
diff -u cl-store/tests.lisp:1.3 cl-store/tests.lisp:1.4
--- cl-store/tests.lisp:1.3 Fri May 21 07:14:40 2004
+++ cl-store/tests.lisp Tue Aug 17 04:12:43 2004
@@ -8,7 +8,7 @@
(rem-all-tests)
-(defvar *test-file* "filetest.dat")
+(defvar *test-file* "filetest.cls")
(defun restores (val)
(store val *test-file*)
@@ -82,7 +82,8 @@
(deftestit vector.1 #(1 2 3 4))
-(deftestit vector.2 (make-array 5 :element-type 'fixnum :initial-contents (list 1 2 3 4 5)))
+(deftestit vector.2 (make-array 5 :element-type 'fixnum
+ :initial-contents (list 1 2 3 4 5)))
(deftestit vector.3
(make-array 5
@@ -109,8 +110,19 @@
(deftestit array.4
(make-array '(2 3 5)
:initial-contents
- '(((1 2 #\f 5 6) (#\Space "fpp" 4 1 0) ('d "foo" #() 3 -1))
- ((0 #\a #\b 4 #\q) (4 0 '(d) 4 1) (#\Newline 1 7 #\4 #\0)))))
+ '(((1 2 #\f 5 12.0) (#\Space "fpp" 4 1 0) ('d "foo" #() 3 -1))
+ ((0 #\a #\b 4 #\q) (12.0d0 0 '(d) 4 1)
+ (#\Newline 1 7 #\4 #\0)))))
+
+(deftestit array.5
+ (let* ((a1 (make-array 5))
+ (a2 (make-array 4 :displaced-to a1
+ :displaced-index-offset 1))
+ (a3 (make-array 2 :displaced-to a2
+ :displaced-index-offset 2)))
+ a3))
+
+
;; symbols
@@ -137,7 +149,8 @@
(deftestit hash.1 (make-hash-table))
(deftestit hash.2
- (let ((val #.(let ((in (make-hash-table :test #'equal :rehash-threshold 0.4 :size 20
+ (let ((val #.(let ((in (make-hash-table :test #'equal
+ :rehash-threshold 0.4 :size 20
:rehash-size 40)))
(dotimes (x 1000) (setf (gethash (format nil "~R" x) in) x))
in)))
@@ -148,43 +161,88 @@
(deftestit package.1 (find-package :cl-store))
-;; standard-object
-(defun object-equalp (obj1 obj2)
- (typecase obj1
- ((or standard-object condition)
- (equalp (cl-store::object-slot-and-vals obj1)
- (cl-store::object-slot-and-vals obj2)))
- (t (equalp obj1 obj2))))
+;; objects
(defclass foo ()
((x :accessor get-x :initarg :x)))
+
(defclass bar (foo)
((y :accessor get-y :initform nil :initarg :y)))
+(defclass quux ()
+ (a))
+
+(defclass baz (quux)
+ ((z :accessor get-z :initarg :z :allocation :class)))
+
+
+
(deftest standard-object.1
(let ((val (store (make-instance 'foo :x 3) *test-file*)))
- (object-equalp val (restore *test-file*)))
+ (= (get-x val) (get-x (restore *test-file*))))
t)
(deftest standard-object.2
(let ((val (store (make-instance 'bar
+ :x (list 1 "foo" 1.0)
:y (make-hash-table :test #'equal))
*test-file*)))
- (object-equalp val (restore *test-file*)))
+ (let ((ret (restore *test-file*)))
+ (and (equalp (get-x val) (get-x ret))
+ (equalp (get-y val) (get-y ret)))))
t)
-#-clisp
-(deftestit standard-class.1 (find-class 'foo))
-#-clisp
-(deftestit standard-class.2 (find-class 'bar))
+(deftest standard-object.3
+ (let ((*store-class-slots* nil)
+ (val (make-instance 'baz :z 9)))
+ (store val *test-file*)
+ (make-instance 'baz :z 2)
+ (= (get-z (restore *test-file*))
+ 2))
+ t)
+
+(deftest standard-object.4
+ (let ((*store-class-slots* t)
+ (val (make-instance 'baz :z 9)))
+ (store val *test-file*)
+ (make-instance 'baz :z 2)
+ (let ((ret (restore *test-file*)))
+ (= (get-z ret )
+ 9)))
+ t)
+
+
+;; classes
+(deftest standard-class.1 (progn (store (find-class 'foo) *test-file*)
+ (restore *test-file*)
+ t)
+ t)
+
+(deftest standard-class.2 (progn (store (find-class 'bar) *test-file*)
+ (restore *test-file*)
+ t)
+ t)
+
+(deftest standard-class.3 (progn (store (find-class 'baz) *test-file*)
+ (restore *test-file*)
+ t)
+ t)
;; conditions
(deftest condition.1
- (let ((val (handler-case (/ 1 0)
- (division-by-zero (c) (store c *test-file*)))))
- (object-equalp val (restore *test-file*)))
+ (handler-case (/ 1 0)
+ (division-by-zero (c)
+ (store c *test-file*)
+ (typep (restore *test-file*) 'division-by-zero)))
+ t)
+
+(deftest condition.2
+ (handler-case (car (read-from-string "3"))
+ (type-error (c)
+ (store c *test-file*)
+ (typep (restore *test-file*) 'type-error)))
t)
;; structure-object
@@ -195,11 +253,11 @@
(defstruct (b (:include a))
d e f)
-#-(or clisp lispworks)
+#+(or sbcl cmu)
(deftestit structure-object.1 (make-a :a 1 :b 2 :c 3))
-#-(or clisp lispworks)
+#+(or sbcl cmu)
(deftestit structure-object.2 (make-b :a 1 :b 2 :c 3 :d 4 :e 5 :f 6))
-#-(or clisp lispworks)
+#+(or sbcl cmu)
(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)))
@@ -211,7 +269,9 @@
(deftestit pathname.1 #P"/home/foo")
(deftestit pathname.2 (make-pathname :name "foo"))
-
+(deftestit pathname.3 (make-pathname :name "foo" :type "bar"
+ #-clisp :device #-clisp "foobar"
+ ))
;; circular objects
@@ -221,9 +281,9 @@
(let ((x (restore *test-file*)))
(eq (cddddr x) x)))
t)
-
+
(defvar circ2 (let ((x (list 2 3 4 4 5)))
- (setf (second x) x)))
+ (setf (second x) x)))
(deftest circ.2 (progn (store circ2 *test-file*)
(let ((x (restore *test-file*)))
(eq (second x) x)))
@@ -260,110 +320,141 @@
(gethash 'first x))))))
t)
-
-
-
-(defvar circ5 (let ((x (make-instance 'bar)))
- (setf (get-y x) x)
- x))
-
-(deftest circ.5 (progn (store circ5 *test-file*)
- (let ((x (restore *test-file*)))
- (eq x (get-y x))))
+(deftest circ.5 (let ((circ5 (make-instance 'bar)))
+ (setf (get-y circ5) circ5)
+ (store circ5 *test-file*)
+ (let ((x (restore *test-file*)))
+ (eq x (get-y x))))
t)
(defvar circ6 (let ((y (make-array '(2 2 2)
- :initial-contents '(((1 2) (3 4))
- ((5 6) (7 8)))
- :element-type 'integer)))
+ :initial-contents '((("foo" "bar")
+ ("me" "you"))
+ ((5 6) (7 8))))))
(setf (aref y 1 1 1) y)
+ (setf (aref y 0 0 0) (aref y 1 1 1))
y))
(deftest circ.6 (progn (store circ6 *test-file*)
(let ((x (restore *test-file*)))
- (eq (aref x 1 1 1) x)))
+ (and (eq (aref x 1 1 1) x)
+ (eq (aref x 0 0 0) (aref x 1 1 1)))))
t)
(defvar circ7 (let ((x (make-a)))
(setf (a-a x) x)))
-#-(or clisp lispworks)
+
+#+(or sbcl cmu)
(deftest circ.7 (progn (store circ7 *test-file*)
(let ((x (restore *test-file*)))
(eq (a-a x) x)))
t)
+(defvar circ.8 (let ((x "foo"))
+ (make-pathname :name x :type x)))
-(defvar *count* 1)
-(defvar *inc* 1)
-(defclass foobar ()())
-(defclass barfoo ()())
-
-(defstore (obj foobar buff :qualifier :before)
- (store-executable '(incf *count*) buff))
-
-(deftest executable.1
- (progn (store (make-instance 'foobar) *test-file*)
- (restore *test-file*)
- (= *count* (incf *inc*)))
+;; clisp apparently creates a copy of the strings in a pathname
+#-clisp
+(deftest circ.8 (progn (store circ.8 *test-file*)
+ (let ((x (restore *test-file*)))
+ (eq (pathname-name x)
+ (pathname-type x))))
t)
-(defvar *hash* (make-hash-table))
-
-
-(defstore (obj barfoo buff :qualifier :before)
- (store-executable `(let ((foo *hash*))
- (setf (gethash 1 foo)
- ,obj)
- (setf *hash* foo))
- buff))
-
-(deftest executable.2
- (progn (store (make-instance 'barfoo) *test-file*)
- (let ((x (restore *test-file*)))
- (eq x (gethash 1 *hash*))))
+(deftest circ.9 (let ((val #("foo" "bar" "baz" 1 2)))
+ (setf (aref val 3) val)
+ (setf (aref val 4) (aref val 0))
+ (store val *test-file*)
+ (let ((rest (restore *test-file*)))
+ (and (eq rest (aref rest 3))
+ (eq (aref rest 4) (aref rest 0)))))
+ t)
+
+(deftest circ.10 (let* ((a1 (make-array 5))
+ (a2 (make-array 4 :displaced-to a1
+ :displaced-index-offset 1))
+ (a3 (make-array 2 :displaced-to a2
+ :displaced-index-offset 2)))
+ (setf (aref a3 1) a3)
+ (store a3 *test-file*)
+ (let ((ret (restore *test-file*)))
+ (eq a3 (aref a3 1))))
+ t)
+
+(defvar circ.11 (let ((x (make-hash-table)))
+ (setf (gethash x x) x)
+ x))
+
+(deftest circ.11 (progn (store circ.11 *test-file*)
+ (let ((val (restore *test-file*)))
+ (eq val (gethash val val))))
+ t)
+
+(deftest circ.12 (let ((x #(1 2 "foo" 4 5)))
+ (setf (aref x 0) x)
+ (setf (aref x 1) (aref x 2))
+ (store x *test-file*)
+ (let ((ret (restore *test-file*)))
+ (and (eq (aref ret 0) ret)
+ (eq (aref ret 1) (aref ret 2)))))
+ t)
+
+(defclass foo.1 ()
+ ((a :accessor foo1-a)))
+
+;; a test from Robert Sedgwick which crashed in earlier
+;; versions (pre 0.2)
+(deftest circ.13 (let ((foo (make-instance 'foo.1))
+ (bar (make-instance 'foo.1)))
+ (setf (foo1-a foo) bar)
+ (setf (foo1-a bar) foo)
+ (store (list foo) *test-file*)
+ (let ((ret (car (restore *test-file*))))
+ (and (eq ret (foo1-a (foo1-a ret)))
+ (eq (foo1-a ret)
+ (foo1-a (foo1-a (foo1-a ret)))))))
t)
-(defclass foobarbaz () ((x :accessor x :initarg :x)))
+(defclass random-obj () ((size :accessor size :initarg :size)))
-(defstore (obj foobarbaz buff)
- (store-object (x obj) buff))
-
-;(defstore (obj foobarbaz buff :before)
-; (format t "Storing a foobarbaz object."))
-
-(defrestore (foobarbaz buff)
- (make-instance 'foobarbaz :x (restore-object buff)))
+(defvar *random-obj-code* (register-code 22 'random-obj))
+(defstore-cl-store (obj random-obj buff)
+ (output-type-code *random-obj-code* buff)
+ (store-object (size obj) buff))
-(deftest custom.1
- (progn (store (make-instance 'foobarbaz :x "foo") *test-file*)
- (equal "foo" (x (restore *test-file*))))
- t)
+(defrestore-cl-store (random-obj buff)
+ (random (restore-object buff)))
-(defclass random-obj () ((size :accessor size :initarg :size)))
-(defstore (obj random-obj buff :type-code 10232)
- (store-object (size obj) buff))
+(add-xml-mapping "RANDOM-OBJ")
+(defstore-xml (obj random-obj stream)
+ (princ-and-store "RANDOM-OBJ" (size obj) stream))
-(defrestore (random-obj buff)
- (random (restore-object buff)))
+(defrestore-xml (random-obj stream)
+ (random (restore-first stream)))
-(deftest custom.2
- (progn (store (make-instance 'random-obj :size 5) *test-file*)
+(deftest custom.1
+ (progn (store (make-instance 'random-obj :size 5) *test-file* )
(typep (restore *test-file*) '(integer 0 4)))
t)
(defun run-tests ()
- (regression-test:do-tests)
+ (format t "~&RUNNING TESTS USING CL-STORE-BACKEND~%")
+ (with-backend (cl-store)
+ (regression-test:do-tests))
+ (format t "~&RUNNING TESTS USING XML-BACKEND~%")
+ (with-backend (xml)
+ (regression-test:do-tests))
(when (probe-file *test-file*)
(delete-file *test-file*)))
Index: cl-store/package.lisp
diff -u cl-store/package.lisp:1.7 cl-store/package.lisp:1.8
--- cl-store/package.lisp:1.7 Sat Jun 5 04:56:42 2004
+++ cl-store/package.lisp Tue Aug 17 04:12:43 2004
@@ -1,119 +1,138 @@
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;; See the file LICENCE for licence information.
-
-(defpackage :cl-store
- (:use :cl)
- (:export :store
- :restore
- :defstore
- :defrestore
- :store-error
- :restore-error
- :internal-store-object
- :store-non-return
- :store-executable
- :store-object
- :restore-object
- :register-code
- :flush
- :fill-buffer
- :make-buffer
- :*full-write*
- :*store-class-slots*
- :*nuke-existing-classes*
- :*store-class-superclasses*)
- #+sbcl (:import-from :sb-mop
- slot-definition-name
- slot-value-using-class
- slot-boundp-using-class
- slot-definition-allocation
- compute-slots
- slot-definition-initform
- slot-definition-initargs
- slot-definition-name
- slot-definition-readers
- slot-definition-type
- slot-definition-writers
- class-direct-default-initargs
- class-direct-slots
- class-direct-superclasses
- class-slots
- ensure-class)
+(defpackage #:cl-store
+ (:use #:cl)
+ (:export #:backend
+ #:name
+ #:magic-number
+ #:stream-type
+ #:restorer-funs
+ #:restorers
+ #:find-backend
+ #:defbackend
+ #:with-backend
+ #:fix-circularities
+ #:*default-backend*
+ #:*cl-store-backend*
+ #:*current-backend*
+ #:*store-class-slots*
+ #:*nuke-existing-classes*
+ #:*store-class-superclasses*
+ #:store-error
+ #:restore-error
+ #:store
+ #:restore
+ #:backend-store
+ #:check-stream-element-type
+ #:store-backend-code
+ #:store-object
+ #:backend-store-object
+ #:get-class-details
+ #:get-array-values
+ #:restore
+ #:backend-restore
+ #:check-magic-number
+ #:get-next-reader
+ #:restore-object
+ #:backend-restore-object
+ #:cl-store
+ #:defstore-cl-store
+ #:defrestore-cl-store
+ #:register-code
+ #:output-type-code
+ #:xml)
+ #+sbcl (:import-from #:sb-mop
+ #:slot-definition-name
+ #:slot-value-using-class
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:compute-slots
+ #:slot-definition-initform
+ #:slot-definition-initargs
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-type
+ #:slot-definition-writers
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-superclasses
+ #:class-slots
+ #:ensure-class)
+
+ #+cmu (:import-from #:pcl
+ #:slot-definition-name
+ #:slot-value-using-class
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:compute-slots
+ #:slot-definition-initform
+ #:slot-definition-initargs
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-type
+ #:slot-definition-writers
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-superclasses
+ #:class-slots
+ #:ensure-class)
+
+ #+cmu (:shadowing-import-from #:pcl
+ #:class-name
+ #:find-class
+ #:standard-class
+ #:class-of)
+
+ #+openmcl (:import-from #:openmcl-mop
+ #:slot-definition-name
+ #:slot-value-using-class
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:compute-slots
+ #:slot-definition-initform
+ #:slot-definition-initargs
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-type
+ #:slot-definition-writers
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-superclasses
+ #:class-slots
+ #:ensure-class)
- #+cmu (:import-from :pcl
- slot-definition-name
- slot-value-using-class
- slot-boundp-using-class
- slot-definition-allocation
- compute-slots
- slot-definition-initform
- slot-definition-initargs
- slot-definition-name
- slot-definition-readers
- slot-definition-type
- slot-definition-writers
- class-direct-default-initargs
- class-direct-slots
- class-direct-superclasses
- class-slots
- ensure-class)
+ #+clisp (:import-from #:clos
+ #:slot-value
+ #:std-compute-slots
+ #:slot-boundp
+ #:class-name
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-slots
+ #:ensure-class)
- #+cmu (:shadowing-import-from :pcl
- class-name
- find-class
- standard-class
- class-of)
-
- #+openmcl (:import-from :openmcl-mop
- slot-definition-name
- slot-value-using-class
- slot-boundp-using-class
- slot-definition-allocation
- compute-slots
- slot-definition-initform
- slot-definition-initargs
- slot-definition-name
- slot-definition-readers
- slot-definition-type
- slot-definition-writers
- class-direct-default-initargs
- class-direct-slots
- class-direct-superclasses
- class-slots
- ensure-class)
-
- #+clisp (:import-from :clos
- slot-value
- std-compute-slots
- slot-boundp
- class-name
- class-direct-default-initargs
- class-direct-slots
- class-slots
- ensure-class)
-
- #+lispworks (:import-from :clos
- slot-definition-name
- slot-value-using-class
- slot-boundp-using-class
- slot-definition-allocation
- compute-slots
- slot-definition-initform
- slot-definition-initargs
- slot-definition-name
- slot-definition-readers
- slot-definition-type
- slot-definition-writers
- class-direct-default-initargs
- class-direct-slots
- class-slots
- class-direct-superclasses
- ensure-class))
+ #+lispworks (:import-from #:clos
+ #:slot-definition-name
+ #:slot-value-using-class
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:compute-slots
+ #:slot-definition-initform
+ #:slot-definition-initargs
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-type
+ #:slot-definition-writers
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-slots
+ #:class-direct-superclasses
+ #:ensure-class))
;; package used to unclutter cl-store by holding all %referrer symbols.
-(defpackage :cl-store-referrers)
+(defpackage #:cl-store-referrers)
-;; EOF
+;; EOF
\ No newline at end of file
Index: cl-store/cl-store.asd
diff -u cl-store/cl-store.asd:1.4 cl-store/cl-store.asd:1.5
--- cl-store/cl-store.asd:1.4 Fri Jun 4 06:55:33 2004
+++ cl-store/cl-store.asd Tue Aug 17 04:12:43 2004
@@ -1,11 +1,12 @@
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;; See the file LICENCE for licence information.
+(in-package #:cl-user)
-(defpackage :cl-store.system
- (:use :cl :asdf))
+(defpackage #:cl-store.system
+ (:use #:cl #:asdf))
-(in-package :cl-store.system)
+(in-package #:cl-store.system)
(defclass non-required-file (cl-source-file) ()
(:documentation
@@ -35,33 +36,44 @@
(defsystem cl-store
- :name "Store"
+ :name "CL-STORE"
:author "Sean Ross <sdr at jhb.ucs.co.za>"
:maintainer "Sean Ross <sdr at jhb.ucs.co.za>"
- :version "0.1.3"
+ :version "0.2"
:description "Serialization package"
:long-description "Portable CL Package to serialize data types"
:licence "MIT"
:components ((:file "package")
- (:file "fast-io" :depends-on ("package"))
- (:file "utils" :depends-on ("fast-io"))
(:non-required-file "fix-clisp" :depends-on ("package"))
- (:file "circularities" :depends-on ("utils"))
- (:file "store" :depends-on ("circularities"))
- (:non-required-file "sockets" :depends-on ("store")))
- :depends-on (#+sbcl :sb-bsd-sockets))
+ (:file "utils" :depends-on ("package"))
+ (:file "backends" :depends-on ("utils"))
+ (:file "plumbing" :depends-on ("backends"))
+ (:file "circularities" :depends-on ("plumbing"))
+ (:file "default-backend" :depends-on ("circularities"))))
+
+(defsystem cl-store-xml
+ :name "CL-STORE-XML"
+ :author "Sean Ross <sdr at jhb.ucs.co.za>"
+ :maintainer "Sean Ross <sdr at jhb.ucs.co.za>"
+ :description "Xml Backend for cl-store"
+ :licence "MIT"
+ :components ((:file "xml-backend"))
+ :depends-on (:cl-store :xmls))
(defmethod perform :after ((o load-op) (c (eql (find-system :cl-store))))
(provide 'cl-store))
+(defmethod perform :after ((o load-op) (c (eql (find-system :cl-store-xml))))
+ (provide 'cl-store-xml))
+
(defmethod perform ((op test-op) (sys (eql (find-system :cl-store))))
(oos 'load-op :cl-store-tests)
(oos 'test-op :cl-store-tests))
(defsystem cl-store-tests
- :depends-on (rt)
+ :depends-on (rt cl-store cl-store-xml)
:components ((:file "tests")))
(defmethod perform ((op test-op) (sys (eql (find-system :cl-store-tests))))
@@ -69,4 +81,4 @@
(error "Test-op Failed.")))
-;; EOF
+;; EOF
\ No newline at end of file
Index: cl-store/circularities.lisp
diff -u cl-store/circularities.lisp:1.4 cl-store/circularities.lisp:1.5
--- cl-store/circularities.lisp:1.4 Fri Jun 4 06:55:33 2004
+++ cl-store/circularities.lisp Tue Aug 17 04:12:43 2004
@@ -1,155 +1,216 @@
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;; See the file LICENCE for licence information.
-(in-package :cl-store)
-
-(defvar *referrer-string* "%REFERRER-")
-(defvar *stored-values* nil)
-(declaim (type fixnum *stored-counter*))
-(defvar *stored-counter* 0)
-(defvar *seen-while-fixing* nil)
+;; Defines a special backend type which specializes various methods
+;; in plumbing.lisp to make it nice and easy to
+;; resolve possible circularities in objects.
+;; Most of the work is done using the resolving-object
+;; macro which knows how to handle an object which
+;; is a referrer to a previously restored value.
+;; Backends wanting to make use of this should take
+;; a look at default-backend.lisp and xml-backend.lisp
+;; paying special attention to the defbackend form and the
+;; defrestore definitions for cons, array, simple-vector
+;; array and hash-table.
+;;
+;; As a note this will ignore integers, symbols or characters
+;; as referrer values. It will handle all other EQ number although
+;; software depending on eq numbers are not conforming
+;; programs according to the Hyperspec(notes in EQ).
+(in-package :cl-store)
+(declaim (optimize (speed 3) (safety 0) (debug 0)))
-(defun referrerp (sym)
- (and (symbolp sym)
- (eq (symbol-package sym) #.(find-package :cl-store-referrers))
- (equal (subseq (symbol-name sym) 0 10)
+(defvar *referrer-string* "%%Referrer-"
+ "String which will be interned to create a symbol we
+ can recognize as a referrer.")
+
+(defvar *prefix-setters*
+ '(slot-value aref row-major-aref)
+ "Setfable places which take the object to set before the
+ rest of the arguments.")
+
+(defun get-setf-place (place obj)
+ "Return a legal setf form for setting PLACE in OBJ, see *prefix-setters*."
+ (declare (type (or cons symbol) place))
+ (cond ((atom place) `(,place ,obj))
+ ((member (car place) *prefix-setters*)
+ `(,(car place) ,obj ,@(cdr place)))
+ (t `(, at place ,obj))))
+
+
+;; The definitions for setting and setting-hash sits in resolving-object.
+(defmacro setting (place get)
+ "Resolve the possible referring object retrieved by GET and
+ set it into PLACE. Only usable within a resolving-object form."
+ (declare (ignore place get))
+ (error "setting can only be used inside a resolving-object form."))
+
+(defmacro setting-hash (getting-key getting-value)
+ "Insert the value retrieved by GETTING-VALUE with the key
+ retrieved by GETTING-KEY, resolving possible circularities.
+ Only usable within a resolving-object form."
+ (declare (ignore getting-key getting-value))
+ (error "setting-hash can only be used inside a resolving-object form."))
+
+
+(defmacro resolving-object (create &body body)
+ "Execute body attempting to resolve circularities found in
+ form CREATE."
+ (with-gensyms (obj value key)
+ `(macrolet ((setting (place getting)
+ (let ((setf-place (get-setf-place place ',obj)))
+ `(let ((,',value ,getting))
+ (if (referrerp ,',value)
+ (push (lambda ()
+ (setf ,setf-place
+ (referred-value ,',value
+ *restored-values*)))
+ *need-to-fix*)
+ (setf ,setf-place ,',value)))))
+ (setting-hash (getting-key getting-place)
+ `(let ((,',key ,getting-key))
+ (if (referrerp ,',key)
+ (let ((,',value ,getting-place))
+ (push (lambda ()
+ (setf (gethash
+ (referred-value ,',key *restored-values*)
+ ,',obj)
+ (if (referrerp ,',value)
+ (referred-value ,',value
+ *restored-values*)
+ ,',value)))
+ *need-to-fix*))
+ (setting (gethash ,',key) ,getting-place)))))
+ (let ((,obj ,create))
+ , at body
+ ,obj))))
+
+(defun referrerp (val)
+ "Is val a referrer?"
+ (and (symbolp val)
+ (eq (symbol-package val) #.(find-package :cl-store-referrers))
+ (equal (subseq (symbol-name val) 0 11)
*referrer-string*)))
(defun referred-value (referrer hash)
- (gethash (read-from-string (subseq (symbol-name referrer) 10))
+ "Return the value REFERRER is meant to be by looking in HASH."
+ (gethash (read-from-string (subseq (symbol-name referrer) 11))
hash))
-(defgeneric inner-fix-circularities (hash obj))
+(defun make-referrer (x)
+ "Create a new referrer suffixed with X."
+ (declare (type fixnum x))
+ (let ((name (intern (format nil "%%Referrer-~D" x)
+ :cl-store-referrers)))
+ name))
-(defun fix-circularities (val1 val2 )
- (aif (gethash val2 *seen-while-fixing*)
- nil
- (progn (setf (gethash val2 *seen-while-fixing*) t)
- (inner-fix-circularities val1 val2))))
-
-
-;; hash tables and objects require some extra fiddling.
-(defmethod inner-fix-circularities ((hash hash-table) (obj hash-table))
- (fix-circularities hash nil)
- (loop for key being the hash-keys of obj
- for val being the hash-values of obj do
- (fix-circularities hash key)
- (fix-circularities hash val)
- (when (referrerp val)
- (setf (gethash key obj)
- (referred-value val hash)))))
-
-(defmethod inner-fix-circularities ((hash hash-table) (obj standard-class))
- nil)
-
-
-(defmethod inner-fix-circularities ((hash hash-table) (obj standard-object))
- (fix-circularities hash nil)
- (dolist (slot (mapcar #'slot-definition-name
- (class-slots (class-of obj))))
- (when (slot-boundp obj slot)
- (fix-circularities hash (slot-value obj slot))
- (when (referrerp (slot-value obj slot))
- (setf (slot-value obj slot)
- (referred-value (slot-value obj slot) hash))))))
-
-(defmethod inner-fix-circularities ((hash hash-table) (obj structure-object))
- (fix-circularities hash nil)
- (dolist (slot (mapcar #'slot-definition-name
- (class-slots (class-of obj))))
- (when (slot-boundp obj slot)
- (fix-circularities hash (slot-value obj slot))
- (when (referrerp (slot-value obj slot))
- (setf (slot-value obj slot)
- (referred-value (slot-value obj slot) hash))))))
-
-
-(defmethod inner-fix-circularities ((hash hash-table) obj)
- (loop for counter from 1 to (hash-table-count hash) do
- (let ((ref (gethash counter hash))
- changed)
- (when (referrerp ref)
- (setf (gethash counter hash)
- (referred-value ref hash)))
- (awhen (and (or (typep ref 'sequence)
- (arrayp ref))
- (pos-of ref))
- (cond
- ((eq it :last)
- (setf changed t)
- (setf (cdr (last ref))
- (referred-value (cdr (last ref)) hash)))
- ((and (listp ref) (numberp it))
- (setf changed t)
- (setf (nth it ref)
- (referred-value (nth it ref) hash)))
- ((and (arrayp ref) (numberp it))
- (setf changed t)
- (setf (row-major-aref ref it)
- (referred-value (row-major-aref ref it) hash)))
- (t nil)))
- (when changed
- ;; lets be sure.
- (fix-circularities hash obj)))))
-
-
-(defun ref-name (x)
- (intern (format nil "%REFERRER-~D" x)
- :cl-store-referrers))
-
-
-(defun pos-of (sequence)
- "Like position but it doens't choke on dotted lists"
- (when (and (listp sequence)
- (circular-listp sequence))
- (return-from pos-of nil))
- (labels ((inner (sequence counter)
- (cond ((atom sequence)
- (when (referrerp sequence)
- :last))
- ((referrerp (car sequence))
- counter)
- (t (inner (cdr sequence) (1+ counter)))))
- (inner-array ()
- (loop for x from 0 upto (1- (array-total-size sequence)) do
- (if (referrerp (row-major-aref sequence x))
- (return-from inner-array x)))))
- (cond ((and (listp sequence)
- (atom (cdr (last sequence))))
- (inner sequence 0))
- ((vectorp sequence)
- (position-if #'referrerp sequence))
- ((arrayp sequence)
- (inner-array)))))
-;; storing already seen objects
+(defclass resolving-backend (backend)
+ ()
+ (:documentation "A backend which does the setup for resolving circularities."))
+
+(declaim (type fixnum *stored-counter*))
+(defvar *stored-counter*)
+(defvar *stored-values*)
+
+(defmethod backend-store ((obj t) (place t) (backend resolving-backend))
+ "Store OBJ into PLACE. Does the setup for counters and seen values."
+ (let ((*stored-counter* 0)
+ (*stored-values* (make-hash-table :test #'eq)))
+ (check-stream-element-type place backend)
+ (store-backend-code place backend)
+ (backend-store-object obj place backend)
+ obj))
(defun seen (obj)
+ "Has this object already been stored?"
+ (incf *stored-counter*)
(gethash obj *stored-values*))
(defun update-seen (obj)
- (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))
- (setf (gethash obj *stored-values*) (incf *stored-counter*))
+ "Register OBJ as having been stored."
+ (setf (gethash obj *stored-values*) *stored-counter*)
obj)
+(deftype not-circ ()
+ "Type grouping integer, characters and symbols, which we
+ don't bother to check if they have been stored before"
+ '(or integer character symbol))
+
(defun needs-checkp (obj)
- (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))
- (not (or (typep obj 'integer)
- (symbolp obj)
- (characterp obj))))
-
-;; instead of constructing symbols here we rather
-;; just return a second value indicating we have
-;; seen this object before and avoid interning unnecessary symbols
-(defun real-value (obj)
- (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))
+ "Do we need to check if this object has been stored before?"
+ (not (typep obj 'not-circ)))
+
+(defun value-or-referrer (obj)
+ "Returns the number of the referrer and t if this object
+ has already been stored in this STORE call."
(if (needs-checkp obj)
(aif (seen obj)
(values it t)
(values (update-seen obj) nil))
obj))
-;; EOF
+(defgeneric store-referrer (obj place backend)
+ (:documentation "Store the number OBJ into PLACE as a referrer for BACKEND.")
+ (:method ((obj t) (place t) (backend resolving-backend))
+ (store-error "store-referrer must be specialized for backend ~(~A~)."
+ (name backend))))
+
+(defmethod backend-store-object ((obj t) (place t) (backend resolving-backend))
+ "Store object if we have not seen this object before, otherwise retrieve
+ the referrer object for it and store that using store-referrer."
+ (multiple-value-bind (obj referrerp) (value-or-referrer obj)
+ (if referrerp
+ (store-referrer obj place backend)
+ (internal-store-object obj place backend))))
+
+
+
+;; Restoration.
+(declaim (type fixnum *restore-counter*))
+(defvar *restore-counter*)
+(defvar *need-to-fix*)
+(defvar *restored-values*)
+
+(defmethod backend-restore ((place stream) (backend resolving-backend))
+ "Restore an object from PLACE using BACKEND. Does the setup for
+ various variables used by resolving-object."
+ (let ((*restore-counter* 0)
+ (*need-to-fix* nil)
+ (*restored-values* (make-hash-table)))
+ (check-stream-element-type place backend)
+ (check-magic-number place backend)
+ (let ((obj (backend-restore-object place backend)))
+ (dolist (fn *need-to-fix*)
+ (funcall (the function fn)))
+ obj)))
+
+(defmethod backend-restore-object ((place t) (backend resolving-backend))
+ "Retrieve a object from PLACE, does housekeeping for circularity fixing."
+ (let ((reader (find-function-for-type place backend)))
+ (if (not (int-sym-or-char-p reader backend))
+ (setf (gethash (incf *restore-counter*) *restored-values*)
+ (new-val (funcall (the function reader) place)))
+ (funcall (the function reader) place))))
+
+(defun int-sym-or-char-p (fn backend)
+ "Is function FN registered to restore an integer, character or symbol
+ in BACKEND."
+ (let ((readers (restorer-funs backend)))
+ (or (eq fn (lookup-reader 'integer readers))
+ (eq fn (lookup-reader 'character readers))
+ (eq fn (lookup-reader 'symbol readers)))))
+
+
+(defun new-val (val)
+ "Tries to get a referred value to reduce unnecessary cirularity fixing."
+ (if (referrerp val)
+ (aif (referred-value val *restored-values*)
+ it
+ val)
+ val))
+
+;; EOF
\ No newline at end of file
Index: cl-store/README
diff -u cl-store/README:1.3 cl-store/README:1.4
--- cl-store/README:1.3 Sat Jun 5 04:56:42 2004
+++ cl-store/README Tue Aug 17 04:12:43 2004
@@ -1,6 +1,7 @@
-Readme for Package CL-STORE.
+README for Package CL-STORE.
Author: Sean Ross
Homepage: http://www.common-lisp.net/project/cl-store/
+Version: 0.2
0. About.
CL-STORE is an portable serialization package which
@@ -9,29 +10,36 @@
1. Installation.
- The first thing you need is a common-lisp, CL-STORE currently
- supports SBCL, CMUCL, Lispworks and CLISP.
+ The first thing you need is a common-lisp, CL-STORE currently
+ supports SBCL, CMUCL, Lispworks, CLISP and OpenMCL.
- Hopefully you've asdf-install to install this in which case
- all should be fine.
+ Hopefully you've asdf-install to install this in which case
+ all should be fine.
- Otherwise symlink cl-store.asd to somewhere on asdf:*central-registry*
- and run (asdf:oos 'asdf:load-op :cl-store).
+ Otherwise symlink cl-store.asd to somewhere on asdf:*central-registry*
+ and run (asdf:oos 'asdf:load-op :cl-store).
- Run (asdf:oos 'asdf:test-op :cl-store) to make sure that
- everything works. Running these tests will try to
- load the RT package, which is asdf-installable.
- If anything breaks drop me a line, see
- http://www.common-lisp.net/project/cl-store/ for mailing-lists.
+ The xml backend can be loaded with (asdf:oos 'asdf:loaded :cl-store-xml).
+ This requires xmls which can be found on http://www.cliki.net and
+ is asdf-installable.
+
+ Run (asdf:oos 'asdf:test-op :cl-store) to make sure that
+ everything works. Running these tests will try to
+ load the RT package, which is asdf-installable.
+ If anything breaks drop me a line, see
+ http://www.common-lisp.net/project/cl-store/ for mailing-lists.
2. Usage
The two main entry points are
- - cl-store:store obj place => obj
- Where place is a path designator, stream or socket.
-
- - cl-store:restore place => restored-obj
- Where place is as above.
+ - cl-store:store (obj place &optional (backend *default-backend*)) i
+ => obj
+ Where place is a path designator, stream or socket and
+ backend is one of the registered backend.
+
+ - cl-store:restore (place &optional (backend *default-backend*))
+ => restored-obj
+ Where place and backend is as above.
- cl-store:restore is setfable, which I think makes
for a great serialized hit counter.
@@ -39,43 +47,54 @@
3. Extending
- CL-STORE is more or less extensible. Using defstore and defrestore
- allows you to customize the storing and restoring of your own classes.
+ CL-STORE is more or less extensible. Using defstore-<backend-name>
+ and defrestore-<backend-name> allows you to customize the storing
+ and restoring of your own classes.
+
contrived eg.
-
- (defclass random () ((a :accessor a :initarg :a)))
- (defstore (obj random buffer)
- (store-object (a obj) buffer))
+ (in-package :cl-user)
+
+ (use-package :cl-store)
+
+ (defclass random-obj () ((a :accessor a :initarg :a)))
+
+ (defvar *random-obj-code* (register-code 22 'random-obj))
- (defrestore (random buff)
- (random (restore-object buff)))
+ (defstore-cl-store (obj random-obj stream)
+ (output-type-code *random-obj-code* stream)
+ (store-object (a obj) stream))
- (store (make-instance 'random :a 10) "/tmp/random")
+ (defrestore-cl-store (random-obj stream)
+ (random (restore-object stream)))
+
+ (store (make-instance 'random-obj :a 10) "/tmp/random")
(restore "/tmp/random")
=> ; some number from 0 to 9
+
+
+4. Backends
+ CL-STORE now has a concept of backends, suggested by Robert Sedgewick.
+ Two backends are in releases now, a default backend which is much
+ what cl-store used to be (pre 0.2) and an xml backend which writes out
+ xml to character streams.
+ Store and Restore now take an optional backend argument which
+ currently can be one of *default-backend* or *xml-backend*.
+
+ The xml written out is not very human readable.
+ I recommend using a tool like tidy <http://tidy.sourceforge.net/>
+ to view it in a nice format.
+
-
-4. Issues
- There are a number of issues with CL-STORE as it stands (0.1.3).
+5. Issues
+ There are a number of issues with CL-STORE as it stands (0.2).
- 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 definitions aren't supported at all.
- - The code for resolving object circularities is a touch dodgy,
- hopefully a better way will be found at some point.
- No documentation.
- - CL-STORE uses read-sequence to pull values out of streams. Unfortunately
- read-sequence doesn't just block but waits until the entire
- buffer is filled. As a quick workaround the evil variable *full-write*
- was created to force write-sequence to write the entire buffer
- down the stream. Setting this to nil is a good idea if you are
- working with file streams. If you are working with streams
- created from sockets DO NOT set *full-write* to nil as this
- will invariably hang. This has been resolved for SBCL and
- you can store and restore objects directly to and from sockets.
- Older cmucl versions, where (eq 'cl:class 'pcl::class)
returns nil, cannot store classes obtained using cl:find-class.
The solution for this is to use pcl::find-class.
@@ -83,5 +102,3 @@
Enjoy
Sean.
-
-
Index: cl-store/ChangeLog
diff -u cl-store/ChangeLog:1.4 cl-store/ChangeLog:1.5
--- cl-store/ChangeLog:1.4 Fri Jun 4 06:55:33 2004
+++ cl-store/ChangeLog Tue Aug 17 04:12:43 2004
@@ -1,22 +1,36 @@
+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.
+ * backends.lisp: New file for creating backends (Idea from Robert Sedgewick).
+ * circularities.lisp: Much changes, now works properly.
+ * default-backend.lisp: New file contains storing definitions
+ from store.lisp. Changes to simple-string storing, magic-number changed.
+ * plumbing.lisp: New file, framework stuff.
+ * xml-backend.lisp: New file. New backend for writing out Common-Lisp
+ objects in xml format.
+ * tests.lisp : More and more tests.
+
2004-06-04 Sean Ross <sdr at jhb.ucs.co.za>
- * circularities.lisp: spelling fix.
- * cl-store.asd: Specialized operation-done-p to stop some errors.
- * package.lisp: Imports for openmcl from Robert Sedgewick,
- Along with extra imports for cmucl.
+ * circularities.lisp: spelling fix.
+ * cl-store.asd: Specialized operation-done-p to stop some errors in asdf.
+ * package.lisp: Imports for openmcl from Robert Sedgewick,
+ Along with extra imports for cmucl.
2004-05-21 Sean Ross <sdr at jhb.ucs.co.za>
- * store.lisp, fix-clisp.lisp, circularities.lisp, package.lisp
- tests.lisp, utils.lisp, cl-store.asd:
- Added ability to specify the type code of an object
- when using defstore. Added code to autogenerate the
- accessor methods for CLISP when restoring classes.
- EQ floats are now restored correctly.
+ * store.lisp, fix-clisp.lisp, circularities.lisp, package.lisp,
+ tests.lisp, utils.lisp, cl-store.asd:
+ Added ability to specify the type code of an object
+ when using defstore. Added code to autogenerate the
+ accessor methods for CLISP when restoring classes.
+ EQ floats are now restored correctly.
+
2004-05-18 Sean Ross <sdr at jhb.ucs.co.za>
- * store.lisp, fix-clisp.lisp, sbcl/sockets.lisp:
- Added fix for sbcl to use non-blocking IO when working with sockets.
- Created directory structure and moved fix-clisp
+ * store.lisp, fix-clisp.lisp, sbcl/sockets.lisp:
+ Added fix for sbcl to use non-blocking IO when working with sockets.
+ Created directory structure and moved fix-clisp
2004-05-17 Sean Ross <sdr at jhb.ucs.co.za>
* store.lisp, fast-io.lisp, circularities.lisp, package.lisp,
- fix-clisp.lisp, utils.lisp, cl-store.asd, tests.lisp:
- Initial import
+ fix-clisp.lisp, utils.lisp, cl-store.asd, tests.lisp:
+ Initial import
Index: cl-store/.cvsignore
diff -u cl-store/.cvsignore:1.1.1.1 cl-store/.cvsignore:1.2
--- cl-store/.cvsignore:1.1.1.1 Mon May 17 08:41:19 2004
+++ cl-store/.cvsignore Tue Aug 17 04:12:43 2004
@@ -1,6 +1,6 @@
*.fasl
*.x86f
*.ufsl
-filetest.dat
+filetest.cls
*.fas
*.lib
More information about the Cl-store-cvs
mailing list