Re: Persistent Objects

From: Erick Gallesio <>
Date: Fri, 26 Mar 1999 12:41:02 +0100 (CET)

Hereafter, is a simple version (I didn't had the time to see the
version you provide which dump an object as a form which can be read
back again. I have just write it and not tested a lot but it seems
correct. It uses write* to manage circular structures. However, this
code is not completely correct because if you dump an object which
have two slots which share some structure, the form which will be
re-read will not share them (i.e. you will have two copies). A
solution, could be to generate a list which contains the values of all
the slot in a let ant to store the values into the slots after that
for sharing correctly the data (I realize that I'm not clear here and
I can try to write this if there is interest for that). Anyway here
is my code:

;; Dump standard classes
(define-method dump-object ((self <top>) file)
  (case (class-of self)
    ((<number> <string> <boolean>) (write self file))
    ((<list> <pair> <vector> <symbol>) (write-char #\' file) (write* self file))
    (else (error "Cannot dump object ~S to file ~S"
                                              self file)))
;; Dump a general object
(define-method dump-object ((self <object>) file)
  (let ((name (gensym))
        (class (class-of self)))
    ;; Write header
    (format file "(let ((~A (make ~A)))\n" name (class-name class))
    ;; Dump each slots
    (for-each (lambda (x)
                (format file " (slot-set! ~A '~A " name x)
                (dump-object (slot-ref self x))
                (format file ")\n"))
              (map slot-definition-name (class-slots class)))
    ;; Close the let
    (format file " ~A)\n" name)))

;; Dump method when the file is unspecified (=> use stdout)
(define-method dump-object ((self <top>))
  (dump-object self (current-output-port)))

Here are some example of usage (code has been pretty-printed by hand):
    (define-class <A> ()
      ((xa :init-form 1)
       (ya :init-form 2)))

    (define-class <B> (<A>)
      ((xb :init-form 1)
       (yb :init-form 2)))

    ; define a circlar list
    (define l '(1 2))
    (set-cdr! l l)

    ; define some instances
    (define a (make <A>))

    (define b1 (make <B>))

    (define b2 (make <B>))
    (slot-set! b2 'xa a)
    (slot-set! b2 'xb l)

Trying to dump b1 will give:
   (dump-object b1)
        => (let ((G10 (make <b>)))
             (slot-set! G10 'xa 1)
             (slot-set! G10 'ya 2)
             (slot-set! G10 'xb 1)
             (slot-set! G10 'yb 2)

And dumping object b2 will give
   (dump-object b1)
        => (let ((G11 (make <b>)))
              (slot-set! G11 'xa (let ((G12 (make <a>)))
                                    (slot-set! G12 'xa 1)
                                    (slot-set! G12 'ya 2)
              (slot-set! G11 'ya 2)
              (slot-set! G11 'xb '#0=(1 . #0#))
              (slot-set! G11 'yb 2)

                -- Erick
Received on Fri Mar 26 1999 - 12:57:28 CET

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST