From 4de81ee0d223f3ffda6c22ac630ace93f0fc47f7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 1 Sep 2010 12:03:08 +0200 Subject: [PATCH] * lisp/emacs-lisp/pcase.el (pcase-split-memq): Overenthusiastic optimisation. (pcase-u1): Handle the case of a lambda pred. --- lisp/ChangeLog | 6 ++++++ lisp/emacs-lisp/pcase.el | 34 ++++++++++++++++++++-------------- lisp/htmlfontify.el | 2 +- 3 files changed, 27 insertions(+), 15 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4003df3355..f59b457252 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2010-09-01 Stefan Monnier + + * emacs-lisp/pcase.el (pcase-split-memq): + Fix overenthusiastic optimisation. + (pcase-u1): Handle the case of a lambda pred. + 2010-08-31 Masatake YAMATO * textmodes/nroff-mode.el (nroff-view): New command. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 0b46eb2a30..b2b27a0e0d 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -290,9 +290,13 @@ MATCH is the pattern that needs to be matched, of the form: (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 @@ and otherwise defers to REST which is a list of branches of the form `(,(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) diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 5c491b0c37..bfa8159508 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -2349,7 +2349,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'." ;;;### (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" "\ -- 2.20.1