mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-05 11:45:45 +00:00
Code Issues Releases Activity

Fix minor corner case bugs in byte compilation and pcase.

Browse Source 
* lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): Don't re-preprocess
functions from byte-compile-function-environment.
* lisp/emacs-lisp/bytecomp.el (byte-compile-constp): Treat #'v as a constant.
(byte-compile-close-variables): Bind byte-compile--outbuffer here...
(byte-compile-from-buffer): ...rather than here.
* lisp/emacs-lisp/pcase.el (pcase--expand): Accept different sets of vars in
different alternative patterns.
(pcase-codegen): Be more careful to preserve identity.
(pcase--u1): Don't forget to mark vars as used.
This commit is contained in:
Stefan Monnier 2012-05-29 10:28:02 -04:00
parent 46b7967e4d
commit 6876a58db3
4 changed files with 71 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lisp/ChangeLog
View File

@ -1,3 +1,17 @@
2012-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/pcase.el (pcase--expand): Accept different sets of vars in
different alternative patterns.
(pcase-codegen): Be more careful to preserve identity.
(pcase--u1): Don't forget to mark vars as used.
* emacs-lisp/bytecomp.el (byte-compile-constp): Treat #'v as a constant.
(byte-compile-close-variables): Bind byte-compile--outbuffer here...
(byte-compile-from-buffer): ...rather than here.
* emacs-lisp/byte-opt.el (byte-compile-inline-expand): Don't re-preprocess
functions from byte-compile-function-environment.
2012-05-29 Troels Nielsen <bn.troels@gmail.com>
* window.el (window-deletable-p): Avoid deleting the root window

12
lisp/emacs-lisp/byte-opt.el
View File

@ -288,10 +288,14 @@
(push `(,(car binding) ',(cdr binding)) renv)))
((eq binding t))
(t (push `(defvar ,binding) body))))
(let ((newfn (byte-compile-preprocess
(if (null renv)
`(lambda ,args ,@body)
`(lambda ,args (let ,(nreverse renv) ,@body))))))
(let ((newfn (if (eq fn localfn)
;; If `fn' is from the same file, it has already
;; been preprocessed!
`(function ,fn)
(byte-compile-preprocess
(if (null renv)
`(lambda ,args ,@body)
`(lambda ,args (let ,(nreverse renv) ,@body)))))))
(if (eq (car-safe newfn) 'function)
(byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
(byte-compile-log-warning

75
lisp/emacs-lisp/bytecomp.el
View File

@ -1478,40 +1478,46 @@ symbol itself."
(defmacro byte-compile-constp (form)
"Return non-nil if FORM is a constant."
`(cond ((consp ,form) (eq (car ,form) 'quote))
`(cond ((consp ,form) (or (eq (car ,form) 'quote)
(and (eq (car ,form) 'function)
(symbolp (cadr ,form)))))
((not (symbolp ,form)))
((byte-compile-const-symbol-p ,form))))
;; Dynamically bound in byte-compile-from-buffer.
;; NB also used in cl.el and cl-macs.el.
(defvar byte-compile--outbuffer)
(defmacro byte-compile-close-variables (&rest body)
(declare (debug t))
(cons 'let
(cons '(;;
;; Close over these variables to encapsulate the
;; compilation state
;;
(byte-compile-macro-environment
;; Copy it because the compiler may patch into the
;; macroenvironment.
(copy-alist byte-compile-initial-macro-environment))
(byte-compile-function-environment nil)
(byte-compile-bound-variables nil)
(byte-compile-const-variables nil)
(byte-compile-free-references nil)
(byte-compile-free-assignments nil)
;;
;; Close over these variables so that `byte-compiler-options'
;; can change them on a per-file basis.
;;
(byte-compile-verbose byte-compile-verbose)
(byte-optimize byte-optimize)
(byte-compile-dynamic byte-compile-dynamic)
(byte-compile-dynamic-docstrings
byte-compile-dynamic-docstrings)
;; (byte-compile-generate-emacs19-bytecodes
;; byte-compile-generate-emacs19-bytecodes)
(byte-compile-warnings byte-compile-warnings)
)
body)))
`(let (;;
;; Close over these variables to encapsulate the
;; compilation state
;;
(byte-compile-macro-environment
;; Copy it because the compiler may patch into the
;; macroenvironment.
(copy-alist byte-compile-initial-macro-environment))
(byte-compile--outbuffer nil)
(byte-compile-function-environment nil)
(byte-compile-bound-variables nil)
(byte-compile-const-variables nil)
(byte-compile-free-references nil)
(byte-compile-free-assignments nil)
;;
;; Close over these variables so that `byte-compiler-options'
;; can change them on a per-file basis.
;;
(byte-compile-verbose byte-compile-verbose)
(byte-optimize byte-optimize)
(byte-compile-dynamic byte-compile-dynamic)
(byte-compile-dynamic-docstrings
byte-compile-dynamic-docstrings)
;; (byte-compile-generate-emacs19-bytecodes
;; byte-compile-generate-emacs19-bytecodes)
(byte-compile-warnings byte-compile-warnings)
)
,@body))
(defmacro displaying-byte-compile-warnings (&rest body)
(declare (debug t))
@ -1852,13 +1858,8 @@ With argument ARG, insert value in current buffer after the form."
(insert "\n"))
((message "%s" (prin1-to-string value)))))))
;; Dynamically bound in byte-compile-from-buffer.
;; NB also used in cl.el and cl-macs.el.
(defvar byte-compile--outbuffer)
(defun byte-compile-from-buffer (inbuffer)
(let (byte-compile--outbuffer
(byte-compile-current-buffer inbuffer)
(let ((byte-compile-current-buffer inbuffer)
(byte-compile-read-position nil)
(byte-compile-last-position nil)
;; Prevent truncation of flonums and lists as we read and print them
@ -1930,8 +1931,8 @@ and will be removed soon. See (elisp)Backquote in the manual."))
;; if the buffer contains multibyte characters.
(and byte-compile-current-file
(with-current-buffer byte-compile--outbuffer
(byte-compile-fix-header byte-compile-current-file)))))
byte-compile--outbuffer))
(byte-compile-fix-header byte-compile-current-file))))
byte-compile--outbuffer)))
(defun byte-compile-fix-header (filename)
"If the current buffer has any multibyte characters, insert a version test."

15
lisp/emacs-lisp/pcase.el
View File

@ -206,9 +206,12 @@ of the form (UPAT EXP)."
(setq vars (delq v vars))
(cdr v)))
prevvars)))
(when vars ;New additional vars.
(error "The vars %s are only bound in some paths"
(mapcar #'car vars)))
;; If some of `vars' were not found in `prevvars', that's
;; OK it just means those vars aren't present in all
;; branches, so they can be used within the pattern
;; (e.g. by a `guard/let/pred') but not in the branch.
;; FIXME: But if some of `prevvars' are not in `vars' we
;; should remove them from `prevvars'!
`(funcall ,res ,@args)))))))
(main
(pcase--u
@ -225,7 +228,10 @@ of the form (UPAT EXP)."
(pcase--let* defs main))))
(defun pcase-codegen (code vars)
`(let* ,(mapcar (lambda (b) (list (car b) (cdr b))) vars)
;; Don't use let*, otherwise pcase--let* may merge it with some surrounding
;; let* which might prevent the setcar/setcdr in pcase--expand's fancy
;; codegen from later metamorphosing this let into a funcall.
`(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars)
,@code))
(defun pcase--small-branch-p (code)
@ -619,6 +625,7 @@ Otherwise, it defers to REST which is a list of branches of the form
sym (apply-partially #'pcase--split-member elems) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
(put sym 'pcase-used t)
(pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems)
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest)))