Re: Persisting GOOPS objects

[Andy Wingo]

Hi,

On Wed 23 Jan 2013 14:46, Andrew Gaylard <address@hidden> writes:

> I made another attempt using strings instead of numbers, to get an idea
> of whether save.scm is usable:
>
> $ cat persistence-test.scm
> (use-modules (oop goops))
> (use-modules (oop goops describe))
> (use-modules (oop goops save))
>
> ;; Apply Andy's fix to the readable? function
> (set! (@@ (oop goops save) readable?)
>       (lambda (x) (hashq-ref (@@ (oop goops save) readables) x)))
>
> ;; make a new class, make an instance of it, and show it
> (define-class <ag-record> (<object>) name addr)
> (define r (make <ag-record>))
> (slot-set! r 'name "Fred")
> (slot-set! r 'addr "101 Elm Street")
> (describe r)
>
> ;; persist the instance
> (define a '())
> (set! a (acons 'r r a))
> (save-objects a (current-output-port))
>
> $ guile
> scheme@(guile-user)> (load "persistence-test.scm")
> #<<ag-record> 9f2b2a0> is an instance of class <ag-record>
> Slots are: 
>      name = "Fred"
>      addr = "101 Elm Street"
> (define r (restore <ag-record> (name addr) oop/goops/save.scm:423:32: In
> procedure #<procedure 9f64f48 at oop/goops/save.scm:414:21 (name aname
> get set)>:
> oop/goops/save.scm:423:32: Wrong type to apply: #<syntax-transformer
> write-component>

This tells me that this module has not worked in Guile 2.0.
Write-component is a macro, and all of its uses were before its
definition.

There is no way to patch this easily; you have to edit the file.  The
attached patch is applied to git.

Now:

  (save-objects a (current-output-port))
  =| (define r (restore <ag-record> (name addr) "Fred" "101 Elm Street"))

Regards,

Andy

>From a3df9ad9e6be7d5fbc566a10bc9ba035a2e38f31 Mon Sep 17 00:00:00 2001
From: Andy Wingo <address@hidden>
Date: Wed, 23 Jan 2013 16:53:54 +0100
Subject: [PATCH] oop goops save: fix compile-time availability of
 write-component

* module/oop/goops/save.scm (write-component)
  (write-component-procedure): Move definitions up so that syntax
  definition is available when compiling the rest of the file.
---
 module/oop/goops/save.scm |   41 +++++++++++++++++++++++------------------
 1 file changed, 23 insertions(+), 18 deletions(-)

diff --git a/module/oop/goops/save.scm b/module/oop/goops/save.scm
index 05362e0..dda2aea 100644
--- a/module/oop/goops/save.scm
+++ b/module/oop/goops/save.scm
@@ -128,6 +128,29 @@
   (hashq-ref readables obj))
 
 ;;;
+;;; Writer helpers
+;;;
+
+(define (write-component-procedure o file env)
+  "Return #f if circular reference"
+  (cond ((immediate? o) (write o file) #t)
+       ((readable? o) (write (readable-expression o) file) #t)
+       ((excluded? o env) (display #f file) #t)
+       (else
+        (let ((info (object-info o env)))
+          (cond ((not (binding? info)) (write-readably o file env) #t)
+                ((not (eq? (visiting info) #:defined)) #f) ;forward reference
+                (else (display (binding info) file) #t))))))
+
+;;; write-component OBJECT PATCHER FILE ENV
+;;;
+(define-macro (write-component object patcher file env)
+  `(or (write-component-procedure ,object ,file ,env)
+       (begin
+         (display #f ,file)
+         (add-patcher! ,patcher ,env))))
+
+;;;
 ;;; Strings
 ;;;
 
@@ -603,24 +626,6 @@
           (pop-ref! env)
           (set! (objects env) (cons o (objects env)))))))
 
-(define (write-component-procedure o file env)
-  "Return #f if circular reference"
-  (cond ((immediate? o) (write o file) #t)
-       ((readable? o) (write (readable-expression o) file) #t)
-       ((excluded? o env) (display #f file) #t)
-       (else
-        (let ((info (object-info o env)))
-          (cond ((not (binding? info)) (write-readably o file env) #t)
-                ((not (eq? (visiting info) #:defined)) #f) ;forward reference
-                (else (display (binding info) file) #t))))))
-
-;;; write-component OBJECT PATCHER FILE ENV
-;;;
-(define-macro (write-component object patcher file env)
-  `(or (write-component-procedure ,object ,file ,env)
-       (begin
-         (display #f ,file)
-         (add-patcher! ,patcher ,env))))
 
 ;;;
 ;;; Main engine
-- 
1.7.10.4

-- 
http://wingolog.org/