Common Lisp looping macros, written for practice that may be useful to someone.

while.lisp

;;; ------------------------------------------------------------------------
;;; Copyright © 2020, 2023 Jason Stephenson <jason@sigio.com>
;;;
;;; Permission to use, copy, modify, and distribute this software for any
;;; purpose with or without fee is hereby granted, provided that the above
;;; copyright notice and this permission notice appear in all copies.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
;;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
;;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
;;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
;;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
;;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
;;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;; ------------------------------------------------------------------------

;;; These macros are intended to imitate the while and do { ... }
;;; while loop constructs of the C programming language with the
;;; addition of a return form argument, similar to those of the Common
;;; Lisp do macros.  The until and do-until variations are added as a
;;; complement to the positive logic version and to emulate the
;;; similar constructs in Perl.  You can use the continue and break
;;; symbols inside the body code to have the same effect as the
;;; identical keywords in C.

;;; The macros were written as a proof of concept and practice for the
;;; author.  They don't really do anything that you cannot do already
;;; with the existing loop constructs in Common Lisp.

(defmacro while ((test &optional return-form) &body body)
  "A while loop macro... Loop while test is true, performing body. Return return-form on exit."
  (let ((name (gensym))
        (tag (gensym)))
    `(symbol-macrolet
         ((break (return-from  ,name ,return-form))
          (continue (go ,tag)))
       (block ,name
         (tagbody ,tag
            (when ,test
              ,@body
              continue)
            (return-from ,name ,return-form))))))

(defmacro until ((test &optional return-form) &body body)
  "An until loop macro... Loop until test is true, performing body. Return return-form on exit."
  (let ((name (gensym))
        (tag (gensym)))
    `(symbol-macrolet
         ((break (return-from  ,name ,return-form))
          (continue (go ,tag)))
       (block ,name
         (tagbody ,tag
            (unless ,test
              ,@body
              continue)
            (return-from ,name ,return-form))))))

(defmacro do-while ((test &optional return-form) &body body)
  "A do {...} while loop macro... Loop while test is true, performing body. Perform body at least once. Return return-form on exit."
  (let ((name (gensym))
        (tag (gensym)))
    `(symbol-macrolet
         ((break (return-from  ,name ,return-form))
          (continue (go ,tag)))
       (block ,name
         (tagbody ,tag
            ,@body
            (when ,test
              continue)
            (return-from ,name ,return-form))))))

(defmacro do-until ((test &optional return-form) &body body)
  "A do {...} until loop macro... Loop until test is true, performing body. Perform body at least once. Return return-form on exit."
  (let ((name (gensym))
        (tag (gensym)))
    `(symbol-macrolet
         ((break (return-from  ,name ,return-form))
          (continue (go ,tag)))
       (block ,name
         (tagbody ,tag
            ,@body
            (unless ,test
              continue)
            (return-from ,name ,return-form))))))

(defmacro repeat ((x &optional return-form) &body body)
  "Repeat BODY X times. You can leave early or continue with BREAK and CONTINUE. Return return-form on exit."
  (let ((name (gensym))
        (tag (gensym))
        (limit (gensym))
        (i (gensym)))
    `(symbol-macrolet
         ((break (return-from ,name ,return-form))
          (continue (go ,tag)))
       (let ((,i 0) (,limit ,x))
         (block ,name
           (tagbody ,tag
              (when (< ,i ,limit)
                ,@body
                (incf ,i)
                continue)
              (return-from ,name ,return-form)))))))