Some Lisp musings, part 8

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.

Leave a Reply

Your email address will not be published. Required fields are marked *

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

*

反垃圾邮件 / Anti-spam question * Time limit is exhausted. Please reload CAPTCHA.