1 files changed, 42 insertions, 30 deletions

diff --git a/modules/language/python/persist.scm b/modules/language/python/persist.scm
index cf0f7c2..4005220 100644
--- a/modules/language/python/persist.scm
+++ b/modules/language/python/persist.scm
@@ -5,7 +5,8 @@
   #:use-module (oop goops)
   #:use-module (oop pf-objects)
   #:use-module (logic guile-log persistance)
-  #:re-export(pcopyable? deep-pcopyable? pcopy deep-pcopy name-object)
+  #:re-export(pcopyable? deep-pcopyable? pcopy deep-pcopy name-object
+			 name-object-deep)
   #:export (reduce cp red cpit))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
@@ -32,10 +33,12 @@
 	    oo))))
 
 (define (red o)
+  (fluid-set! first #t)
   (list #:reduce
 	(let ((cl (class-of o)))
 	  (lambda () (make cl)))		
 	(reduce o)))
+  
 
 (define-method (pcopy (o <p>))
   (list #:obj
@@ -48,22 +51,29 @@
        (list #:obj  (it))
        (red o)))
 
+(define first (make-fluid #f))
 (define-method (reduce o) '())
 (define-method (reduce (o <p>))
-  (cons*
-   (cons
-    (lambda (o args)
-      (let ((h (make-hash-table)))
-	(slot-set! o 'h h)
-	(for-each
-	 (lambda (x) (hash-set! h (car x) (cdr x)))
-	 args)))
-    (list
-     (hash-fold
-      (lambda (k v s) (cons (cons k v) s))
-      '()
-      (slot-ref o 'h))))
-   (next-method)))
+  (if (fluid-ref first)
+      (begin
+	(fluid-set! first #f)
+	(cons
+	 (aif it (ref o '__reduce__)
+	      (it)
+	      (cons
+	       (lambda (o args)
+		 (let ((h (make-hash-table)))
+		   (slot-set! o 'h h)
+		   (for-each
+		    (lambda (x) (hash-set! h (car x) (cdr x)))
+		    args)))
+	       (list
+		(hash-fold
+		 (lambda (k v s) (cons (cons k v) s))
+		 '()
+		 (slot-ref o 'h)))))
+	 (next-method)))
+      (next-method)))
 
 (define (fold f s l)
   (if (pair? l)
@@ -71,22 +81,24 @@
       s))
 
 (define-method (reduce (o <pf>))
-  (cons*
-   (cons
-    (lambda (o n args)
-      (slot-set! o 'size n)
-      (slot-set! o 'n    n)
-      (let ((h
-	     (fold	      
-	      (lambda (k v s) (vhash-assoc k v s))
-	      vlist-null
-	      args)))
-	(slot-set! o 'h h)))
-    (list (slot-ref o 'n) (vhash->assoc (slot-ref o 'h))))
-   (next-method)))
+  (if (fluid-ref first)
+      (begin
+	(fluid-set! first #f)
+	(cons*
+	 (cons
+	  (lambda (o n args)
+	    (slot-set! o 'size n)
+	    (slot-set! o 'n    n)
+	    (let ((h
+		   (fold	      
+		    (lambda (k v s) (vhash-assoc k v s))
+		    vlist-null
+		    args)))
+	      (slot-set! o 'h h)))
+	  (list (slot-ref o 'n) (vhash->assoc (slot-ref o 'h))))
+	 (next-method)))
+      (next-method)))
      
-
-
 (define-syntax cpit
   (lambda (x)
     (syntax-case x ()