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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fbb398335d866b3333c72b566e91d72ae86df167..83d3f3e467734efde5c2210f1466a65b2dcd0558 100644 (file)
--- 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 3b324a09659d8ed426c4e52404d13628cf3906fe..9dd475f2a5108adefaee3b9cb0c3f308f6959427 100644 (file)
--- 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 91db288feefd6ae51971587d069785887ada33be..2518d8359c3c0b60b61b87c714dfebbc3923e5d4 100644 (file)
--- 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 363c0965c3e31c22e1707c69183cc4d71022daa8..9f98b30adaececbc35d6e36746b17fec44e8576f 100644 (file)
--- 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)))