Function: cl--pcase-mutually-exclusive-p

cl--pcase-mutually-exclusive-p is a byte-compiled function defined in cl-macs.el.gz.

Signature

(cl--pcase-mutually-exclusive-p ORIG PRED1 PRED2)

Documentation

Extra special cases for cl-typep predicates.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/cl-macs.el.gz
(defun cl--pcase-mutually-exclusive-p (orig pred1 pred2)
  "Extra special cases for `cl-typep' predicates."
  (let* ((x1 pred1) (x2 pred2)
         (t1
          (and (eq 'pcase--flip (car-safe x1)) (setq x1 (cdr x1))
               (eq 'cl-typep (car-safe x1))    (setq x1 (cdr x1))
               (null (cdr-safe x1))            (setq x1 (car x1))
               (eq 'quote (car-safe x1))       (cadr x1)))
         (t2
          (and (eq 'pcase--flip (car-safe x2)) (setq x2 (cdr x2))
               (eq 'cl-typep (car-safe x2))    (setq x2 (cdr x2))
               (null (cdr-safe x2))            (setq x2 (car x2))
               (eq 'quote (car-safe x2))       (cadr x2))))
    (or
     (and (symbolp t1) (symbolp t2)
          (let ((c1 (cl--find-class t1))
                (c2 (cl--find-class t2)))
            (and c1 c2
                 (not (or (memq c1 (cl--struct-all-parents c2))
                          (memq c2 (cl--struct-all-parents c1)))))))
     (let ((c1 (and (symbolp t1) (cl--find-class t1))))
       (and c1 (cl--struct-class-p c1)
            (funcall orig (cl--defstruct-predicate t1)
                     pred2)))
     (let ((c2 (and (symbolp t2) (cl--find-class t2))))
       (and c2 (cl--struct-class-p c2)
            (funcall orig pred1
                     (cl--defstruct-predicate t2))))
     (funcall orig pred1 pred2))))