[Emacs-diffs] /srv/bzr/emacs/trunk r108422: Fix minor corner case bugs in byte compilation and pcase.

[Stefan Monnier]

------------------------------------------------------------
revno: 108422
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2012-05-29 10:28:02 -0400
message:
  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.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/byte-opt.el
  lisp/emacs-lisp/bytecomp.el
  lisp/emacs-lisp/pcase.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-05-29 12:22:49 +0000
+++ b/lisp/ChangeLog    2012-05-29 14:28:02 +0000
@@ -1,3 +1,17 @@
+2012-05-29  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * window.el (window-deletable-p): Avoid deleting the root window

=== modified file 'lisp/emacs-lisp/byte-opt.el'
--- a/lisp/emacs-lisp/byte-opt.el       2012-04-09 12:36:01 +0000
+++ b/lisp/emacs-lisp/byte-opt.el       2012-05-29 14:28:02 +0000
@@ -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

=== modified file 'lisp/emacs-lisp/bytecomp.el'
--- a/lisp/emacs-lisp/bytecomp.el       2012-05-19 18:28:32 +0000
+++ b/lisp/emacs-lisp/bytecomp.el       2012-05-29 14:28:02 +0000
@@ -1478,40 +1478,46 @@
 
 (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 @@
             (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 @@
       ;; 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."

=== modified file 'lisp/emacs-lisp/pcase.el'
--- a/lisp/emacs-lisp/pcase.el  2012-05-26 15:52:27 +0000
+++ b/lisp/emacs-lisp/pcase.el  2012-05-29 14:28:02 +0000
@@ -206,9 +206,12 @@
                                           (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 @@
       (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 @@
                        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)))