Iterators can be surprisingly fast (on SBCL, when they are inlined)

list-iterators.lisp

(in-package #:cl-user)

(defpackage #:list-iterators
  (:use #:cl))

(in-package #:list-iterators)

(declaim (inline make-read-iterator))
(defun make-read-iterator (list terminate)
  (lambda ()
    (cond ((consp list)
           (pop list))
          (t
           (funcall terminate)))))

(declaim (inline make-write-iterator))
(defun make-write-iterator (list terminate)
  (lambda (value)
    (cond ((consp list)
           (prog1 value
             (setf (car list) value)
             (pop list)))
          (t
           (funcall terminate)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Benchmark 1 - FILL

(defun fill-using-iterators (list value)
  (let ((iter (make-write-iterator list (lambda () (return-from fill-using-iterators list)))))
    (loop (funcall iter value))))

(defun fill-using-loop (list value)
  (loop for cons on list do
    (setf (car cons) value))
  list)

(defun fill-benchmark ()
  (let ((list (make-list 10000)))
    (loop for fn in '(fill-using-iterators fill-using-loop) do
      (format t "Benchmark ~A:~%" fn)
      (time (loop repeat 100000 do (funcall fn list 42))))))

;;; Benchmark fill-using-iterators:
;;; Evaluation took:
;;;   1.156 seconds of real time
;;;   1.156141 seconds of total run time (1.156141 user, 0.000000 system)
;;;   100.00% CPU
;;;   4,161,325,012 processor cycles
;;;   0 bytes consed
;;;
;;; Benchmark fill-using-loop:
;;; Evaluation took:
;;;   1.141 seconds of real time
;;;   1.141031 seconds of total run time (1.141031 user, 0.000000 system)
;;;   100.00% CPU
;;;   4,107,172,072 processor cycles
;;;   0 bytes consed

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Benchmark 2 - REPLACE

(defun replace-using-iterators (list-1 list-2)
  (let ((dst (make-write-iterator list-1 (lambda () (return-from replace-using-iterators list-1))))
        (src (make-read-iterator list-2 (lambda () (return-from replace-using-iterators list-1)))))
    (loop (funcall dst (funcall src)))))

(defun replace-using-loop (list-1 list-2)
  (loop for cons-1 on list-1
        for cons-2 on list-2 do
          (setf (car cons-1) (car cons-2)))
  list-1)

(defun replace-benchmark ()
  (let ((list-1 (make-list 10000))
        (list-2 (make-list 10000)))
    (loop for fn in '(replace-using-iterators replace-using-loop) do
      (format t "Benchmark ~A:~%" fn)
      (time (loop repeat 100000 do (funcall fn list-1 list-2))))))

;;; Benchmark replace-using-iterators:
;;; Evaluation took:
;;;   1.214 seconds of real time
;;;   1.214443 seconds of total run time (1.214443 user, 0.000000 system)
;;;   100.00% CPU
;;;   4,371,462,902 processor cycles
;;;   0 bytes consed
;;;
;;; Benchmark replace-using-loop:
;;; Evaluation took:
;;;   1.597 seconds of real time
;;;   1.596942 seconds of total run time (1.596942 user, 0.000000 system)
;;;   100.00% CPU
;;;   5,748,687,216 processor cycles
;;;   0 bytes consed