+(defun parse-dwim-is-arguments (form)
+ (destructuring-bind (test &optional reason-string &rest reason-args)
+ form
+ (let ((reason-form (if reason-string
+ `(:reason (format nil ,reason-string ,@reason-args))
+ nil))
+ (expected-value (gensym))
+ (actual-value (gensym)))
+ (flet ((make-failure-instance (type &key predicate expected actual condition)
+ (values `(make-instance ',type
+ ,@reason-form
+ :predicate ',predicate
+ :test-expr ',test
+ ,@(when expected
+ `(:expected-form ',expected :expected-value ,expected-value))
+ ,@(when actual
+ `(:actual-form ',actual :actual-value ,actual-value)))
+ (append (when expected
+ `((,expected-value ,expected)))
+ (when actual
+ `((,actual-value ,actual))))
+ condition)))
+ (list-match-case test
+ ((not (?predicate ?expected ?actual))
+
+ (make-failure-instance 'is-negated-binary-failure
+ :predicate ?predicate
+ :expected ?expected
+ :actual ?actual
+
+ :condition `(not (,?predicate ,expected-value ,actual-value))))
+
+ ((not (?predicate ?expected))
+
+ (make-failure-instance 'is-negated-unary-failure
+ :predicate ?predicate
+ :expected ?expected
+ :condition `(not (,?predicate ,expected-value))))
+
+ ((?predicate ?expected ?actual)
+
+ (make-failure-instance 'is-binary-failure
+ :predicate ?predicate
+ :expected ?expected
+ :actual ?actual
+ :condition `(,?predicate ,expected-value ,actual-value)))
+ ((?predicate ?expected)
+
+ (make-failure-instance 'is-unary-failure
+ :predicate ?predicate
+ :expected ?expected
+ :condition `(,?predicate ,expected-value)))
+ (_
+ (values `(make-instance 'test-failure ,@reason-form)
+ '()
+ test)))))))
+