labels

dynamic-labels.lisp

(defmacro dynamic-labels
    ((&rest definitions) &body body)
  (let ((olds (mapcar #'(lambda (x)
			  (declare (ignore x))
			  (gensym))
		      definitions)))
    `(let ,(mapcar
	    #'(lambda (sym def)
		`(,sym ,(and (fboundp (car def)) (symbol-function (car def)))))
	    olds
	    definitions)
       ,@(mapcar
	  #'(lambda (def)
	      `(,(if (generic-function-p (car def))
		     `cl:defmethod
		     `cl:defun)
		 ,@def))
	  definitions)
       (unwind-protect
	    (progn
	      ,@body)
	 ,@(mapcar
	    #'(lambda (old def)
		`(if ,old
		     (setf (symbol-function ',(car def))
			   ,old)
		     (fmakunbound ',(car def))))
	    olds
	    definitions)))))