macros.lisp

   1 (in-package :alexandria)
   2
   3 (defmacro with-unique-names (names &body forms)
   4   "Binds each variable named by NAMES to a unique symbol."
   5   `(let ,(mapcar (lambda (name)
   6                    `(,name (gensym ,(symbol-name name))))
   7                  names)
   8      ,@forms))
   9
  10 (defmacro once-only (names &body forms)
  11   "Evaluates FORMS with NAMES rebound to temporary variables,
  12 ensuring that each is evaluated only once.
  13
  14 Example:
  15   (defmacro cons1 (x) (once-only (x) `(cons ,x ,x)))
  16   (let ((y 0)) (cons1 (incf y))) => (1 . 1)"
  17   (let ((gensyms (make-gensym-list (length names) "ONCE-ONLY")))
  18     ;; bind in user-macro
  19     `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string n))))
  20                    gensyms names)
  21        ;; bind in final expansion
  22        `(let (,,@(mapcar (lambda (g n) ``(,,g ,,n)) gensyms names))
  23           ;; bind in user-macro
  24           ,(let ,(mapcar #'list names gensyms)
  25              ,@forms)))))
  26
  27 (defun parse-body (body &key documentation)
  28   "Parses BODY into documentation string, declarations, and remaining forms.
  29 Documentation strings are recognized only if DOCUMENTATION is true. Returns
  30 three values: list of remaining forms, list of declarations, and documentation
  31 string if any."
  32   (let ((doc nil)
  33         (decls nil)
  34         (current nil))
  35     (tagbody
  36      :declarations
  37        (setf current (car body))
  38        (when (and documentation (stringp current) (not doc) (cdr body))
  39          (setf doc (pop body))
  40          (go :declarations))
  41        (when (starts-with 'declare current)
  42          (push (pop body) decls)
  43          (go :declarations)))
  44     (values body (nreverse decls) doc)))