[Emacs-diffs] /srv/bzr/emacs/trunk r101266: * lisp/emacs-lisp/pcase.el (pcase-split-memq): Overenthusiastic optimisation.

[Stefan Monnier]

------------------------------------------------------------
revno: 101266
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Wed 2010-09-01 12:03:08 +0200
message:
  * lisp/emacs-lisp/pcase.el (pcase-split-memq): Overenthusiastic optimisation.
  (pcase-u1): Handle the case of a lambda pred.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/pcase.el
  lisp/htmlfontify.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-08-31 18:04:26 +0000
+++ b/lisp/ChangeLog    2010-09-01 10:03:08 +0000
@@ -1,3 +1,9 @@
+2010-09-01  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/pcase.el (pcase-split-memq):
+       Fix overenthusiastic optimisation.
+       (pcase-u1): Handle the case of a lambda pred.
+
 2010-08-31  Masatake YAMATO  <address@hidden>
 
        * textmodes/nroff-mode.el (nroff-view): New command.

=== modified file 'lisp/emacs-lisp/pcase.el'
--- a/lisp/emacs-lisp/pcase.el  2010-08-11 02:14:53 +0000
+++ b/lisp/emacs-lisp/pcase.el  2010-09-01 10:03:08 +0000
@@ -290,9 +290,13 @@
 (defun pcase-split-memq (elems pat)
   ;; Based on pcase-split-eq.
   (cond
-   ;; The same match will give the same result.
+   ;; The same match will give the same result, but we don't know how
+   ;; to check it.
+   ;; (???
+   ;;  (cons :pcase-succeed nil))
+   ;; A match for one of the elements may succeed or fail.
    ((and (eq (car-safe pat) '\`) (member (cadr pat) elems))
-    (cons :pcase-succeed nil))
+    nil)
    ;; A different match will fail if this one succeeds.
    ((and (eq (car-safe pat) '\`)
          ;; (or (integerp (cadr pat)) (symbolp (cadr pat))
@@ -383,18 +387,20 @@
                         `(,(cadr upat) ,sym)
                       (let* ((exp (cadr upat))
                              ;; `vs' is an upper bound on the vars we need.
-                             (vs (pcase-fgrep (mapcar #'car vars) exp)))
-                        (if vs
-                            ;; Let's not replace `vars' in `exp' since it's
-                            ;; too difficult to do it right, instead just
-                            ;; let-bind `vars' around `exp'.
-                            `(let ,(mapcar (lambda (var)
-                                             (list var (cdr (assq var vars))))
-                                           vs)
-                               ;; FIXME: `vars' can capture `sym'.  E.g.
-                               ;; (pcase x ((and `(,x . ,y) (pred (fun x)))))
-                               (,@exp ,sym))
-                          `(,@exp ,sym))))
+                             (vs (pcase-fgrep (mapcar #'car vars) exp))
+                             (call (if (functionp exp)
+                                       `(,exp ,sym) `(,@exp ,sym))))
+                        (if (null vs)
+                            call
+                          ;; Let's not replace `vars' in `exp' since it's
+                          ;; too difficult to do it right, instead just
+                          ;; let-bind `vars' around `exp'.
+                          `(let ,(mapcar (lambda (var)
+                                           (list var (cdr (assq var vars))))
+                                         vs)
+                             ;; FIXME: `vars' can capture `sym'.  E.g.
+                             ;; (pcase x ((and `(,x . ,y) (pred (fun x)))))
+                             ,call))))
                     (pcase-u1 matches code vars then-rest)
                     (pcase-u else-rest))))
        ((symbolp upat)

=== modified file 'lisp/htmlfontify.el'
--- a/lisp/htmlfontify.el       2010-08-29 20:10:43 +0000
+++ b/lisp/htmlfontify.el       2010-09-01 10:03:08 +0000
@@ -2349,7 +2349,7 @@
 
 
 ;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file)
-;;;;;;  "hfy-cmap" "hfy-cmap.el" "3de2db2d213813bb3afe170ffd66cdde")
+;;;;;;  "hfy-cmap" "hfy-cmap.el" "7e622e4b131ea5efbe9d258f719822d6")
 ;;; Generated autoloads from hfy-cmap.el
 
 (autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\