Download

(require 'cl)
(defmacro with-gensyms (symbols &rest body)
"Execute BODY in a context where the variables in SYMBOLS are bound to
fresh gensyms."
(assert (every #'symbolp symbols))
`(let ,(mapcar* #'list symbols '#1=((gensym) . #1#))
,@body))
(defmacro once-only (symbols &rest body)
"Execute BODY in a context where the values bound to the variables in
SYMBOLS are bound to fresh gensyms, and the variables in SYMBOLS are bound
to the corresponding gensym."
(assert (every #'symbolp symbols))
(let ((gensyms (mapcar (lambda (x) (gensym)) symbols)))
`(with-gensyms ,gensyms
(list 'let (mapcar* #'list (list ,@gensyms) (list ,@symbols))
,(list* 'let (mapcar* #'list symbols gensyms)
body)))))
(put 'once-only 'lisp-indent-function 1)
(when nil
(let* ((form0 '(once-only (x) (list 'foo x)))
(form1 (macroexpand form0))
(sym1 (caaadr form1))
(form2 (eval `(let ((x '(bar))) ,form)))
(sym2 (caaadr form2)))
(assert (equal form1
`(let ((,sym1 (gensym)))
(list 'let (mapcar* #'list (list ,sym1) (list x))
(let ((x ,sym1))
(list 'foo x))))))
(assert (equal form2
`(let ((,sym2 (bar)))
(foo ,sym2))))))
(provide 'macro-utils)