X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/7769f8fdb8694fe33ebb6198978d96e22e05c027..0eed4749891adf0a7be89e786b8968ee805a8d41:/mdw-base.lisp diff --git a/mdw-base.lisp b/mdw-base.lisp index 4bed97d..2bad2c2 100644 --- 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.