From 6876a58db34b81e411293b5ee8d161aa451fd767 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 29 May 2012 10:28:02 -0400 Subject: [PATCH] Fix minor corner case bugs in byte compilation and pcase. * 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. --- lisp/ChangeLog | 14 +++++++ lisp/emacs-lisp/byte-opt.el | 12 ++++-- lisp/emacs-lisp/bytecomp.el | 75 +++++++++++++++++++------------------ lisp/emacs-lisp/pcase.el | 15 ++++++-- 4 files changed, 71 insertions(+), 45 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fbb398335d8..83d3f3e4677 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,17 @@ +2012-05-29 Stefan Monnier + + * 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 * window.el (window-deletable-p): Avoid deleting the root window diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 3b324a09659..9dd475f2a51 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -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 diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 91db288feef..2518d8359c3 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -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." diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 363c0965c3e..9f98b30adae 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -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))) -- 2.39.2