(defmacro list-match-case (target &body clauses)
(if clauses
(destructuring-bind ((test &rest progn) &rest others)
clauses
(with-unique-names (tgt binds success)
`(let ((,tgt ,target))
(multiple-value-bind (,binds ,success)
(list-match ,tgt ',test)
(declare (ignorable ,binds))
(if ,success
(let ,(mapcar (lambda (var)
`(,var (cdr (assoc ',var ,binds))))
(vars test))
(declare (ignorable ,@(vars test)))
,@progn)
(list-match-case ,tgt ,@others))))))
nil))Source Context