Common Lisp Control Structures

This article exists to showcase some Common Lisp macros and other curiosities I've written.  I don't
tend to go heavily into Lisp of this sort, although it's the most pure and rewarding Lisp hacking; I
prefer macros for heavier work or merely to save typing.  Some claim the value of metaprogramming is
in adding new, well-formed control structures and the like; I'd make the argument a good deal of the
value comes from being able to devise and use haphazard or even malformed macros for brief contexts.

All code fragments here are licensed under the GNU Affero General Public License version three.

Common Lisp features a DOLIST and DOTIMES which are often more pleasant than using a DO or LOOP, yet
those often fall short of precisely what's wanted, necessitating the heavier LOOP; these amend such:

(defmacro dovector ((symbol vector &optional return) &body progn)
  "Iterate with SYMBOL bound to elements of VECTOR, returning RETURN.  This is analogous to DOLIST."
  `(loop :for ,symbol :across ,vector :do (tagbody ,@progn)
         :finally (let (,symbol) (declare (ignorable ,symbol)) (return ,return))))

There are two forms of this REPEAT, being a DOTIMES without the variable, both with some advantages:

(defmacro repeat (count &body progn)
  "Iterate, repeating the body COUNT times, ultimately returning the value of that final iteration."
  `(loop :repeat (1- ,count) :doing (progn ,@progn) :finally (return (progn ,@progn))))

(defmacro repeat (count &body progn &aux (gensym (gensym)) (gentemp (gensym)))
  "Iterate, repeating the body COUNT times, ultimately returning the value of that final iteration."
  `(let (,gentemp) (dotimes (,gensym ,count ,gentemp) (declare (ignorable ,gensym))
                            (setq ,gentemp (progn ,@progn)))))

This DORANGE addresses the DOTIMES starting point of zero, when arithmetic isn't wanted every cycle:

(defmacro dorange ((symbol first last &optional return) &body progn)
  "Iterate with SYMBOL bound from FIRST to LAST, inclusive, returning RETURN, analogous to DOTIMES."
  `(loop :for ,symbol :from ,first :to ,last :doing (tagbody ,@progn)
         :finally (let (,symbol) (declare (ignorable ,symbol)) (return ,return))))

I suppose CONSTANTLY does handle these two boolean functions much better, but I provide them anyway:

(setf (symbol-function 'true) (constantly t)
      (documentation 'true 'function) "This function accepts any arguments, always returning T."
      (symbol-function 'false) (constantly nil)
      (documentation 'false 'function) "This function accepts any arguments, always returning NIL.")

I see only OR and AND for control structures, but XOR is alluring in any case; here are three forms:

(defmacro xor (&body rest) ;This version lacks associativity and so shouldn't really be used at all.
  "Evaluate all the forms, with no short-circuiting, and return that XOR of the accumulated values."
  (reduce (lambda (first rest) `(eql ,first (not ,rest))) rest :from-end t :initial-value nil))

(defmacro xor (&body rest)
  "Evaluate all the forms, with no short-circuiting, and return that XOR of the accumulated values."
  (reduce (lambda (first rest) `(if ,first (not ,rest) ,rest)) rest :from-end t :initial-value nil))

(defmacro xor (&body rest)
  "Evaluate all the forms, with no short-circuiting, and return that XOR of the accumulated values."
  `(svref #(nil t) (logxor ,@(mapcar (lambda (if) `(if ,if 1 0)) rest))))

This is a loop which only ceases when the boolean function provided reports a difference in returns:

(defmacro while (function &body progn &aux (gensym (gensym)) (gentemp (gensym)))
  "Loop at least once, until the value returned changes, determined by function, returning changed."
  `(loop :with ,gensym := (progn ,@progn) :for ,gentemp := (progn ,@progn)
         :doing (if (,function ,gensym ,gentemp) (setq ,gensym ,gentemp) (loop-finish))
         :finally (return ,gentemp)))

I often find myself wanting this primitive I enjoy from APL; this is a poor form I'll improve later:

(defun adbmal (function)
  "Return a function which behaves just as function but accepting parameters in the opposite order."
  (lambda (&rest rest) (apply function (reverse rest))))

I intend to update this article with more such curiosities as I feel the want, as in my APL article.
Some features I want, such as multiple-array displacement, may not be feasibly added by mere macros.
.