Skip to content

Instantly share code, notes, and snippets.

@Dyrcona
Created Nov 28, 2020
Embed
What would you like to do?
Common Lisp looping macros, written for practice that may be useful to someone.
;;; ------------------------------------------------------------------------
;;; Copyright © 2020 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
(go ,tag))
(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
(go ,tag))
(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
(go ,tag))
(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
(go ,tag))
(return-from ,name ,return-form))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment