Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv8833/src/code
Modified Files:
early-extensions.lisp
Log Message:
0.8.2.39:
* New macro SB!INT:BINDING*, uniting LET*, M-V-BIND and AWHEN;
* add simple inference of iteration variable type;
* SAME-LEAF-REF-P: look through CAST chains;
* wrap all uses of handle_rt_signal into #!+sb-thread;
* (SB-ACLREPL): CD-CMD takes one argument, not two.
Index: early-extensions.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-extensions.lisp,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -d -r1.64 -r1.65
--- early-extensions.lisp 16 Aug 2003 21:46:30 -0000 1.64
+++ early-extensions.lisp 18 Aug 2003 07:53:35 -0000 1.65
@@ -1097,6 +1097,33 @@
(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)
|