From ... From: Erik Naggum Subject: Re: `letf' in Common Lisp? Date: 2000/06/02 Message-ID: <3168928070841171@naggum.no>#1/1 X-Deja-AN: 630162205 References: mail-copies-to: never Content-Type: text/plain; charset=us-ascii X-Complaints-To: newsmaster@eunet.no X-Trace: oslo-nntp.eunet.no 959940041 8032 195.0.192.66 (2 Jun 2000 10:00:41 GMT) Organization: Naggum Software; vox: +47 8800 8879; fax: +47 8800 8601; http://www.naggum.no User-Agent: Gnus/5.0803 (Gnus v5.8.3) Emacs/20.6 Mime-Version: 1.0 NNTP-Posting-Date: 2 Jun 2000 10:00:41 GMT Newsgroups: comp.lang.lisp * Ivar Rummelhoff | 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.