Structure-Preserving Copy |
|
(define (copy-list-2 l)
(let ((tag (list 'BEEN-HERE-DONE-THAT)))
(define (copy l)
(cond ((null? l) '())
((and (pair? l) (not (eq? (car l) tag)))
(let ((the-car (car l))
(the-cdr (cdr l))
(result (cons 0 0)))
(set-car! l tag)
(set-cdr! l result)
(set-car! result (copy the-car))
(set-cdr! result (copy the-cdr))
result))
((pair? l) (cdr l))
(else l)))
(copy l)))
(define z (copy-list-2 y))
z ; ((a b c) a b c)
(eq? (car z) (cdr z)) ; #T
(define x '(a b c))
(set-cdr! x x)
(define y (copy-list-2 x))
(eq? y (cdr y)) ; #T