--- serialization.lisp.orig	2007-03-16 10:37:18.000000000 -0500
+++ serialization.lisp	2007-04-05 09:53:33.000000000 -0500
@@ -327,6 +327,56 @@
               ((:proper-sequence :proper-list) (proper-sequence length))
               ((:dotted-list :circular-list) (improper-list))))))))
 
+(defmethod serialize-sexp-internal ((object simple-array) stream serialization-state)
+  (let ((id (known-object-id serialization-state object)))
+    (if id
+        (progn
+          (write-string "(:REF . " stream)
+          (prin1 id stream)
+          (write-string ")" stream))
+      (let ((array-total-size (array-total-size object))
+            (id (set-known-object serialization-state object)))
+             (write-string "(:SIMPLE-ARRAY " stream)
+             (prin1 id stream)
+             (write-string " :DIMENSIONS (" stream)
+             (dolist (x (array-dimensions object))
+               (write-string " " stream)
+               (prin1 x stream))
+             (write-string " )" stream)
+             (write-string " :ELEMENT-TYPE " stream)
+             (prin1 (array-element-type object) stream)
+             (unless (zerop array-total-size)
+               (write-string " :ELEMENTS (" stream)
+               (dotimes (i array-total-size)
+                 (write-string " " stream)
+                 (serialize-sexp-internal (row-major-aref object i) stream serialization-state))
+               (write-string " ) )" stream))))))
+
+(defmethod serialize-xml-internal ((object simple-array) stream serialization-state)
+  (let ((id (known-object-id serialization-state object)))
+    (if id
+        (progn
+          (write-string "<REF ID=\"" stream)
+          (prin1 id stream)
+          (write-string "\"/>" stream))
+      (let ((array-total-size (array-total-size object))
+            (id (set-known-object serialization-state object)))
+             (write-string "<SIMPLE-ARRAY ID=\"" stream)
+             (prin1 id stream)
+             (write-string "\" DIMENSIONS=\"" stream)
+             (write-string "( " stream)
+             (dolist (x (array-dimensions object))
+               (prin1 x stream)
+               (write-string " " stream))
+             (write-string ")" stream)
+             (write-string "\" ELEMENT-TYPE=\"" stream)
+             (prin1 (array-element-type object) stream)
+             (write-string "\">" stream)
+             (unless (zerop array-total-size)
+               (dotimes (i array-total-size)
+                 (serialize-xml-internal (row-major-aref object i) stream serialization-state))
+               (write-string "</SIMPLE-ARRAY>" stream))))))
+
 (defmethod serialize-xml-internal ((object hash-table) stream serialization-state)
   (let ((id (known-object-id serialization-state object)))
     (if id
@@ -490,6 +540,15 @@
 		     (size (parse-integer (get-attribute-value :size attributes))))
 		 (setf (gethash id *deserialized-objects*)
 		       (make-sequence class size))))
+    (:simple-array (let ((id (parse-integer (get-attribute-value :id attributes)))
+                         (dimensions (read-from-string (get-attribute-value :dimensions attributes)))
+                         (element-type (read-from-string (get-attribute-value :element-type attributes))))
+                     (setf (gethash id *deserialized-objects*)
+                           (make-array dimensions
+                                       :adjustable nil    ; not just any array, ...
+                                       :fill-pointer nil  ; ...
+                                       :displaced-to nil  ; ... a simple-array
+                                       :element-type element-type))))
     (:object (let ((id (parse-integer (get-attribute-value :id attributes)))
 		   (class (read-from-string (get-attribute-value :class attributes))))
 	       (setf (gethash id *deserialized-objects*)
@@ -525,6 +584,13 @@
 	  (:sequence (let* ((id (parse-integer (get-attribute-value :id attributes)))
 			    (sequence (gethash id *deserialized-objects*)))
 		       (map-into sequence #'identity (nreverse seed))))
+          (:simple-array (let* ((id (parse-integer (get-attribute-value :id attributes)))
+                                (simple-array (gethash id *deserialized-objects*))
+                                (i 0))
+                           (dolist (x (nreverse seed) simple-array)
+                             (setf (row-major-aref simple-array i)
+                                   x)
+                             (incf i))))
           (:cons (let* ((id (parse-integer (get-attribute-value :id attributes)))
                         (cons-pair (gethash id *deserialized-objects*)))
                    (rplaca cons-pair (second seed))
@@ -561,6 +627,19 @@
                        (map-into sequence 
                                  #'(lambda (x) (deserialize-sexp-internal x deserialized-objects)) 
                                  elements))))
+        (:simple-array (destructuring-bind (id &key dimensions element-type elements) (rest sexp)
+                         (let ((simple-array (make-array dimensions
+                                                         :adjustable nil    ; not just any array, ...
+                                                         :fill-pointer nil  ; ...
+                                                         :displaced-to nil  ; a simple-array
+                                                         :element-type element-type)))
+                           (setf (gethash id deserialized-objects) simple-array)
+                           (let ((i 0))
+                             (dolist (x elements)
+                               (setf (row-major-aref simple-array i)
+                                     (deserialize-sexp-internal x deserialized-objects))
+                               (incf i)))
+                           simple-array)))
         (:hash-table (destructuring-bind (id &key test size rehash-size rehash-threshold entries) (rest sexp)
                        (let ((hash-table (make-hash-table :size size 
                                                           :test test 
