[cl-store-cvs] CVS cl-store
sross
sross at common-lisp.net
Tue Mar 14 09:34:09 UTC 2006
Update of /project/cl-store/cvsroot/cl-store
In directory clnet:/tmp/cvs-serv11996
Modified Files:
utils.lisp tests.lisp default-backend.lisp cl-store.asd
ChangeLog
Log Message:
Added custom structure object storing for OpenMCL
Thanks to Kilian Sprotte.
--- /project/cl-store/cvsroot/cl-store/utils.lisp 2005/11/30 09:49:56 1.20
+++ /project/cl-store/cvsroot/cl-store/utils.lisp 2006/03/14 09:34:09 1.21
@@ -12,9 +12,6 @@
`(let ,(mapcar #'(lambda (x) `(,x (gensym))) names)
, at body))
-(defun mappend (fn &rest lsts)
- (apply #'append (apply #'mapcar fn lsts)))
-
(defgeneric serializable-slots (object)
(declare (optimize speed))
(:documentation
@@ -23,7 +20,7 @@
and the objects class")
(:method ((object standard-object))
(serializable-slots-using-class object (class-of object)))
-#+(or sbcl cmu)
+#+(or sbcl cmu openmcl)
(:method ((object structure-object))
(serializable-slots-using-class object (class-of object)))
(:method ((object condition))
@@ -37,7 +34,7 @@
The default calls compute slots with class")
(:method ((object t) (class standard-class))
(compute-slots class))
-#+(or sbcl cmu)
+#+(or sbcl cmu openmcl)
(:method ((object t) (class structure-class))
(compute-slots class))
#+sbcl
@@ -54,8 +51,8 @@
(: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))
+ (:method ((slot-definition #+(or ecl (and clisp (not mop))) t
+ #-(or ecl (and clisp (not mop))) slot-definition))
(list :name (slot-definition-name slot-definition)
:allocation (slot-definition-allocation slot-definition)
:initargs (slot-definition-initargs slot-definition)
@@ -63,7 +60,18 @@
;; serialize functions
:readers (slot-definition-readers slot-definition)
:type (slot-definition-type slot-definition)
- :writers (slot-definition-writers slot-definition))))
+ :writers (slot-definition-writers slot-definition)))
+ #+openmcl
+ (:method ((slot-definition ccl::structure-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 when-let ((var test) &body body)
`(let ((,var ,test))
--- /project/cl-store/cvsroot/cl-store/tests.lisp 2005/09/09 14:59:17 1.25
+++ /project/cl-store/cvsroot/cl-store/tests.lisp 2006/03/14 09:34:09 1.26
@@ -330,11 +330,11 @@
(defstruct (b (:include a))
d e f)
-#+(or sbcl cmu lispworks)
+#+(or sbcl cmu lispworks openmcl)
(deftestit structure-object.1 (make-a :a 1 :b 2 :c 3))
-#+(or sbcl cmu lispworks)
+#+(or sbcl cmu lispworks openmcl)
(deftestit structure-object.2 (make-b :a 1 :b 2 :c 3 :d 4 :e 5 :f 6))
-#+(or sbcl cmu lispworks)
+#+(or sbcl cmu lispworks openmcl)
(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)))
--- /project/cl-store/cvsroot/cl-store/default-backend.lisp 2005/11/30 09:49:56 1.33
+++ /project/cl-store/cvsroot/cl-store/default-backend.lisp 2006/03/14 09:34:09 1.34
@@ -466,9 +466,11 @@
(meta (restore-object stream))
(keywords '(:direct-slots :direct-superclasses
:metaclass))
- (final (mappend #'list keywords (list slots
- (or supers (list 'standard-object))
- meta))))
+ (final (loop for keyword in keywords
+ for slot in (list slots
+ (or supers (list 'standard-object))
+ meta)
+ nconc (list keyword slot))))
(cond ((find-class class nil)
(cond (*nuke-existing-classes*
(apply #'ensure-class class final)
--- /project/cl-store/cvsroot/cl-store/cl-store.asd 2005/11/30 09:49:56 1.35
+++ /project/cl-store/cvsroot/cl-store/cl-store.asd 2006/03/14 09:34:09 1.36
@@ -9,13 +9,18 @@
(in-package #:cl-store.system)
+#-(or lispworks mcl cmu clisp sbcl allegro ecl openmcl)
+(error "This is an unsupported lisp implementation.
+Currently only MCL, OpenMCL, Lispworks, CMUCL, SBCL,
+CLISP, ECL and AllegroCL are supported.")
+
(defclass non-required-file (cl-source-file) ()
(:documentation
"File containing implementation dependent code which may or may not be there."))
(defun lisp-system-shortname ()
#+mcl :mcl #+lispworks :lispworks #+cmu :cmucl #+clisp :clisp #+sbcl :sbcl
- #+allegro :acl #+ecl :ecl)
+ #+allegro :acl #+ecl :ecl #+openmcl :openmcl)
(defmethod component-pathname ((component non-required-file))
(let ((pathname (call-next-method))
@@ -38,9 +43,9 @@
(defsystem cl-store
:name "CL-STORE"
- :author "Sean Ross <sdr at jhb.ucs.co.za>"
- :maintainer "Sean Ross <sdr at jhb.ucs.co.za>"
- :version "0.6.8"
+ :author "Sean Ross <sross at common-lisp.net>"
+ :maintainer "Sean Ross <sross at common-lisp.net>"
+ :version "0.6.9"
:description "Serialization package"
:long-description "Portable CL Package to serialize data"
:licence "MIT"
--- /project/cl-store/cvsroot/cl-store/ChangeLog 2005/11/30 09:49:56 1.38
+++ /project/cl-store/cvsroot/cl-store/ChangeLog 2006/03/14 09:34:09 1.39
@@ -1,3 +1,11 @@
+2006-03-13 Sean Ross <sross at common-lisp.net>
+ * utils.lisp, tests.lisp, openmcl/custom.lisp: Added
+ support for structure object storing for OpenMCL.
+ Thanks to Kilian Sprotte for the code.
+ * default-backend.lisp, utils.lisp: Changed creation
+ of class initargs to use loop instead of mappend.
+ Removed mappend.
+
2005-11-30 Sean Ross <sross at common-lisp.net>
* package.lisp: Added imports for MCL (from Gary King)
* backends.lisp: Changed definition of the defstore-? and
More information about the Cl-store-cvs
mailing list