procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/emacs-lisp/bytecomp.el: Add default-case for last cond clause.

Browse source 
* lisp/emacs-lisp/bytecomp.el: (byte-compile-cond-jump-table) Add
default-case for last cond clause.
This commit is contained in:
Vibhav Pant 2017-01-19 23:12:09 +05:30
parent 522f16dac9
commit 46193d5209
1 changed files with 19 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

35
lisp/emacs-lisp/bytecomp.el
View file

@ -4019,23 +4019,24 @@ that suppresses all warnings during execution of BODY."
jump-table test-obj body tag donetag default-tag default-case)
(when (and cases (not (= (length cases) 1)))
(setq jump-table (make-hash-table :test test :size (length cases))
default-tag (byte-compile-make-tag)
donetag (byte-compile-make-tag))
(byte-compile-variable-ref var)
(byte-compile-push-constant jump-table)
(byte-compile-out 'byte-switch)
;; When the opcode argument is `byte-goto', `byte-compile-goto' sets
;; `byte-compile-depth' to `nil'. However, we need `byte-compile-depth'
;; to be non-nil for generating tags for all cases. Since
;; `byte-compile-depth' will increase by atmost 1 after compiling
;; all of the clause (which is further enforced by cl-assert below)
;; it should be safe to preserve it's value.
(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))
default-tag (byte-compile-make-tag))
(setq cases (butlast cases 1))
;; When the opcode argument is `byte-goto', `byte-compile-goto' sets
;; `byte-compile-depth' to `nil'. However, we need `byte-compile-depth'
;; to be non-nil for generating tags for all cases. Since
;; `byte-compile-depth' will increase by atmost 1 after compiling
;; all of the clause (which is further enforced by cl-assert below)
;; it should be safe to preserve it's value.
(let ((byte-compile-depth byte-compile-depth))
(byte-compile-goto 'byte-goto default-tag)))
cases (butlast cases 1)))
(dolist (case cases)
(setq tag (byte-compile-make-tag)
@ -4051,21 +4052,23 @@ that suppresses all warnings during execution of BODY."
;; increase by one for every clause body compiled, causing
;; depth/tag conflicts or violating asserts down the road.
;; To make sure `byte-compile-body' itself doesn't violate this,
;; we use `cl-assert' (which probably doesn't need to .
;; we use `cl-assert'.
(byte-compile-body body byte-compile--for-effect)
(cl-assert (or (= byte-compile-depth init-depth)
(= byte-compile-depth (1+ init-depth))))
(byte-compile-goto 'byte-goto donetag)))
(byte-compile-goto 'byte-goto donetag)
(setcdr (cdr donetag) nil)))
(byte-compile-out-tag default-tag)
(if default-case
(progn (byte-compile-out-tag default-tag)
(byte-compile-body-do-effect default-case))
(byte-compile-push-constant nil))
(byte-compile-body-do-effect default-case)
(byte-compile-form 'nil))
(byte-compile-out-tag donetag)
(push jump-table byte-compile-jump-tables))))
(defun byte-compile-cond (clauses)
(or (and byte-compile-cond-use-jump-table (byte-compile-cond-jump-table clauses))
(or (and byte-compile-cond-use-jump-table
(byte-compile-cond-jump-table clauses))
(let ((donetag (byte-compile-make-tag))
nexttag clause)
(while (setq clauses (cdr clauses))