pickling copy and deep copy support

1 files changed, 50 insertions, 0 deletions

diff --git a/modules/language/python/persist.scm b/modules/language/python/persist.scm
new file mode 100644
index 0000000..ac7d7af
--- /dev/null
+++ b/modules/language/python/persist.scm
@@ -0,0 +1,50 @@
+(define-module (language python persist)
+  #:export ())
+
+(define-method (pcopyable      (<p> o)) #t)
+(define-method (deep_pcopyable (<p> o)) #t)
+
+(define-method (pcopy (<p> o))
+  (list #:obj
+	(aif it (get o '__copy__)
+	     (it)
+	     (copy o))))
+
+(define-method (deep-pcopy (<p> o) p?)
+  (aif it (and p? (get o '__deepcopy__))
+       (list #:obj  (it))
+       (list #:reduce
+	     (make (class-of o))
+	     (reduce o))))
+
+(define-method (reduce o) '())
+(define-method (reduce (<p> o))
+  (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))))))
+    (list
+     (hash-fold
+      (lambda (k v s) (cons (cons k v) s))
+      '()
+      (slot-ref o 'h))))
+   (next-method)))
+
+(define-method (reduce (<pf> o))
+  (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)))
+