From: yann ARMAND
Subject: Persistence/serialization of CLOS objects
Date: 
Message-ID: <9g4ldr$n5p$1@s1.read.news.oleane.net>
Hello,

I am searching a Data serialization libraries for CLOS working with
CMUCL, AllegroCL, or both.

I found Plob (http://www.lisp.de/software/plob/Welcome.html), said working 
with Allegro, but does anyone tested it with CMUCL ?
-- 
-----
-yVa-
-----

From: Drew McDermott
Subject: Re: Persistence/serialization of CLOS objects
Date: 
Message-ID: <3B2920B9.E64B1FD9@yale.edu>
This is a multi-part message in MIME format.
--------------44FD25C70EA8557E0EB40794
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

yann ARMAND wrote:

> Hello,
>
> I am searching a Data serialization libraries for CLOS working with
> CMUCL, AllegroCL, or both.
>
> I found Plob (http://www.lisp.de/software/plob/Welcome.html), said working
> with Allegro, but does anyone tested it with CMUCL ?
> --
> -----
> -yVa-
> -----

I've attached a hack that someone might use to write a real serializer.  It
should work in any Common Lisp.  Caveat emptor.

  -- Drew McDermott


--------------44FD25C70EA8557E0EB40794
Content-Type: text/plain; charset=us-ascii;
 name="serialize.lisp"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="serialize.lisp"

(defpackage :serialize
  (:use :common-lisp)
  (:export "SERIALIZE" "SERIALIZER"))

(in-package :serialize)

;;; Create a string that when read rebuilds ob.
;;; Doesn't have to be human-readable.
(defun serialize (ob)
   (multiple-value-bind (str numsharps inits )
		        (basic-serialize ob 0 '())
      (cond ((null inits)
	     str)
	    (t
	     (let ((to-assimilate '())
		   (extra-string "")
		   (extra-inits '()))
	        (loop 
		   (setf to-assimilate inits)
		   (dolist (i to-assimilate)
		      (let (more-string)
			 (multiple-value-setq (more-string numsharps extra-inits)
			                      (basic-serialize i numsharps '()))
			 (setf extra-string
			       (concatenate 'string more-string extra-string))))
		  (cond ((null extra-inits)
			 (return (format nil 
					 "#.(prog1 '~a ~a)"
					  str extra-string))))
		  (setf inits extra-inits)))))))

(defclass sharpoid ()
   ((num :initarg :num)))

(defmethod print-object ((s sharpoid) srm)
   (format srm "#~s#" (slot-value s 'num)))

;;; Return < string, numsharps inits, >
(defun basic-serialize (thing sharps inits)
      (let ((str (with-output-to-string (srm nil)
		     (multiple-value-setq (sharps inits)
					  (write-serialized thing srm sharps inits)))))
	 (values str sharps inits)))

;;; Return < cumulative-sharps, cumulative-inits >
(defun write-serialized (x srm sharps inits)
   (cond ((not x)
	  (format srm "nil")
	  (values sharps inits))
	 ((typep x 'sharpoid)
	  (format srm "#~s#" (slot-value x 'num))
	  (values sharps inits))
	 (t
	  (let ((serializer (form-serializer x)))
	     ;; This is for a Nisp hook; others please ignore
	     (cond (serializer
		    (funcall serializer x srm sharps inits))
		   ((symbolp x)
		    (let ((pkg (symbol-package x)))
		       (cond (pkg
			      (format srm "~a::|~a|"
				      (package-name pkg)
				      (symbol-name x)))
			     (t
			      (format srm "#:|~a|" (symbol-name x))))
		       (values sharps inits)))
		   ((or (numberp x)
			(stringp x))
		    (format srm "~s" x)
		    (values sharps inits))
		   ((consp x)
		    (format srm "(")
		    (list-write-serialized x srm sharps inits))
		   ((vectorp x)
		    (format srm "#(")
		    (do ((i 0 (+ i 1))
			 (l (length x)))
			((= i l))
		       (multiple-value-setq (sharps inits)
			                    (write-serialized (elt x i) srm
							      sharps inits))
		       (cond ((< i l) (format srm " "))))
		    (format srm ")")
		    (values sharps inits))
		   ((arrayp x)
		    (error "Can't serialize complex arrays yet: ~s" x))
		   (t
		    (multiple-value-bind (l i)
			                 (make-load-form x)
		       (cond (i
			      (incf sharps)
			      (format srm "#~s=#." sharps)
			      (multiple-value-setq (sharps inits)
				                   (write-serialized l srm sharps inits))
			      (values sharps
				      (cons (load-form-subst
						   (make-instance 'sharpoid :num sharps)
						   x i)
					    inits)))
			     (t
			      (format srm "#.")
			      (write-serialized l srm sharps inits))))))))))

;;; Write all of a list but the open paren.
(defun list-write-serialized (l srm sharps inits)
      (do ()
	  ((atom l))
	(multiple-value-setq (sharps inits)
			     (write-serialized (car l) srm sharps inits))
	(setq l (cdr l))
	(cond (l
		(format srm " "))))
      (cond (l
	     (format srm ". ")
	     (multiple-value-setq (sharps inits)
				  (write-serialized l srm sharps inits))))
      (format srm ")")
      (values sharps inits))

;;; This handles only the simplest case, which is probably the only case that
;;; will ever occur.
(defun load-form-subst (sharpoid ob e)
   (cond ((atom e) e)
	 ((and (eq (car e) 'quote)
	       (eq (cadr e) ob))
	  sharpoid)
	 (t
	  (mapcar #'(lambda (y) (load-form-subst sharpoid ob y))
		  e))))

(defclass stest ()
  ((a :initarg :a :accessor stest-a)))

(defmethod make-load-form ((s stest) &optional env)
   (declare (ignore env))
   (values
      `(make-instance 'stest)
      `(setf (stest-a ',s) ',(stest-a s))))

(defun form-serializer (x)
   (and (consp x)
	(symbolp (car x))
	(get (car x) 'serializer)))
--------------44FD25C70EA8557E0EB40794--
From: Barry Margolin
Subject: Re: Persistence/serialization of CLOS objects
Date: 
Message-ID: <jQaW6.29$4O4.312@burlma1-snr2>
In article <·················@yale.edu>,
Drew McDermott  <··············@yale.edu> wrote:
>I've attached a hack that someone might use to write a real serializer.  It
>should work in any Common Lisp.  Caveat emptor.

Doesn't the Lisp Archive have a SAVE-OBJECT function?  Wouldn't that be a
better starting point?

-- 
Barry Margolin, ······@genuity.net
Genuity, Burlington, MA
*** DON'T SEND TECHNICAL QUESTIONS DIRECTLY TO ME, post them to newsgroups.
Please DON'T copy followups to me -- I'll assume it wasn't posted to the group.