Now, we’re ready to put together the more complex version of the original macro with the generalized n-iterator macro-generating macro. That’s fairly simple, certainly compared to the magic that goes into building the looping construct. We’ve already got the desired template, we just fold them in. Here’s the result:
(defmacro create-n-iter-loop (n name) (assert (and (integerp n) (> n 0))) (let (symbols first-sym last-sym) (dotimes (i n) (push (intern (format nil "ITER~D" i)) symbols)) (setf last-sym (first symbols)) (setf symbols (reverse symbols)) (setf first-sym (first symbols)) `(defmacro ,name ((dl-list ,@symbols &key start end circular reverse) &body body) (let ((dl-cap (gensym)) (start-cap (gensym)) (end-cap (gensym)) (circ-cap (gensym)) (rev-cap (gensym)) (inc-fcn (gensym)) (early-exit (gensym))) `(let ((,dl-cap ,dl-list) (,start-cap ,start) (,end-cap ,end) (,circ-cap ,circular) (,inc-fcn 'iter-next) (,rev-cap ,reverse) ,early-exit) (cond ((and ,circ-cap ,rev-cap) (setf ,inc-fcn #'(lambda (dl it) (let ((rv (iter-prev dl it))) (or rv (iter-back dl)))))) ((and ,circ-cap (not ,rev-cap)) (setf ,inc-fcn #'(lambda (dl it) (let ((rv (iter-next dl it))) (or rv (iter-front dl)))))) ((and (not ,circ-cap) ,rev-cap) (setf ,inc-fcn 'iter-prev))) (unless ,start-cap (if ,rev-cap (setf ,start-cap (iter-back ,dl-cap)) (setf ,start-cap (iter-front ,dl-cap)))) (when ,end-cap (setf ,early-exit #'(lambda (x) (eq x ,end-cap)))) (do* ((,,first-sym ,start-cap (funcall ,inc-fcn ,dl-cap ,,first-sym)) ,,@(mapcar #'(lambda (x y) ``(,,x (and ,,y (funcall ,,'inc-fcn ,,'dl-cap ,,y)) (and ,,y (funcall ,,'inc-fcn ,,'dl-cap ,,y)))) (cdr symbols) symbols)) ((not ,,last-sym)) ,@body (when (and ,early-exit (funcall ,early-exit ,,first-sym)) (return))))))))
While there might be some minor adjustments to be made, this macro does what I need for iteration over a dl-list object.