X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-extensions.lisp;h=81b6f7b046a5bf0285d767fee01697d73b18640e;hb=77af6d16968262049d6dadfb5521af7a8a7c6868;hp=7435069fb9800104bb77c8ee010b48e4db7d293f;hpb=b7cfa0e5e726c2037ba2c6cb32406ff7e9764dd2;p=sbcl.git

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 7435069..81b6f7b 100644
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -1097,6 +1097,33 @@ which can be found at <http://sbcl.sourceforge.net/>.~:@>"
                (let ((it ,test)) (declare (ignorable it)),@body)
                (acond ,@rest))))))
 
+;;; (binding* ({(name initial-value [flag])}*) body)
+;;; FLAG may be NIL or :EXIT-IF-NULL
+;;;
+;;; This form unites LET*, MULTIPLE-VALUE-BIND and AWHEN.
+(defmacro binding* ((&rest bindings) &body body)
+  (let ((bindings (reverse bindings)))
+    (loop with form = `(progn ,@body)
+          for binding in bindings
+          do (destructuring-bind (names initial-value &optional flag)
+                 binding
+               (multiple-value-bind (names declarations)
+                   (etypecase names
+                     (null
+                      (let ((name (gensym)))
+                        (values (list name) `((declare (ignorable ,name))))))
+                     (symbol
+                      (values (list names) nil))
+                     (list
+                      (values names nil)))
+                 (setq form `(multiple-value-bind ,names
+                                 ,initial-value
+                               ,@declarations
+                               ,(ecase flag
+                                       ((nil) form)
+                                       ((:exit-if-null)
+                                        `(when ,(first names) ,form)))))))
+          finally (return form))))
 
 ;;; Delayed evaluation
 (defmacro delay (form)