ARNESI

Various flow control operators 

Anaphoric conditionals 

(defmacro if-bind (var test then &optional else)
  "Anaphoric IF control structure.

VAR (a symbol) will be bound to the primary value of TEST. If
TEST returns a true value then THEN will be executed, otherwise
ELSE will be executed."
  `(let ((,var ,test))
     (if ,var ,then ,else)))

(defmacro aif (test then &optional else)
  "Just like IF-BIND but the var is always IT."
  `(if-bind it ,test ,then ,else))

(defmacro when-bind (var test &body body)
  "Just like @code{WHEN} except @var{var} will be bound to the
  result of @var{test} in @var{body}."
  `(if-bind ,var ,test (progn ,@body)))

(defmacro awhen (test &body body)
  "Just like @code{WHEN} expect the symbol @code{IT} will be
  bound to the result of @var{test} in @var{body}."
  `(when-bind it ,test ,@body))

(defmacro cond-bind (var &body clauses)
  "Just like @code{COND} @var{var} will be bound to the result of
  the first cond which returns true."
  (if clauses
      (destructuring-bind ((test &rest body) &rest others)
          clauses
        `(if-bind ,var ,test
                  (progn ,@body)
                  (cond-bind ,var ,@others)))
      nil))

(defmacro acond (&rest clauses)
  "Just like @code{COND-BIND} except the var is automatically
  @code{IT}."
  `(cond-bind it ,@clauses))

(defmacro aand (&rest forms)
  `(and-bind it ,@forms))

(defmacro and-bind (var &rest forms)
  (if forms
      `(when-bind ,var ,(first forms)
         (and-bind ,var ,@(cdr forms)))
      t))

Whichever 

(defmacro whichever (&rest possibilities)
  "Evaluates one (and only one) of its args, which one is chosen at random"
  `(ecase (random ,(length possibilities))
     ,@(loop for poss in possibilities
             for x from 0
             collect (list x poss))))

XOR - The missing conditional 

(defmacro xor (&rest datums)
  "Evaluates the args one at a time. If more than one arg returns true
  evaluation stops and NIL is returned. If exactly one arg returns
  true that value is retuned."
  (let ((state (gensym "XOR-state-"))
        (block-name (gensym "XOR-block-"))
        (arg-temp (gensym "XOR-arg-temp-")))
    `(let ((,state nil)
           (,arg-temp nil))
       (block ,block-name
         ,@(loop
              for arg in datums
              collect `(setf ,arg-temp ,arg)
              collect `(if ,arg-temp
                           ;; arg is T, this can change the state
                           (if ,state
                               ;; a second T value, return NIL
                               (return-from ,block-name nil)
                               ;; a first T, swap the state
                               (setf ,state ,arg-temp))))
         (return-from ,block-name ,state)))))

Switch 

(defmacro switch ((obj &key (test #'eql)) &body clauses)
  "Evaluate the first clause whose car satisfies @code{(funcall
  test car obj)}."
  ;; NB: There is no need to do the find-if and the remove here, we
  ;; can just as well do them with in the expansion
  (let ((default-clause (find-if (lambda (c) (eq t (car c))) clauses)))
    (when default-clause
      (setf clauses (remove default-clause clauses :test #'equalp)))
    (let ((obj-sym (gensym))
          (test-sym (gensym)))
      `(let ((,obj-sym ,obj)
             (,test-sym ,test))
         (cond
           ,@(mapcar (lambda (clause)
                       (let ((keys (ensure-list (car clause)))
                             (form (cdr clause)))
                         `((or ,@(mapcar (lambda (key)
					   `(funcall ,test-sym ',key ,obj-sym))
					 keys))
			   ,@form)))
                     clauses)
           ,@(when default-clause
                   `((t ,@(cdr default-clause)))))))))

(defmacro eswitch ((obj &key (test #'eql)) &rest body)
  "Like @code{SWITCH} but signals an error if no clause succeds."
  (let ((obj-sym (gensym)))
    `(let ((,obj-sym ,obj))
       (switch (,obj-sym :test ,test)
               ,@body
               (t
                (error "Unmatched SWITCH. Testing against ~A."
                       ,obj-sym))))))

(defmacro cswitch ((obj &key (test #'eql)) &rest body)
  "Like @code{SWITCH} but signals a continuable error if no
  clause matches."
  (let ((obj-sym (gensym)))
    `(let ((,obj-sym ,obj))
       (switch (,obj-sym :test ,test)
               ,@body
               (t
                (cerror "Unmatched SWITCH. Testing against ~A."
                        ,obj-sym))))))

Eliminating Nesting 

(defmacro with* (&body body)
  (cond
    ((cddr body)
     (append (first body) `((with* ,@(cdr body)))))
    ((cdr body)
     `(,@(first body) ,(second body)))
    (body (first body))
    (t nil)))