summaryrefslogtreecommitdiff
path: root/modules/language/python/persist.scm
blob: ac7d7af047bb245158e4121104837c80184c4276 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
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)))