bug#14773: 24.2; pcase

bug#14773: 24.2; pcase

[John Williams]

(require 'pcase)
(macroexpand
   '(pcase 1
      ((and (let var left) (guard var)) 'left)
      ((and (let var right) (guard var)) 'right)))

When I run this, the result I get is (let ((x 1)) (if (let* ((var left))
var) (let ((var left)) (quote left)) nil)).  Note that "right" doesn't
appear anywhere in the macro expansion!


In GNU Emacs 24.2.1 (x86_64-pc-linux-gnu, GTK+ Version 2.24.10)
 of 2013-03-05 on touchstone.was.corp.google.com, modified by Debian
Windowing system distributor `The X.Org Foundation', version 11.0.11103000
Configured using:
 `configure '--build' 'x86_64-linux-gnu' '--build' 'x86_64-linux-gnu'
 '--prefix=/usr' '--sharedstatedir=/var/lib' '--libexecdir=/usr/lib'
 '--localstatedir=/var/lib' '--infodir=/usr/share/info'
 '--mandir=/usr/share/man' '--with-pop=yes'
 '--enable-locallisppath=/etc/emacs24:/etc/emacs:/usr/local/share/emacs/24.2/site-lisp:/usr/local/share/emacs/site-lisp:/usr/share/emacs/24.2/site-lisp:/usr/share/emacs/site-lisp'
 '--with-crt-dir=/usr/lib/x86_64-linux-gnu' '--with-x=yes'
 '--with-x-toolkit=gtk' '--with-toolkit-scroll-bars'
 'build_alias=x86_64-linux-gnu' 'CFLAGS=-g -O2 -fstack-protector
 --param=ssp-buffer-size=4 -Wformat -Wformat-security
 -Werror=format-security -Wall' 'LDFLAGS=-Wl,-Bsymbolic-functions
 -Wl,-z,relro' 'CPPFLAGS=-D_FORTIFY_SOURCE=2''

Important settings:
  value of $LC_ALL: nil
  value of $LC_COLLATE: nil
  value of $LC_CTYPE: nil
  value of $LC_MESSAGES: nil
  value of $LC_MONETARY: nil
  value of $LC_NUMERIC: nil
  value of $LC_TIME: nil
  value of $LANG: nil
  value of $XMODIFIERS: nil
  locale-coding-system: nil
  default enable-multibyte-characters: t

Major mode: Fundamental

Minor modes in effect:
  savehist-mode: t
  desktop-save-mode: t
  server-mode: t
  auto-fold-mode: t
  shell-dirtrack-mode: t
  show-paren-mode: t
  global-auto-revert-mode: t
  tooltip-mode: t
  mouse-wheel-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  column-number-mode: t
  line-number-mode: t
  transient-mark-mode: t
  abbrev-mode: t

Recent input:
M-P C-e C-b C-b C-b C-b C-b C-b C-b C-b C-b C-b C-b 
C-b C-b C-b C-b C-b ) <return> q M-: M-P C-a C-e C-b 
C-b C-b C-b C-b C-b C-b C-b C-b C-b C-b C-b C-b M-p 
M-p M-p M-p M-p <return> M-: M-P C-a C-f C-f C-f C-f 
C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f 
C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f 
C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f <backspace> 
<backspace> <backspace> ( x <backspace> f ) C-f C-f 
C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f 
C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f 
C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f C-f 
C-f C-f C-f C-f C-f <backspace> ( g ) C-e <return> 
M-: M-P C-a M-f M-f M-f M-f M-f M-f M-f M-f C-b C-b 
C-b C-b C-b C-b C-b C-b C-b <backspace> - <backspace> 
l e f t - b r a n c h - v a r M-f M-f M-f M-f M-f M-f 
M-f M-f M-f M-f M-f M-b M-b M-b M-f <backspace> r i 
g h t - b r a n c h - v a r C-e <return> M-: M-P C-e 
C-b C-b C-b C-b C-b C-b C-b C-b C-b C-b C-b C-b C-b 
C-b C-b C-b C-b C-b C-b <backspace> v a r C-e <return> 
<down-mouse-4> <mouse-4> <down-mouse-4> <mouse-4> <double-down-mouse-4> 
<double-mouse-4> <triple-down-mouse-4> <triple-mouse-4> 
<down-mouse-4> <mouse-4> <double-down-mouse-4> <double-mouse-4> 
<triple-down-mouse-4> <triple-mouse-4> <down-mouse-5> 
<mouse-5> <double-down-mouse-5> <double-mouse-5> <triple-down-mouse-5> 
<triple-mouse-5> <triple-down-mouse-5> <triple-mouse-5> 
<down-mouse-4> <mouse-4> <double-down-mouse-4> <double-mouse-4> 
<triple-down-mouse-4> <triple-mouse-4> <triple-down-mouse-4> 
<triple-mouse-4> <help-echo> <down-mouse-1> <mouse-1> 
<help-echo> <help-echo> <help-echo> <help-echo> <help-echo> 
<help-echo> <help-echo> <help-echo> <help-echo> <help-echo> 
<help-echo> <help-echo> <help-echo> <help-echo> <help-echo> 
<help-echo> <menu-bar> <help-menu> <send-emacs-bug
-report>

Recent messages:
(b 2)
Mark set
let: End of file during parsing
Entering debugger...
Back to top level.
(let ((x 1)) (if (let* ((var nil)) var) (let ((var nil)) (list (quote a) var)) (let* ((x 2)) (if t (let ((var x)) (list (quote b) var)) nil))))
(let ((x 1)) (let* ((x (f))) (if (let* ((var x)) var) (let ((var x)) (list (quote a) var)) (let* ((x (g))) (if t (let ((var x)) (list (quote b) var)) nil)))))
(let ((x 1)) (let* ((x (left-branch-var))) (if (let* ((var x)) var) (let ((var x)) (list (quote a) var)) (let* ((x (right-branch-var))) (if t (let ((var x)) (list (quote b) var)) nil)))))
(let ((x 1)) (let* ((x (left-branch-var))) (if (let* ((var x)) var) (let ((var x)) (list (quote a) var)) nil)))
byte-code: Beginning of buffer [3 times]
byte-code: Beginning of buffer

Load-path shadows:
/usr/share/emacs24/site-lisp/emacs-goodies-el/folding hides /usr/share/emacs/24.2/site-lisp/google/gm/folding
/usr/share/emacs24/site-lisp/google/python-mode-words-like-others hides /usr/share/emacs/24.2/site-lisp/google/gnuemacs/python-mode-words-like-others
/home/build/eng/elisp/third_party/gnuemacs/string hides /usr/share/emacs/24.2/site-lisp/google/third_party/string
/home/build/eng/elisp/third_party/gnuemacs/js2-google hides /usr/share/emacs/24.2/site-lisp/google/third_party/gnuemacs/js2-google
/home/build/eng/elisp/third_party/gnuemacs/go-mode hides /usr/share/emacs/24.2/site-lisp/google/third_party/gnuemacs/go-mode
/home/build/eng/elisp/third_party/gnuemacs/ssh hides /usr/share/emacs/24.2/site-lisp/google/third_party/gnuemacs/ssh
/home/build/eng/elisp/third_party/gnuemacs/button-lock hides /usr/share/emacs/24.2/site-lisp/google/third_party/gnuemacs/button-lock
/home/build/eng/elisp/third_party/gnuemacs/string hides /usr/share/emacs/24.2/site-lisp/google/third_party/gnuemacs/string
/home/build/eng/elisp/third_party/gnuemacs/js2-see-readme hides /usr/share/emacs/24.2/site-lisp/google/third_party/gnuemacs/js2-see-readme
/home/build/eng/elisp/third_party/gnuemacs/string hides /usr/share/emacs/24.2/site-lisp/google/third_party/gnuemacs/elib-1.0/string
/usr/share/emacs/24.2/site-lisp/google/third_party/xref/emacs/xrefprotocol hides /usr/share/emacs/24.2/site-lisp/google/third_party/xref-1.6.6/env/emacs/xrefprotocol
/usr/share/emacs/24.2/site-lisp/google/third_party/xref/emacs/xref hides /usr/share/emacs/24.2/site-lisp/google/third_party/xref-1.6.6/env/emacs/xref
/usr/share/emacs/24.2/site-lisp/google/third_party/xref/emacs/xrefactory hides /usr/share/emacs/24.2/site-lisp/google/third_party/xref-1.6.6/env/emacs/xrefactory
/usr/share/emacs/24.2/site-lisp/google/third_party/xref/emacs/xrefdoc hides /usr/share/emacs/24.2/site-lisp/google/third_party/xref-1.6.6/env/emacs/xrefdoc
/usr/share/emacs/24.2/site-lisp/debian-startup hides /usr/share/emacs/site-lisp/debian-startup
/usr/share/emacs/24.2/site-lisp/google/g-client/json hides /usr/share/emacs/24.2/lisp/json
/usr/share/emacs24/site-lisp/dictionaries-common/ispell hides /usr/share/emacs/24.2/lisp/textmodes/ispell
/usr/share/emacs24/site-lisp/dictionaries-common/flyspell hides /usr/share/emacs/24.2/lisp/textmodes/flyspell
/usr/share/emacs/24.2/site-lisp/google/third_party/xmltok hides /usr/share/emacs/24.2/lisp/nxml/xmltok
/usr/share/emacs/24.2/lisp/custom hides /usr/local/google/home/jrw/elisp/custom
/home/build/eng/elisp/third_party/gnuemacs/string hides /usr/local/google/home/jrw/elisp/3rdparty/string
/usr/share/emacs24/site-lisp/emacs-goodies-el/highlight-beyond-fill-column hides /usr/local/google/home/jrw/elisp/3rdparty/highlight-beyond-fill-column

Features:
(shadow sort gnus-util mail-extr emacsbug message format-spec rfc822 mml
mml-sec mm-decode mm-bodies mm-encode mail-parse rfc2231 mailabbrev
gmm-utils mailheader sendmail rfc2047 rfc2045 ietf-drums mm-util
mail-prsvr mail-utils help-mode view debug my-js2 etags my-syntax
my-files cl-specs bs edebug unit-test-core tabify misearch multi-isearch
savehist info google-git vc-git desktop server my-interactive find-func
clojure-mode-autoloads debbugs-autoloads haskell-mode-autoloads
num3-mode-autoloads undo-tree-autoloads package tabulated-list auto-fold
my-shift-region my-repeat-key csharp-mode byte-opt bytecomp byte-compile
cconv macroexp cc-langs flymake helm-config helm-aliases yaml-mode gofmt
my-compile my-misc my-mouse-drag-region eless my-python
my-imports-python my-local my-dabbrev dabbrev google3-build-mode
python-21 python google-buildifier diff my-google-jstd-tests
my-google-java my-java my-util my-google google3-ffap ffap google3-build
googlemenu rotate-among-files string compilation-colorization google
google-log gud google3 google-gud google-comint google-emacs-utilities
google-trailing-whitespace google-coding-style python-custom newcomment
google-autogen google-paths my-file-names alist jasmel jasmel-core pcase
conflicts highlight-beyond-fill-column skeleton cc-mode cc-fonts
easymenu cc-guess cc-menus cc-cmds cc-styles cc-align cc-engine cc-vars
cc-defs my-shell shell pcomplete my-move-region-to-file my-lisp rx
my-imports defstruct-as-plist my-hooks if-match my-edit-variable derived
thingatpt auto-eval-buffer warnings string-util unit-test-utils
my-load-path unit-test-runner paredit crontab-mode load-path-alias
my-diff edmacro kmacro jka-compr midnight uniquify advice help-fns
advice-preload winner paren grep compile comint regexp-opt ansi-color
ring autorevert cus-start cus-load cl google-autoloads google-platform
assoc emacs-goodies-el emacs-goodies-custom emacs-goodies-loaddefs
easy-mmode time-date tooltip ediff-hook vc-hooks lisp-float-type mwheel
x-win x-dnd tool-bar dnd fontset image fringe lisp-mode register page
menu-bar rfn-eshadow timer select scroll-bar mouse jit-lock font-lock
syntax facemenu font-core frame cham georgian utf-8-lang misc-lang
vietnamese tibetan thai tai-viet lao korean japanese hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
case-table epa-hook jka-cmpr-hook help simple abbrev minibuffer loaddefs
button faces cus-face files text-properties overlay sha1 md5 base64
format env code-pages mule custom widget hashtable-print-readable
backquote make-network-process dbusbind dynamic-setting
system-font-setting font-render-setting move-toolbar gtk x-toolkit x
multi-tty emacs)

bug#14773: 24.2; pcase

[Stefan Monnier]

> (require 'pcase)
> (macroexpand
>    '(pcase 1
>       ((and (let var left) (guard var)) 'left)
>       ((and (let var right) (guard var)) 'right)))

> When I run this, the result I get is (let ((x 1)) (if (let* ((var left))
> var) (let ((var left)) (quote left)) nil)).  Note that "right" doesn't
> appear anywhere in the macro expansion!

Since the second branch of your pcase is unreachable, I think it's OK
for pcase to eliminate it.

Note that it output the message "Redundant pcase pattern: (and (let var
right) (guard var))" which explains the behavior.

This said, I can't remember making this optimization so aggressive (it
seems correct here, but it seems difficult to avoid similar incorrect
ones), so I wouldn't be surprised if there are other cases where it gets
it wrong.

Could it be that you had another (real) problem and that the above
example is a (too) simplified test case you extracted from it?


        Stefan

bug#14773: 24.2; pcase

[Michael Heerdegen]

Stefan Monnier <monnier@IRO.UMontreal.CA> writes:

> > (require 'pcase)
> > (macroexpand
> >    '(pcase 1
> >       ((and (let var left) (guard var)) 'left)
> >       ((and (let var right) (guard var)) 'right)))
>
> > When I run this, the result I get is (let ((x 1)) (if (let* ((var left))
> > var) (let ((var left)) (quote left)) nil)).  Note that "right" doesn't
> > appear anywhere in the macro expansion!
>
> Since the second branch of your pcase is unreachable, I think it's OK
> for pcase to eliminate it.

Why is it unreachable?

(defvar left nil)
(defvar right t)

(pcase 1
  ((and (let var left) (guard var)) 'left)
  (_ 'right))

==> 'right

But

(pcase 1
  ((and (let var left) (guard var)) 'left)
  ((and (let var right) (guard var)) 'right))

==> nil

It should also return right, no?


Michael.

bug#14773: 24.2; pcase

[Stefan Monnier]

> Why is it unreachable?

Right, it's not, duh!

It's clearly too aggressive,


        Stefan

bug#14773: 24.2; pcase

[Stefan Monnier]

> (pcase 1
>   ((and (let var left) (guard var)) 'left)
>   ((and (let var right) (guard var)) 'right))
> ==> nil
> It should also return right, no?

It should be fixed now.  Thank you,


        Stefan