src/sicp/ex3_17.rkt

   1 #lang r5rs
   2
   3 (define (traverse-tree! x)
   4   (cond
   5     ((not (pair? x)) x)
   6     ((eqv? (car x) 'traversed)
   7      (cons (traverse-tree! (car (cdr x)))
   8            (traverse-tree! (cdr (cdr x)))))
   9     (else
  10      (begin
  11        (set! x (cons 'traversed (cons (car x) (cdr x))))
  12        (traverse-tree! x)))))
  13
  14 (define (count-tree x)
  15   (cond
  16     ((not (pair? x)) 0)
  17     ((traversed? x) (+ (count-tree (left x))
  18                        (count-tree (right x))))
  19     (else
  20      (begin
  21        (set-car! x (traverse x))
  22        (+ (count-tree (left x))
  23           (count-tree (right x))
  24           1)))))
  25
  26 (define (traversed? x)
  27   (if (pair? (car x))
  28       (eqv? (car (car x)) 'traversed)
  29       #f))
  30
  31 (define (left x)
  32   (if (traversed? x)
  33       (cdr (car x))
  34       (car x)))
  35
  36 (define (right x)
  37   (cdr x))
  38
  39 (define (traverse x)
  40   (cons 'traversed
  41         (car x)))
  42
  43 (define x (list 'a 'b))
  44 (define z (cons x x))