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.

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  <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
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)))