From 4a025170b2b293810cf03c964b402963495fe7d7 Mon Sep 17 00:00:00 2001 From: Robert Cochran Date: Wed, 6 Jun 2018 00:31:25 -0700 Subject: [PATCH] Use a gensym for the default case in byte-compile-cond-jump-table * lisp/bytecomp.el (byte-compile-cond-jump-table): Create gensym to use as default case symbol (byte-compile-cond-jump-table-info): new argument `default-sym'; use it when generating default case clause --- lisp/emacs-lisp/bytecomp.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ad6b5b7ce2..0fedfd0868 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4092,7 +4092,7 @@ byte-compile-cond-vars (and (symbolp obj1) (macroexp-const-p obj2) (cons obj1 obj2)) (and (symbolp obj2) (macroexp-const-p obj1) (cons obj2 obj1)))) -(defun byte-compile-cond-jump-table-info (clauses) +(defun byte-compile-cond-jump-table-info (clauses default-sym) "If CLAUSES is a `cond' form where: The condition for each clause is of the form (TEST VAR VALUE). VAR is a variable. @@ -4124,14 +4124,15 @@ byte-compile-cond-jump-table-info (not (assq obj2 cases))) (push (list (if (consp obj2) (eval obj2) obj2) body) cases) (if (and (macroexp-const-p condition) condition) - (progn (push (list 'default (or body `(,condition))) cases) + (progn (push (list default-sym (or body `(,condition))) cases) (throw 'break t)) (setq ok nil) (throw 'break nil)))))) (list (cons prev-test prev-var) (nreverse cases))))) (defun byte-compile-cond-jump-table (clauses) - (let* ((table-info (byte-compile-cond-jump-table-info clauses)) + (let* ((default-sym (gensym "byte-compile--cond-default-sym")) + (table-info (byte-compile-cond-jump-table-info clauses default-sym)) (test (caar table-info)) (var (cdar table-info)) (cases (cadr table-info)) @@ -4141,7 +4142,7 @@ byte-compile-cond-jump-table ;; set it to `t' for cond forms with a small number of cases. (setq jump-table (make-hash-table :test test :purecopy t - :size (if (assq 'default cases) + :size (if (assq default-sym cases) (1- (length cases)) (length cases))) default-tag (byte-compile-make-tag) @@ -4175,8 +4176,8 @@ byte-compile-cond-jump-table (let ((byte-compile-depth byte-compile-depth)) (byte-compile-goto 'byte-goto default-tag)) - (when (assq 'default cases) - (setq default-case (cadr (assq 'default cases)) + (when (assq default-sym cases) + (setq default-case (cadr (assq default-sym cases)) cases (butlast cases 1))) (dolist (case cases) -- 2.17.1