Next: Recfib, Previous: Benchmark Sources, Up: Benchmark Sources [Contents][Index]
;;;; 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)