;;;; Destructive operation benchmark
(define (destructive n m)
  (let ((l (do ((i 10 (- i 1))
                (a '() (cons '() a)))
               ((= i 0) a))))
    (do ((i n (- i 1)))
        ((= i 0))
      (if (null? (car l))
          (do ((l l (cdr l)))
              ((null? l))
            (or (car l) (set-car! l (cons '() '())))
            (append! (car l) (do ((j m (- j 1))
                                  (a '() (cons '() a)))
                                 ((= j 0) a))))
          (do ((l1 l (cdr l1))
               (l2 (cdr l) (cdr l2)))
              ((null? l2))
            (set-cdr! (do ((j (quotient (length (car l2)) 2) (- j 1))
                           (a (car l2) (cdr a)))
                          ((zero? j) a)
                        (set-car! a i))
                      (let ((n (quotient (length (car l1)) 2)))
                        (cond ((= n 0) (set-car! l1 '()) (car l1))
                              (else (do ((j n (- j 1))
                                         (a (car l1) (cdr a)))
                                        ((= j 1)
                                         (let ((x (cdr a)))
                                           (set-cdr! a '()) x))
                                      (set-car! a i)))))))))))
;; call:  (destructive 600 50)