Subject: Re: `letf' in Common Lisp?
From: Erik Naggum <erik@naggum.no>
Date: 2000/06/02
Newsgroups: comp.lang.lisp
Message-ID: <3168928070841171@naggum.no>

* Ivar Rummelhoff <ivarru@math.uio.no>
| The Emacs lisp CL-package (by Dave Gillespie) has a convenient macro
| named `letf'.  Do anyone know if there is a Common Lisp implementation
| available somewhere?

  Some time ago, I wrote these, and put them in my customized lisp,
  but I have not used them much since then.

(defun letf-bindings (bindings environment)
  (let ((savers ())
	(setters ())
	(restorers ()))
    (loop
     for (place values-form) in bindings do
      (multiple-value-bind (vars vals stores setter getter)
	  (get-setf-expansion place environment)
	(let ((save (gensym))
	      (store (first stores))
	      (multiple-values (rest stores)))
	  (setf savers (nconc (nreverse (mapcar #'list vars vals)) savers))
	  (push `(,save ,(if multiple-values
			   `(multiple-value-list ,getter)
			   getter))
		savers)
	  (push (if multiple-values
		  `(multiple-value-bind ,stores ,values-form ,setter)
		  `(let ((,store ,values-form)) ,setter)) 
		setters) 
	  (push (if multiple-values
		  `(multiple-value-bind ,stores (values-list ,save) ,setter)
		  `(let ((,store ,save)) ,setter))
		restorers))))
    (values (nreverse savers) (nreverse setters) (nreverse restorers))))

(defmacro letf* (bindings &body body &environment environment)
  "Simulate serial shallow binding of places in BINDINGS around BODY."
  (if bindings
    (multiple-value-bind (savers setters restorers)
	(letf-bindings (list (first bindings)) environment)
      `(let* (,@savers)
	 ,@setters
	 (unwind-protect
	     ,`(letf* ,(rest bindings) ,@body)
	   ,@restorers)))
    `(progn ,@body)))

(defmacro letf (bindings &body body &environment environment)
  "Simulate parallell shallow binding of places in BINDINGS around BODY."
  (if bindings
    (multiple-value-bind (savers setters restorers)
	(letf-bindings bindings environment)
      `(let* (,@savers)
	 ,@setters
	 (unwind-protect
	     (progn ,@body)
	   ,@restorers)))
    `(progn ,@body)))

#:Erik
-- 
  If this is not what you expected, please alter your expectations.