(define-module (language python persist) #:use-module (ice-9 match) #:use-module (ice-9 vlist) #:use-module (ice-9 pretty-print) #: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 name-object-deep) #:export (reduce cp red cpit)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) (define (vhash->assoc v) (let ((t (make-hash-table))) (vhash-fold (lambda (k v s) (if (hash-ref t k) s (begin (hash-set! t k #t) (cons (cons k v) s)))) '() v))) (define-method (pcopyable? (o
)) #t) (define-method (deep-pcopyable? (o
)) #t) (define (cp o) (match (red o) ((#:reduce mk f) (let ((oo (mk))) (for-each (lambda (x) (apply (car x) oo (cdr x))) f) oo)))) (define (red o) (fluid-set! first #t) (list #:reduce (let ((cl (class-of o))) (lambda () (make cl))) (reduce o))) (define-method (pcopy (o
)) (list #:obj (aif it (ref o '__copy__) (it) (cp o)))) (define-method (deep-pcopy (o
) p?) (aif it (and p? (ref o '__deepcopy__)) (list #:obj (it)) (red o))) (define first (make-fluid #f)) (define-method (reduce o) '()) (define-method (reduce (o
))
(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)
(fold f (f (car l) s) (cdr l))
s))
(define-method (reduce (o