[cl-store-devel] structure-objects for openmcl

[Kilian Sprotte]

Hi Sean,

I am very happy that cl-store is continuously improving - its quite  
an important lib, I think. Just playing around a little with openmcl  
revealed that storing a structure is not that hard.

I am not sure, if it is a nice way of doing like so, have a look at  
the diff against latest CVS, if you like. (structure-object.[1-3] do  
pass...)

Cheers,

	Kilian Sprotte


--- orig/default-backend.lisp
+++ mod/default-backend.lisp
@@ -418,6 +418,11 @@
    (output-type-code +standard-object-code+ stream)
    (store-type-object obj stream))
+#+openmcl
+(defstore-cl-store (obj structure-object stream)
+  (output-type-code +structure-object-code+ stream)
+  (store-type-object obj stream))
+
(defstore-cl-store (obj condition stream)
    (output-type-code +condition-code+ stream)
    (store-type-object obj stream))
@@ -442,6 +447,10 @@
(defrestore-cl-store (standard-object stream)
    (restore-type-object stream))
+#+openmcl
+(defrestore-cl-store (structure-object stream)
+  (restore-type-object stream))
+
(defrestore-cl-store (condition stream)
    (restore-type-object stream))


--- orig/tests.lisp
+++ mod/tests.lisp
@@ -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)))


--- orig/utils.lisp
+++ mod/utils.lisp
@@ -23,7 +23,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 +37,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
@@ -56,14 +56,25 @@
      as an argument to ensure-class")
    (:method ((slot-definition #+(or ecl clisp) t
                               #-(or ecl clisp) 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))))
+    (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)))
+  #+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))