Function: pcase-compile-patterns

pcase-compile-patterns is a byte-compiled function defined in pcase.el.gz.

Signature

(pcase-compile-patterns EXP CASES)

Documentation

Compile the set of patterns in CASES.

EXP is the expression that will be matched against the patterns. CASES is a list of elements (PAT . CODEGEN) where CODEGEN is a function that returns the code to use when PAT matches. That code has to be in the form of a cons cell.

CODEGEN will be called with at least 2 arguments, VARVALS and COUNT. VARVALS is a list of elements of the form (VAR VAL . RESERVED) where VAR is a variable bound by the pattern and VAL is a duplicable expression that returns the value this variable should be bound to. If the pattern PAT uses or, CODEGEN may be called multiple times, in which case it may want to generate the code differently to avoid a potential code explosion. For this reason the COUNT argument indicates how many time this CODEGEN is called.

Probably introduced at or before Emacs version 28.1.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/pcase.el.gz
(defun pcase-compile-patterns (exp cases)
  "Compile the set of patterns in CASES.
EXP is the expression that will be matched against the patterns.
CASES is a list of elements (PAT . CODEGEN)
where CODEGEN is a function that returns the code to use when
PAT matches.  That code has to be in the form of a cons cell.

CODEGEN will be called with at least 2 arguments, VARVALS and COUNT.
VARVALS is a list of elements of the form (VAR VAL . RESERVED) where VAR
is a variable bound by the pattern and VAL is a duplicable expression
that returns the value this variable should be bound to.
If the pattern PAT uses `or', CODEGEN may be called multiple times,
in which case it may want to generate the code differently to avoid
a potential code explosion.  For this reason the COUNT argument indicates
how many time this CODEGEN is called."
  (macroexp-let2 macroexp-copyable-p val exp
    (let* ((seen '())
           (phcounter 0)
           (main
            (pcase--u
             (mapcar
              (lambda (case)
                `(,(pcase--match val (pcase--macroexpand (car case)))
                  ,(lambda (vars)
                     (let ((prev (assq case seen)))
                       (unless prev
                         ;; Keep track of the cases that are used.
                         (push (setq prev (list case)) seen))
                       ;; Put a counter in the cdr just so that not
                       ;; all branches look identical (to avoid things
                       ;; like `macroexp-if' optimizing them too
                       ;; optimistically).
                       (let ((ph (cons 'pcase--placeholder
                                       (setq phcounter (1+ phcounter)))))
                         (setcdr prev (cons (cons vars ph) (cdr prev)))
                         ph)))))
              cases))))
      ;; Take care of the place holders now.
      (dolist (branch seen)
        (let ((codegen (cdar branch))
              (uses (cdr branch)))
          ;; Find all the vars that are in scope (the union of the
          ;; vars provided in each use case).
          (let* ((allvarinfo '())
                 (_ (dolist (use uses)
                      (dolist (v (car use))
                        (let ((vi (assq (car v) allvarinfo)))
                          (if vi
                              (if (cddr v) (setcdr vi 'used))
                            (push (cons (car v) (cddr v)) allvarinfo))))))
                 (allvars (mapcar #'car allvarinfo)))
            (dolist (use uses)
              (let* ((vars (car use))
                     (varvals
                      (mapcar (lambda (v)
                                `(,v ,(cadr (assq v vars))
                                     ,(cdr (assq v allvarinfo))))
                              allvars))
                     (placeholder (cdr use))
                     (code (funcall codegen varvals (length uses))))
                ;; (cl-assert (eq (car placeholder) 'pcase--placeholder))
                (setcar placeholder (car code))
                (setcdr placeholder (cdr code)))))))
      (dolist (case cases)
        (unless (or (assq case seen)
                    (memq (car case) pcase--dontwarn-upats))
          (setq main
                (macroexp-warn-and-return
                 (format "pcase pattern %S shadowed by previous pcase pattern"
                         (car case))
                 main nil nil (car case)))))
      main)))