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)
G10)
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)
G12))
(slot-set! G11 'ya 2)
(slot-set! G11 'xb '#0=(1 . #0#))
(slot-set! G11 'yb 2)
G11))
-- Erick
Received on Fri Mar 26 1999 - 12:57:28 CET