+
+;;; (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))))
+\f
+;;; Delayed evaluation
+(defmacro delay (form)
+ `(cons nil (lambda () ,form)))
+
+(defun force (promise)
+ (cond ((not (consp promise)) promise)
+ ((car promise) (cdr promise))
+ (t (setf (car promise) t
+ (cdr promise) (funcall (cdr promise))))))
+
+(defun promise-ready-p (promise)
+ (or (not (consp promise))
+ (car promise)))