diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-02-19 15:59:51 +0100 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-02-19 15:59:51 +0100 |
commit | 304b82e4bb9c5f85e293a7e0706e3448aec04574 (patch) | |
tree | 1b24a9d0aa12d35f09142ff32b831f7d372cef9e | |
parent | 7bdf92ff183ac2f1edc942f644a050853bf50a3d (diff) |
pickling copy and deep copy support
-rw-r--r-- | modules/language/python/persist.scm | 50 |
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))) + |