From sross at common-lisp.net Tue Mar 14 09:31:02 2006 From: sross at common-lisp.net (sross) Date: Tue, 14 Mar 2006 04:31:02 -0500 (EST) Subject: [cl-store-cvs] CVS cl-store/openmcl Message-ID: <20060314093102.8A1857B019@common-lisp.net> Update of /project/cl-store/cvsroot/cl-store/openmcl In directory clnet:/tmp/cvs-serv11965/openmcl Log Message: Directory /project/cl-store/cvsroot/cl-store/openmcl added to the repository From sross at common-lisp.net Tue Mar 14 09:34:08 2006 From: sross at common-lisp.net (sross) Date: Tue, 14 Mar 2006 04:34:08 -0500 (EST) Subject: [cl-store-cvs] CVS cl-store/openmcl Message-ID: <20060314093408.E28EC7B019@common-lisp.net> Update of /project/cl-store/cvsroot/cl-store/openmcl In directory clnet:/tmp/cvs-serv11996/openmcl Added Files: custom.lisp Log Message: Added custom structure object storing for OpenMCL Thanks to Kilian Sprotte. --- /project/cl-store/cvsroot/cl-store/openmcl/custom.lisp 2006/03/14 09:34:08 NONE +++ /project/cl-store/cvsroot/cl-store/openmcl/custom.lisp 2006/03/14 09:34:08 1.1 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;; See the file LICENCE for licence information. (in-package :cl-store) (defstore-cl-store (obj structure-object stream) (output-type-code +structure-object-code+ stream) (store-type-object obj stream)) (defrestore-cl-store (structure-object stream) (restore-type-object stream)) ; EOF From sross at common-lisp.net Tue Mar 14 09:34:09 2006 From: sross at common-lisp.net (sross) Date: Tue, 14 Mar 2006 04:34:09 -0500 (EST) Subject: [cl-store-cvs] CVS cl-store Message-ID: <20060314093409.3FE0D7B019@common-lisp.net> 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 " - :maintainer "Sean Ross " - :version "0.6.8" + :author "Sean Ross " + :maintainer "Sean Ross " + :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 + * 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 * package.lisp: Added imports for MCL (from Gary King) * backends.lisp: Changed definition of the defstore-? and From sross at common-lisp.net Tue Mar 14 10:58:59 2006 From: sross at common-lisp.net (sross) Date: Tue, 14 Mar 2006 05:58:59 -0500 (EST) Subject: [cl-store-cvs] CVS cl-store/sbcl Message-ID: <20060314105859.518294E005@common-lisp.net> Update of /project/cl-store/cvsroot/cl-store/sbcl In directory clnet:/tmp/cvs-serv22833/sbcl Modified Files: custom.lisp Log Message: Fixed structure definition storing for more recent sbcl versions. --- /project/cl-store/cvsroot/cl-store/sbcl/custom.lisp 2005/10/04 08:14:02 1.10 +++ /project/cl-store/cvsroot/cl-store/sbcl/custom.lisp 2006/03/14 10:58:59 1.11 @@ -101,11 +101,36 @@ (funcall (compile nil `(lambda () ,@(sbcl-struct-defs dd)))) (find-class (dd-name dd))) +;; From 0.9.6.25 sb-kernel::%defstruct +;; takes a source location as a third argument. +(eval-when (:compile-toplevel) + (labels ((make-version (string) + (map-into (make-list 4 :initial-element 0) + #'parse-integer + (asdf::split string nil '(#\.)))) + (version>= (v1 v2) + (loop for x in (make-version v1) + for y in (make-version v2) + when (> x y) :do (return t) + when (> y x) :do (return nil) + finally (return t)))) + (when (version>= (lisp-implementation-version) + "0.9.6.25") + (pushnew :defstruct-has-source-location *features*)))) + +asdf::version-satisfies +(defun sb-kernel-defstruct (dd supers source) + (declare (ignorable source)) + #+defstruct-has-source-location + (sb-kernel::%defstruct dd supers source) + #-defstruct-has-source-location + (sb-kernel::%defstruct dd supers)) + (defun sbcl-define-structure (dd supers) (cond ((or *nuke-existing-classes* (not (find-class (dd-name dd) nil))) ;; create-struct - (sb-kernel::%defstruct dd supers) + (sb-kernel-defstruct dd supers nil) ;; compiler stuff (sb-kernel::%compiler-defstruct dd supers) ;; create make-? From sross at common-lisp.net Tue Mar 14 10:58:59 2006 From: sross at common-lisp.net (sross) Date: Tue, 14 Mar 2006 05:58:59 -0500 (EST) Subject: [cl-store-cvs] CVS cl-store Message-ID: <20060314105859.8EABE4F006@common-lisp.net> Update of /project/cl-store/cvsroot/cl-store In directory clnet:/tmp/cvs-serv22833 Modified Files: cl-store.asd ChangeLog Log Message: Fixed structure definition storing for more recent sbcl versions. --- /project/cl-store/cvsroot/cl-store/cl-store.asd 2006/03/14 09:34:09 1.36 +++ /project/cl-store/cvsroot/cl-store/cl-store.asd 2006/03/14 10:58:59 1.37 @@ -45,7 +45,7 @@ :name "CL-STORE" :author "Sean Ross " :maintainer "Sean Ross " - :version "0.6.9" + :version "0.6.10" :description "Serialization package" :long-description "Portable CL Package to serialize data" :licence "MIT" --- /project/cl-store/cvsroot/cl-store/ChangeLog 2006/03/14 09:34:09 1.39 +++ /project/cl-store/cvsroot/cl-store/ChangeLog 2006/03/14 10:58:59 1.40 @@ -1,4 +1,8 @@ 2006-03-13 Sean Ross + * sbcl/custom.lisp: Fixed sbcl structure definition + storing for versions >= 0.9.6.25 . + +2006-03-13 Sean Ross * utils.lisp, tests.lisp, openmcl/custom.lisp: Added support for structure object storing for OpenMCL. Thanks to Kilian Sprotte for the code. From sross at common-lisp.net Tue Mar 14 11:02:32 2006 From: sross at common-lisp.net (sross) Date: Tue, 14 Mar 2006 06:02:32 -0500 (EST) Subject: [cl-store-cvs] CVS cl-store/sbcl Message-ID: <20060314110232.135D35903A@common-lisp.net> Update of /project/cl-store/cvsroot/cl-store/sbcl In directory clnet:/tmp/cvs-serv24791/sbcl Modified Files: custom.lisp Log Message: Whoops, remove errant symbol. --- /project/cl-store/cvsroot/cl-store/sbcl/custom.lisp 2006/03/14 10:58:59 1.11 +++ /project/cl-store/cvsroot/cl-store/sbcl/custom.lisp 2006/03/14 11:02:32 1.12 @@ -118,7 +118,6 @@ "0.9.6.25") (pushnew :defstruct-has-source-location *features*)))) -asdf::version-satisfies (defun sb-kernel-defstruct (dd supers source) (declare (ignorable source)) #+defstruct-has-source-location