bug#5728: Byte compile doesn't work right on macro

bug#5728: Byte compile doesn't work right on macro

[Tom Breton]

When I byte-compile certain code, the results are different than when
it's not byte-compiled.  It seems to wrongly merge lists.  The one
unusual thing I was doing with the code is using a macro to generate a
call to a ctor (as generated by defstruct)

I have attached two elisp files which demonstrate the buggy behavior.
The first, "byte-compile-bug.el", is meant to be alternately loaded
plain or loaded byte-compiled.  The second, "demo-byte-compile-bug.el"
is partly a script which demonstartes that the behavior is indeed
different when byte-compiled, and partly a collection of
(quote-protected) calls to slightly different examples of the bug and
examples of similar code which does not exhibit the bug, all defined
in the first file.




In GNU Emacs 22.2.1 (i486-pc-linux-gnu, X toolkit, Xaw3d scroll bars)
 of 2008-11-09 on raven, modified by Debian
Windowing system distributor `The X.Org Foundation', version 11.0.10402000
configured using `configure  '--build=i486-linux-gnu' '--host=i486-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/emacs22:/etc/emacs:/usr/local/share/emacs/22.2/site-lisp:/usr/local/share/emacs/site-lisp:/usr/share/emacs/22.2/site-lisp:/usr/share/emacs/site-lisp:/usr/share/emacs/22.2/leim' '--with-x=yes' '--with-x-toolkit=athena' '--with-toolkit-scroll-bars' 'build_alias=i486-linux-gnu' 'host_alias=i486-linux-gnu' 'CFLAGS=-DDEBIAN -g -O2' 'LDFLAGS=-g' 'CPPFLAGS=''

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
  locale-coding-system: nil
  default-enable-multibyte-characters: t

Major mode: Lisp Interaction

Minor modes in effect:
  tooltip-mode: t
  tool-bar-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
  unify-8859-on-encoding-mode: t
  utf-translate-cjk-mode: t
  auto-compression-mode: t
  line-number-mode: t

Recent input:
M-x r e p o <tab> r t <tab> <return>

Recent messages:
("emacs" "-Q")
For information about GNU Emacs and the GNU system, type C-h C-a.
Making completion list...
Loading help-mode...done
Loading emacsbug...
Loading regexp-opt...done
Loading emacsbug...done
next-history-element: Beginning of history; no preceding item

===File ~/projects/elisp/bugs/byte-compile-bug.el============
;;;_ byte-compile-bug.el --- File to reproduce byte-compile bug

;;;_. Headers
;;;_ , Commentary:

;;Bug report by Tom Breton (Tehom)

;; The bug seems to involve:
;;   defstruct
;;   macro that builds a ctor.  
;;   a while loop
;;   The byte compiler

;;Observe that it occurs only in compiled code.

;;The macro is made by defmacro* but the same occurs with defmacro
;;feeding defun*

;;;_ , Requires

(eval-when-compile (require 'cl))

;;;_. Body
;;;_ , Type
(defstruct (BUG:structure
	      (:conc-name BUG:structure->)
	      (:constructor BUG:make-structure))
   
   "An ADT make by defstruct"
   edits
   a)

;;;_ , BUG:helper

(defun BUG:helper (accessor oobj form)
   ""
   (subst
      (list accessor oobj)
      '-old-
      (copy-tree form)))

(defmacro* BUG:make-form (oobj &key edits a)
   "Construct an BUG:structure object adapted from CAND.
Syntax is almost that of a ctor, but in each form, the symbol `-old-'
is replaced by the value of the respective field of OOBJ."

   `(BUG:make-structure
       :edits
       ,(BUG:helper
	   'BUG:structure->edits 
	   oobj
	   edits)
       :a
       ,(BUG:helper
	   'BUG:structure->a 
	   oobj
	   a)))


;;;_ , BUG

(defun BUG (a)
   "Contains a bug involving the byte-compiler"

   (let
      (
	 (cand
	    (BUG:make-structure
	       :edits '()
	       :a a)))

      (catch 'BUG:answer
	 (while t
	    (let
	       (  
		  (a (BUG:structure->a cand)))
	       
	       (unless a
		  (throw 'BUG:answer 
		     (reverse
			(BUG:structure->edits cand))))
	       (setq cand
		  (BUG:make-form cand
		     :edits
		     (cons (car a) -old-)
		     :a
		     (cdr -old-))))))))
(defun BUG-2 (a)
   "Equivalent to BUG except no catch/throw.  Still a bug."

   (let
      (  (done nil)
	 (cand
	    (BUG:make-structure
	       :edits '()
	       :a a)))

      (while (not done)
	 (let
	    (  
	       (a (BUG:structure->a cand)))
	       
	    (if a
	       (setq cand
		  (BUG:make-form cand
		     :edits
		     (cons (car a) -old-)
		     :a
		     (cdr -old-)))
	       (setq done t))))
      (reverse
	 (BUG:structure->edits cand))))

(defun BUG-3 (a)
   "Equivalent to BUG.  Also buggy, slightly different manifestation.
Slightly different form not involving the second field `a' of BUG:structure."

   (let
      (
	 (cand
	    (BUG:make-structure
	       :edits '())))
      
      (catch 'BUG:answer
	 (while t
	    (unless a
	       (throw 'BUG:answer 
		  (reverse
		     (BUG:structure->edits cand))))
	    (setq cand
	       (BUG:make-form cand
		  :edits
		  (cons (car a) -old-)))
	    (pop a)))))

(defun BUG-4 (a)
   "Equivalent to BUG.  Also buggy, slightly different manifestation.
Slightly different form not directly using a while loop."

   (let
      (
	 (cand
	    (BUG:make-structure
	       :edits '())))
      (dotimes (i (length a))
	 (setq cand
	    (BUG:make-form cand
	       :edits
	       (cons (car a) -old-)))
	 (pop a))
      (reverse
	 (BUG:structure->edits cand))))

(defun NOBUG (a)
   "Equivalent to BUG.
This form extracts elements from list `a' before using them.

No buggy behavior."

   (let
      (
	 (cand
	    (BUG:make-structure
	       :edits '()
	       :a a)))

      (catch 'BUG:answer
	 (progn
	    (dolist (x a)
	       (setq cand
		  (BUG:make-form cand
		     :edits
		     (cons x -old-)
		     :a
		     (cdr -old-))))
	    (throw 'BUG:answer 
	       (reverse
		  (BUG:structure->edits cand)))))))

(defun NOBUG-2 (a)
   "Equivalent to BUG except doesn't use the second field `a' of
BUG:structure and extracts elements from list `a' before using
them.

No buggy behavior."

   (let
      (
	 (cand
	    (BUG:make-structure
	       :edits '())))
      
      (catch 'BUG:answer
	 (while t
	    (let
	       ((x (pop a)))
	       
	       (unless x
		  (throw 'BUG:answer 
		     (reverse
			(BUG:structure->edits cand))))
	       (setq cand
		  (BUG:make-form cand
		     :edits
		     (cons x -old-))))))))




;;;_. Footers
;;;_ , Provides

(provide 'byte-compile-bug)

;;;_ * Local emacs vars.
;;;_  + Local variables:
;;;_  + mode: allout
;;;_  + End:

;;;_ , End
;;; byte-compile-bug.el ends here
============================================================

===File ~/projects/elisp/bugs/demo-byte-compile-bug.el======
;;File to demonstrate this bug.  eval-buffer to see it.  Also various
;;examples of it are included for easy C-x C-e exploration.


(defun BUG:assert-works-ok (str)
   ""
   (message str)
   (assert
      (equal
	 (BUG
	    '(a b c d))
	 '(a b c d))
      t))

(progn
   (load-file "byte-compile+cl.el")
   (BUG:assert-works-ok "Uncompiled version works OK")
   (byte-compile-file "byte-compile+cl.el")
   (load-file "byte-compile+cl.elc")
   (BUG:assert-works-ok "Compiled version doesn't"))

;;For comparison:

;;Buggy equivalents

'
(assert
   (equal
      (BUG-2
	 '(a b c d))
      '(a b c d))
   t)

'
(assert
   (equal
      (BUG-3
	 '(a b c d))
      '(a b c d))
   t)

'
(assert
   (equal
      (BUG-4
	 '(a b c d))
      '(a b c d))
   t)

;;Non-buggy equivalents

'
(assert
   (equal
      (NOBUG
	 '(a b c d))
      '(a b c d))
   t)

'
(assert
   (equal
      (NOBUG-2
	 '(a b c d))
      '(a b c d))
   t)============================================================

bug#5728: Byte compile doesn't work right on macro

[Stefan Monnier]

> When I byte-compile certain code, the results are different than when
> it's not byte-compiled.  It seems to wrongly merge lists.  The one
> unusual thing I was doing with the code is using a macro to generate a
> call to a ctor (as generated by defstruct)

You're victim of a form of "name capture".
E.g. if you rename `a' to `b' in BUG3, the bug disappears.
And if you macroexpand by hand the call to BUG:make-form the bug is
still there.

More to the point, the bug is in the compiler-macro for
BUG:make-structure:

   ELISP> (compiler-macroexpand '(BUG:make-structure :edits (cons (car a) (BUG:structure->edits cand)) :a nil))
   (block BUG:make-structure
     (vector 'cl-struct-BUG:structure
   	  (cons (car nil) (BUG:structure->edits cand))
   	  nil))
   ELISP> (defsubst* toto (a1 a2) (+ a1 a2))
   toto
   ELISP> (compiler-macroexpand '(toto a2 nil))
   (block toto (+ nil nil))
   
   ELISP> 

The problem is that cl-defsubst-expand does the substitution "a1 -> a2
and a2 -> nil" one after the other rather than simultaneously.

I've just installed a fix for it in the emacs-23 branch.


        Stefan