Next: , Previous: Benchmark Sources, Up: Benchmark Sources


4.3.1 Destruct

     ;;;; 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)