122-deep-copy.scm (2077B)
1 ; Generic deep-copy is an ordinary graph clone. It preserves sharing and 2 ; cycles within a context, without relying on heap selection. 3 4 (define-record-type cell 5 (mk-cell head tail) 6 cell? 7 (head cell-head cell-head-set!) 8 (tail cell-tail cell-tail-set!)) 9 10 (define ctx0 (make-deep-copy-context)) 11 (if (eq? 'foo (deep-copy ctx0 'foo)) 0 (sys-exit 1)) 12 (if (= 42 (deep-copy ctx0 42)) 0 (sys-exit 2)) 13 (if (eq? #t (deep-copy ctx0 #t)) 0 (sys-exit 3)) 14 15 (define source-list (cons 1 (cons 2 (cons 3 '())))) 16 (define ctx1 (make-deep-copy-context)) 17 (define copy-list (deep-copy ctx1 source-list)) 18 (if (equal? source-list copy-list) 0 (sys-exit 10)) 19 (if (not (eq? source-list copy-list)) 0 (sys-exit 11)) 20 (if (eq? copy-list (deep-copy ctx1 source-list)) 0 (sys-exit 12)) 21 22 (define source-bv (bytevector 1 2 3 4 5)) 23 (define copy-bv (deep-copy (make-deep-copy-context) source-bv)) 24 (if (bytevector=? source-bv copy-bv) 0 (sys-exit 20)) 25 (if (not (eq? source-bv copy-bv)) 0 (sys-exit 21)) 26 (bytevector-u8-set! source-bv 0 99) 27 (if (= (bytevector-u8-ref copy-bv 0) 1) 0 (sys-exit 22)) 28 29 (define source-cell (mk-cell 10 20)) 30 (define copy-cell (deep-copy (make-deep-copy-context) source-cell)) 31 (if (cell? copy-cell) 0 (sys-exit 30)) 32 (if (not (eq? source-cell copy-cell)) 0 (sys-exit 31)) 33 (if (eq? (record-td source-cell) (record-td copy-cell)) 0 (sys-exit 32)) 34 (if (= (cell-head copy-cell) 10) 0 (sys-exit 33)) 35 36 ; Both edges must point at one fresh clone. 37 (define shared (cons 'a 'b)) 38 (define graph (cons shared shared)) 39 (define graph-copy (deep-copy (make-deep-copy-context) graph)) 40 (if (eq? (car graph-copy) (cdr graph-copy)) 0 (sys-exit 40)) 41 (if (not (eq? (car graph-copy) shared)) 0 (sys-exit 41)) 42 43 ; An eager stand-in breaks cycles while recursively filling fields. 44 (define cycle (mk-cell 1 #f)) 45 (cell-tail-set! cycle cycle) 46 (define cycle-copy (deep-copy (make-deep-copy-context) cycle)) 47 (if (not (eq? cycle cycle-copy)) 0 (sys-exit 50)) 48 (if (eq? cycle-copy (cell-tail cycle-copy)) 0 (sys-exit 51)) 49 (collect-garbage) 50 (if (eq? cycle-copy (cell-tail cycle-copy)) 0 (sys-exit 52)) 51 52 (sys-exit 42)