Function: byte-compile--cond-switch-prefix

byte-compile--cond-switch-prefix is a byte-compiled function defined in bytecomp.el.gz.

Signature

(byte-compile--cond-switch-prefix CLAUSES)

Documentation

Find a switch corresponding to a prefix of CLAUSES, or nil if none.

Return (TAIL VAR TEST CASES), where:
  TAIL is the remaining part of CLAUSES after the switch, including
  any default clause,
  VAR is the variable being switched on,
  TEST is the equality test (eq, eql or equal),
  CASES is a list of (VALUES . BODY) where VALUES is a list of values
    corresponding to BODY (always non-empty).

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/bytecomp.el.gz
(defun byte-compile--cond-switch-prefix (clauses)
  "Find a switch corresponding to a prefix of CLAUSES, or nil if none.
Return (TAIL VAR TEST CASES), where:
  TAIL is the remaining part of CLAUSES after the switch, including
  any default clause,
  VAR is the variable being switched on,
  TEST is the equality test (`eq', `eql' or `equal'),
  CASES is a list of (VALUES . BODY) where VALUES is a list of values
    corresponding to BODY (always non-empty)."
  (let ((cases nil)                 ; Reversed list of (VALUES BODY).
        (keys nil)                  ; Switch keys seen so far.
        (switch-var nil)
        (switch-test 'eq))
    (while (pcase (car clauses)
             (`((,(and fn (or 'eq 'eql 'equal)) ,expr1 ,expr2) . ,body)
              (let* ((vars (byte-compile--cond-vars expr1 expr2))
                     (var (car vars))
                     (value (cdr vars)))
                (and var (or (eq var switch-var) (not switch-var))
                     (progn
                       (setq switch-var var)
                       (setq switch-test
                             (byte-compile--common-test switch-test fn))
                       (unless (member value keys)
                         (push value keys)
                         (push (cons (list value) (or body '(t))) cases))
                       t))))
             ;; Treat (not X) as (eq X nil).
             (`((,(or 'not 'null) ,(and var (pred symbolp))) . ,body)
              (and (or (eq var switch-var) (not switch-var))
                   (progn
                     (setq switch-var var)
                     (setq switch-test
                           (byte-compile--common-test switch-test 'eq))
                     (unless (memq nil keys)
                       (push nil keys)
                       (push (cons (list nil) (or body '(t))) cases))
                     t)))
             (`((,(and fn (or 'memq 'memql 'member)) ,var ,expr) . ,body)
              (and (symbolp var)
                   (or (eq var switch-var) (not switch-var))
                   (macroexp-const-p expr)
                   ;; Require a non-empty body, since the member
                   ;; function value depends on the switch argument.
                   body
                   (let ((value (eval expr lexical-binding)))
                     (and (proper-list-p value)
                          (progn
                            (setq switch-var var)
                            (setq switch-test
                                  (byte-compile--common-test
                                   switch-test
                                   (cdr (assq fn '((memq   . eq)
                                                   (memql  . eql)
                                                   (member . equal))))))
                            (let ((vals nil))
                              (dolist (elem value)
                                (unless (funcall fn elem keys)
                                  (push elem vals)))
                              (when vals
                                (setq keys (append vals keys))
                                (push (cons (nreverse vals) body) cases)))
                            t))))))
      (setq clauses (cdr clauses)))
    ;; Assume that a single switch is cheaper than two or more discrete
    ;; compare clauses.  This could be tuned, possibly taking into
    ;; account the total number of values involved.
    (and (> (length cases) 1)
         (list clauses switch-var switch-test (nreverse cases)))))