So, in a series of posts, I talked about Lisp macros and their power.

• Part 1
• Part 2
• Part 3
• Part 4
• Part 5
• Part 6
• Part 7
• Part 8
• Part 9

I started out saying that there were features of Lisp that I missed when programming in other languages.  Ultimately, the languages are for the programmer, not the computer.  If your language has support for the functions you need, and the compiler is a good one, the computer is perfectly fine running your code in whatever language you choose.  Once those essentials have been covered, the choice of language comes down to familiarity and ease of use.

In this series of articles, I described how to set up Lisp macros to create a new looping structure in the language, for a particular use case I had in my work.  I was writing looping code over and over again, in a format like this:
 

(labels
    ((circular-inc (dlist iter)
       (let ((rv (dl-list:iter-next dlist iter)))
         (or rv (dl-list:iter-front dlist)))))

  (do* ((iter0 
         (dl-list:iter-front dlist) 
         (circular-inc dlist iter0))

        (iter1 
         (circular-inc dlist iter0) 
         (circular-inc dlist iter0)))

      (nil)
    (let ((contents0 
           (dl-list:iter-contents dlist iter0))
          (contents1 
           (dl-list:iter-contents dlist iter1)))

      (perform-some-function-on-content-pair contents0 
                                             contents1)
      (when (eq iter0 (dl-list:iter-back dlist))
        (return)))))

With the help of the macros, this can be rewritten:
 

(dl-list:2-value-loop (dlist contents0 contents1 :circular t)
  (perform-some-function-on-contents contents0 
                                     contents1))

This not only saves typing, and reduces the opportunity for typos introducing bugs, but it makes the block of code immediately readable to the user.  The code is much more self-documenting, as the maintainer doesn’t have to scan through a dozen lines of boilerplate code to see what this particular loop does. The programmer doesn’t have to look out for variable-name collisions in the iterator variables, (s)he can rely on the macro to avoid that danger.  To a person reviewing or editing the code, it is sufficient to know that this loop iterators over all pairs of values in a circular list, without needing to know exactly how that is actually implemented.  It hides the boring, repetitive parts out of sight, much the way a compiler or assembler hides registers and memory addresses from the C programmer.

In C++ you can use classes and methods to reduce some of the on-screen clutter, but building a new flow-control structure and using it this concisely is difficult, if even possible.  When I converted my code to C++, I wound up with specialized iterators, pair_iterators, triplet_iterators, and when you start putting in const-types and reverse iterators you wind up with hundreds of lines of code that is boring to write.  Even then, the C++ version is less concise when used in the code.

So, that’s one of the things I miss when I’m not programming in Lisp, the ability to build new flow-control structures that aid greatly in keeping the code concise and readable.

I mentioned earlier that the macro-generating macro was essentially done.  There is one more new control loop that I find frequent need of.  Sometimes, it is sufficient to loop over the values, I don’t actually need a user-visible variable with the iterator itself.  So, we can build a new looping construct that loops through the contents of the dl-list, instead of through iterators into the dl-list.  This time, we’ll jump right to the general case.

(defmacro create-n-value-loop (n name iter-loop-to-use)
  (assert (and (integerp n) (> n 0)))
  (let (value-symbols iter-symbols)
    (dotimes (i n)
      (push (intern (format nil "ITER~D" i)) iter-symbols)
      (push (intern (format nil "VALUE~D" i)) value-symbols))
    (setf iter-symbols (reverse iter-symbols))
    (setf value-symbols (reverse value-symbols))
    `(defmacro ,name ((dl-list ,@value-symbols 
                               &key start end circular reverse)
                      &body body)
       (let ((dl-cap (gensym))
             ,@(mapcar #'(lambda (x) 
                           `(,x (gensym))) 
                       iter-symbols))
         `(let ((,dl-cap ,dl-list))
            (,',iter-loop-to-use 
             (,dl-cap ,,@iter-symbols
                      :start ,,'start
                      :end ,,'end
                      :circular ,,'circular
                      :reverse ,,'reverse)
             (let (,,@(mapcar 
                       #'(lambda (x y) 
                           ``(,,x 
                              (iter-contents ,,'dl-cap ,,y)))
                       value-symbols iter-symbols))
               ,@body)))))))

This creates macros like value-loop, the by-hand version of which is reproduced here:
 

(defmacro value-loop ((dl-list value0 
                               &key start end circular reverse)
                      &body body)
  (let ((dl-cap (gensym))
        (iter (gensym)))
    `(let ((,dl-cap ,dl-list))
       (iter-loop (,dl-cap ,iter 
                           :start ,start :end ,end
                           :circular ,circular :reverse ,reverse)
        (let ((,value0 (dl-list:iter-contents ,dl-cap ,iter)))
          ,@body)))))

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.

Continuing from part 6, we’re now getting into some macro magic.  We noticed a pattern between the basic iter-loop, 2-iter-loop, and 3-iter-loop.  We create a number of iterator names as placeholders.  The first one, we initialize from the beginning of the dl-list.  The second one we assign and update to the iter-next of the first iterator.  The third iterator we assign and update to the iter-next of the second iterator, and so on.  The exit condition is when the last iterator is nil.  Can we automate this?  Can we make a macro that produces macros of any number of iterators?  Yes.  Here’s the basic version of that macro:
 

(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) &body body)
       (let ((dl-cap (gensym)))
         `(let ((,dl-cap ,dl-list))
            (do* ((,,first-sym (iter-front ,dl-cap) 
                               (iter-next ,dl-cap ,,first-sym))
                  ,,@(mapcar #'(lambda (x y) 
                                 ``(,,x 
                                    (and ,,y 
                                         (iter-next ,,'dl-cap ,,y))
                                    (and ,,y 
                                         (iter-next ,,'dl-cap ,,y))))
                             (cdr symbols) symbols))
                 ((not ,,last-sym))
              ,@body))))))

This macro would be invoked with an ‘n’, and the name of the looping macro to be created.  So, executing the command

(create-n-iter-loop 1 iter-loop)

produces the simple single-iterator macro.  We can observe this by executing the command

(macroexpand-1 '(create-n-iter-loop 1 iter-loop))

the output of which is:
 

(DEFMACRO ITER-LOOP ((DL-LIST::DL-LIST ITER0) &BODY DL-LIST::BODY)
  (LET ((DL-LIST::DL-CAP (GENSYM)))
    `(LET ((,DL-LIST::DL-CAP ,DL-LIST::DL-LIST))
       (DO* ((,ITER0 (DL-LIST:ITER-FRONT ,DL-LIST::DL-CAP)
                     (DL-LIST:ITER-NEXT ,DL-LIST::DL-CAP ,ITER0)))
            ((NOT ,ITER0))
         ,@DL-LIST::BODY))))

This code is the same as our original iter-loop.  Similarly, we can produce the 2-iter-loop:
 

(DEFMACRO 2-ITER-LOOP ((DL-LIST::DL-LIST ITER0 ITER1) &BODY DL-LIST::BODY)
  (LET ((DL-LIST::DL-CAP (GENSYM)))
    `(LET ((,DL-LIST::DL-CAP ,DL-LIST::DL-LIST))
       (DO* ((,ITER0 (DL-LIST:ITER-FRONT ,DL-LIST::DL-CAP)
                     (DL-LIST:ITER-NEXT ,DL-LIST::DL-CAP ,ITER0))
             (,ITER1 (AND ,ITER0 (DL-LIST:ITER-NEXT ,DL-LIST::DL-CAP ,ITER0))
                     (AND ,ITER0 (DL-LIST:ITER-NEXT ,DL-LIST::DL-CAP ,ITER0))))
            ((NOT ,ITER1))
         ,@DL-LIST::BODY))))

and the 3-iter-loop macro:
 

(DEFMACRO 3-ITER-LOOP
          ((DL-LIST::DL-LIST ITER0 ITER1 ITER2) &BODY DL-LIST::BODY)
  (LET ((DL-LIST::DL-CAP (GENSYM)))
    `(LET ((,DL-LIST::DL-CAP ,DL-LIST::DL-LIST))
       (DO* ((,ITER0 (DL-LIST:ITER-FRONT ,DL-LIST::DL-CAP)
                     (DL-LIST:ITER-NEXT ,DL-LIST::DL-CAP ,ITER0))
             (,ITER1 (AND ,ITER0 (DL-LIST:ITER-NEXT ,DL-LIST::DL-CAP ,ITER0))
                     (AND ,ITER0 (DL-LIST:ITER-NEXT ,DL-LIST::DL-CAP ,ITER0)))
             (,ITER2 (AND ,ITER1 (DL-LIST:ITER-NEXT ,DL-LIST::DL-CAP ,ITER1))
                     (AND ,ITER1 (DL-LIST:ITER-NEXT ,DL-LIST::DL-CAP ,ITER1))))
            ((NOT ,ITER2))
         ,@DL-LIST::BODY))))

So, why go to all that trouble of generalizing the macro?  Well, I need all three looping constructs.  iter-loop, 2-iter-loop, 3-iter-loop.  They’re very similar macros, but coding them three times raises the possibility that there will be typos that introduce subtle errors, or bugs might be fixed in two of the macros, but not in the third.  By making sure that they’re all created from a single block of code, I increase the reliability.  I can make sure that all of the macros have the same API, that they use the same keywords, and if one day I decide I need a 4-iter-loop, it’s no effort at all to create it and know that it’s running the same basic code as all the others.

So, now that we’ve written the generalized basic iterator macro-generating macro, it’s time to put back the bells and whistles.  Circular lists, start/end points, and backward traversal.  That’s for next time.

Now, we’re interested in maybe running the iterators backwards as well as forwards.  This is a fairly simple adjustment to the macro.  We create a new keyword parameter, :reverse.  Now, the iterator increment function has four possible values.  It can be the simple next-iter, it can be a next-iter with wrap-around, it can be prev-iter, or prev-iter with wrap-around.  These cases are handled in the macro here.  This is actually a very simple modification to the macro.  After this, we’ll start doing some more complicated/interesting things.
   

(defmacro iter-loop ((dl-list iter &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 ((,iter ,start-cap (funcall ,inc-fcn ,dl-list ,iter)))
           ((not ,iter))
         ,@body
         (when (and ,early-exit
                    (funcall ,early-exit ,iter))
           (return))))))

So, where are we going next?  Well, at the beginning of this series of articles, I mentioned that my real-world application involves looking at pairs and triplets of points in a doubly-linked list.  So, let’s go back in time a bit, to our basic single iterator macro.  What if we wanted a macro that did the same thing, but with two, or even three consecutive iterators, all incrementing together?  We’d need to be a bit careful about what happens at the end of the loop, but otherwise it’s very similar to what we had before.  For a non-circular list of N elements, we have N-1 pairs, or N-2 triplets.  Here are the macros that would perform these operations.  The single iterator version again, and the 2- and 3- iterator versions:
 

(defmacro iter-loop ((dl-list iter) &body body)
  (let ((dl-cap (gensym)))
    `(let ((,dl-cap ,dl-list))
       (do ((,iter (iter-front ,dl-cap) (iter-next ,dl-cap ,iter)))
           ((not ,iter))
         ,@body))))

(defmacro 2-iter-loop ((dl-list iter1 iter2) &body body)
  (let ((dl-cap (gensym)))
    `(let ((,dl-cap ,dl-list))
       (do* ((,iter1 (iter-front ,dl-cap) (iter-next ,dl-cap ,iter1))
             (,iter2 (and ,iter1 (iter-next ,dl-cap ,iter1))
                     (and ,iter1 (iter-next ,dl-cap ,iter1))))
           ((not ,iter2))
         ,@body))))

(defmacro 3-iter-loop ((dl-list iter1 iter2 iter3) &body body)
  (let ((dl-cap (gensym)))
    `(let ((,dl-cap ,dl-list))
       (do* ((,iter1 (iter-front ,dl-cap) 
                     (iter-next ,dl-cap ,iter1))
             (,iter2 (and ,iter1 (iter-next ,dl-cap ,iter1))
                     (and ,iter1 (iter-next ,dl-cap ,iter1)))
             (,iter3 (and ,iter2 (iter-next ,dl-cap ,iter2))
                     (and ,iter2 (iter-next ,dl-cap ,iter2))))
           ((not ,iter3))
         ,@body))))

There’s a pattern here, and we’re going to make use of that soon.