src/sicp/ex3_19.rkt

   1 #lang r5rs
   2
   3 (define (contains-cycle? x y)
   4   (if (or (not (pair? x))
   5           (not (pair? y)))
   6       #f
   7       (let ((t (cdr x))
   8             (h (cdr (cdr y))))
   9         (if (eqv? t h)
  10             #t
  11             (contains-cycle? t h)))))
  12
  13 (define (last-pair x)
  14   (if (null? (cdr x))
  15       x
  16       (last-pair (cdr x))))
  17
  18 (define (make-cycle x)
  19   (set-cdr! (last-pair x) x)
  20   x)
  21
  22 (define z (make-cycle (list 'a 'b 'c)))
  23 (define z1 (list 'a 'b 'c))
  24
  25 (contains-cycle? z (cdr z))
  26 (contains-cycle? z1 (cdr z1))