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) ,@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@jhb.ucs.co.za" - :maintainer "Sean Ross sdr@jhb.ucs.co.za" - :version "0.6.8" + :author "Sean Ross sross@common-lisp.net" + :maintainer "Sean Ross sross@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@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@common-lisp.net * package.lisp: Added imports for MCL (from Gary King) * backends.lisp: Changed definition of the defstore-? and