mdw-base.lisp: Rewrite `setf-default' using `with-places/gensyms'.

Now that we have `with-places' and friends, there's no reason to write a
`setf'-like macro out longhand ever again.

diff --git a/mdw-base.lisp b/mdw-base.lisp
index 4bed97d..2bad2c2 100644 (file)
--- a/mdw-base.lisp
+++ b/mdw-base.lisp
@@ -353,30 +353,21 @@
   (do-case2-like 'ecase vform clauses))
 
 (export 'setf-default)
-(defmacro setf-default (&rest specs &environment env)
+(defmacro setf-default (&rest specs)
   "Like setf, but only sets places which are currently nil.
 
    The arguments are an alternating list of PLACEs and DEFAULTs.  If a PLACE
    is nil, the DEFAULT is evaluated and stored in the PLACE; otherwise the
    default is /not/ stored.  The result is the (new) value of the last
    PLACE."
-  (labels ((doit (specs)
-            (cond ((null specs) nil)
-                  ((null (cdr specs))
-                   (error "Odd number of arguments for SETF-DEFAULT."))
-                  (t
-                   (let ((place (car specs))
-                         (default (cadr specs))
-                         (rest (cddr specs)))
-                     (multiple-value-bind
-                         (vars vals store-vals writer reader)
-                         (get-setf-expansion place env)
-                       `(let* ,(mapcar #'list vars vals)
-                          (or ,reader
-                              (multiple-value-bind ,store-vals ,default
-                                ,writer))
-                          ,@(and rest (list (doit rest))))))))))
-    (doit specs)))
+  `(progn ,@(do ((list nil)
+                (specs specs (cddr specs)))
+               ((endp specs) (nreverse list))
+             (unless (cdr specs)
+               (error "Odd number of arguments for `setf-default'."))
+             (push (with-places/gensyms ((place (car specs)))
+                     `(or ,place (setf ,place ,(cadr specs))))
+                   list))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Update-in-place macros built using with-places.