[alexandria-cvs] updated branch master: 34949e1... new macro: ENSUREF

[Nikodemus Siivola]

The branch master has been updated:
       via  34949e184e892240d0197bae46ad0924fcb2f51b (commit)
      from  a2c71efed048596cb0fbc734e814248d00a2601f (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 34949e184e892240d0197bae46ad0924fcb2f51b
Author: Nikodemus Siivola <nikodemus at random-state.net>
Date:   Mon Mar 8 13:48:49 2010 +0200

    new macro: ENSUREF
    
      Code by: Tobias C. Rittweiler <tcr at freebits.de>

-----------------------------------------------------------------------

Summary of changes:
 control-flow.lisp |   39 +++++++++++++++++++++++++++++++++++++++
 package.lisp      |    1 +
 2 files changed, 40 insertions(+), 0 deletions(-)

diff --git a/control-flow.lisp b/control-flow.lisp
index bf64728..8225442 100644
--- a/control-flow.lisp
+++ b/control-flow.lisp
@@ -104,3 +104,42 @@ NIL."
   "Like CL:MULTIPLE-VALUE-PROG1, except it saves the values of the
 second form."
   `(progn ,first-form (multiple-value-prog1 ,second-form , at body)))
+
+(defmacro ensuref (place thing &rest more &environment env)
+ "If PLACE evaluates to NIL set it to THING, otherwise leave PLACE unchanged.
+
+\(ENSUREF PLACE THING) is approximately equivalent to
+
+  (SETF PLACE (OR PLACE THING))
+
+except that ENSUREF ensures that PLACE is evaluated only once, and except that
+PLACE isn't set at all if it evaluated to NIL.
+
+Example:
+
+  (let ((a nil)
+        (b :foo)
+        (c (list 1 2 nil 4)))
+    (ensuref a :a
+             b :b
+             (third c) :c)
+    (values a b c))
+
+       ==> :A, :FOO, (1 2 :C 4)
+"
+ (multiple-value-bind (gvars vals gstorevars setter getter)
+     (get-setf-expansion place env)
+   (when (second gstorevars)
+     (error "ENSUREF does not support setting multiple values ~
+             via the (VALUES ...) place."))
+   (if (null more)
+       (let ((gstorevar (first gstorevars))
+             (gtmp (gensym "CURVAL+")))
+         `(let ,(mapcar #'list gvars vals)
+            (let ((,gtmp ,getter))
+              (if ,gtmp
+                  ,gtmp
+                  (let ((,gstorevar ,thing))
+                    ,setter)))))
+       `(progn (ensuref ,place ,thing)
+               (ensuref , at more)))))
diff --git a/package.lisp b/package.lisp
index 81c1e58..61ba06c 100644
--- a/package.lisp
+++ b/package.lisp
@@ -230,4 +230,5 @@
    #:symbolicate
    #:assoc-value
    #:rassoc-value
+   #:ensuref
    ))
-- 
Alexandria hooks/post-receive