Function: pcase--app-subst-match

pcase--app-subst-match is a byte-compiled function defined in pcase.el.gz.

Signature

(pcase--app-subst-match MATCH SYM FUN NSYM)

Documentation

Refine MATCH knowing that NSYM = (funcall FUN SYM).

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/pcase.el.gz
(defun pcase--app-subst-match (match sym fun nsym)
  "Refine MATCH knowing that NSYM = (funcall FUN SYM)."
  (cond
   ((eq (car-safe match) 'match)
    (cond
     ((not (eq sym (cadr match))) match)
     ((and (eq 'app (car-safe (cddr match)))
           (equal fun (nth 1 (cddr match))))
      ;; MATCH is (match SYM app FUN UPAT), so we can refine it to refer to
      ;; NSYM rather than re-compute (funcall FUN SYM).
      (pcase--match nsym (nth 2 (cddr match))))
     ((eq 'quote (car-safe (cddr match)))
      ;; MATCH is (match SYM quote VAL), so we can decompose it into
      ;; (match NSYM quote (funcall FUN VAL)) plus a check that
      ;; the part of VAL not included in (funcall FUN VAL) still
      ;; result is SYM matching (quote VAL).  (bug#71398)
      (condition-case nil
          `(and (match ,nsym . ',(funcall fun (nth 3 match)))
                ;; FIXME: "the part of VAL not included in (funcall FUN VAL)"
                ;; is hard to define for arbitrary FUN.  We do it only when
                ;; FUN is `c[ad]r', and for the rest we just preserve
                ;; the original `match' which is not optimal but safe.
                ,(if (and (memq fun '(car cdr car-safe cdr-safe))
                          (consp (nth 3 match)))
                     (let ((otherfun (if (memq fun '(car car-safe))
                                         #'cdr-safe #'car-safe)))
                       `(match ,(cadr match) app ,otherfun
                               ',(funcall otherfun (nth 3 match))))
                   match))
        (error match)))
     (t match)))
   ((memq (car-safe match) '(or and))
    `(,(car match)
      ,@(mapcar (lambda (match)
                  (pcase--app-subst-match match sym fun nsym))
                (cdr match))))
   ((memq match '(:pcase--succeed :pcase--fail)) match)
   (t (error "Unknown MATCH %s" match))))