This public domain implementation is by David Mullen:
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun whereas->when (variable type body-continuation)
(when (null type)
(return-from whereas->when
`((when ,variable
,@(funcall body-continuation)))))
;; We have an actual type.
(if (subtypep 'null type)
`((declare (type ,type ,variable))
,@(funcall body-continuation))
`((when ,variable
(locally
(declare (type ,type ,variable))
,@(funcall body-continuation)))))))
(defmacro whereas ((&rest bindings) &body body)
(destructuring-bind ((var-list expression &optional decl-list) . more) bindings
(flet ((punt-to-interior-whereas () (if more `((whereas ,more ,@body)) body)))
(if (atom var-list)
`(let ((,var-list ,expression))
,@(whereas->when var-list
decl-list
#'punt-to-interior-whereas))
`(multiple-value-bind ,var-list ,expression
,@(labels ((one-of-multiple-values ()
(whereas->when (pop var-list)
(pop decl-list)
(if (endp var-list)
#'punt-to-interior-whereas
#'one-of-multiple-values))))
;; Each variable in VAR-LIST corresponds
;; to the parallel element of DECL-LIST.
(check-type decl-list list)
(one-of-multiple-values)))))))
Examples
(whereas (((name present-p)
(gethash ...)
((or null string))))
(string-capitalize name))
;;; Macro expansion
;;; ---------------
(MULTIPLE-VALUE-BIND (NAME PRESENT-P)
(GETHASH ...)
(DECLARE (TYPE (OR NULL STRING) NAME))
(WHEN PRESENT-P (STRING-CAPITALIZE NAME)))
;;; Accessing an alist
;;; ------------------
(whereas ((cell (assoc ...) cons)
(value (cdr cell) fixnum))
(integer-length value))
;;; Macro expansion
;;; ---------------
(LET ((CELL (ASSOC ...)))
(WHEN CELL
(LOCALLY
(DECLARE (TYPE CONS CELL))
(LET ((VALUE (CDR CELL)))
(WHEN VALUE
(LOCALLY
(DECLARE (TYPE FIXNUM VALUE))
(INTEGER-LENGTH VALUE)))))))
;;; Looking up a symbol
;;; -------------------
(whereas (((symbol status)
(find-symbol ...)
(symbol keyword)))
(symbol-plist symbol))
;;; Macro expansion
;;; ---------------
(MULTIPLE-VALUE-BIND (SYMBOL STATUS)
(FIND-SYMBOL ...)
(DECLARE (TYPE SYMBOL SYMBOL))
(WHEN STATUS
(LOCALLY
(DECLARE (TYPE KEYWORD STATUS))
(SYMBOL-PLIST SYMBOL))))
Exercise
Rewrite the whereas macro using reduce.
Common Lisp Utilities