(define (copy-ring r)
  (define (append-ring r stop resultfirst resultlast)
    (if (eq? r stop)
        (begin
          (set-cdr! resultlast resultfirst)
          resultfirst)
        (begin
          (set-cdr! resultlast (list (car r)))
          (append-ring (cdr r) stop resultfirst (cdr resultlast)))))
  (let ((first-cell (cons (car r) '())))
    (append-ring (cdr r) r first-cell first-cell)))