pickling copy and deep copy support
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Mon, 19 Feb 2018 14:59:51 +0000 (15:59 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Mon, 19 Feb 2018 14:59:51 +0000 (15:59 +0100)
modules/language/python/persist.scm [new file with mode: 0644]

diff --git a/modules/language/python/persist.scm b/modules/language/python/persist.scm
new file mode 100644 (file)
index 0000000..ac7d7af
--- /dev/null
@@ -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)))
+