GNU bug report logs - #27016
possible bug in `defsetf'

Previous Next

Full log

View this message in rfc822 format

From: Stefan Monnier <monnier <at> IRO.UMontreal.CA>
To: npostavs <at> users.sourceforge.net
Cc: Michael Heerdegen <michael_heerdegen <at> web.de>, 27016 <at> debbugs.gnu.org, Rafael D Sorkin <rsorkin <at> perimeterinstitute.ca>
Subject: bug#27016: possible bug in `defsetf'
Date: Fri, 14 Jul 2017 00:32:34 -0400

> I'm not sure yet how best way to solve this.

I believe the patch below does the right thing.  It's kind of a bummer
that we have to byte-compile the function call by hand, tho.  I tested
it only lightly, so please give it a more thorough testing and then feel
free to push it.


        Stefan


diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index e5b9b47b1d..e6f90e044b 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -498,6 +498,10 @@ byte-compile-macro-environment
 Each element looks like (MACRONAME . DEFINITION).  It is
 \(MACRONAME . nil) when a macro is redefined as a function.")
 
+(defvar byte-compile-plist-environment nil
+  "Alist of property lists defined in the file being compiled.
+Each element looks like (SYMBOL . PLIST).")
+
 (defvar byte-compile-function-environment nil
   "Alist of functions defined in the file being compiled.
 This is so we can inline them when necessary.
@@ -1585,6 +1589,7 @@ byte-compile-close-variables
           ;; macroenvironment.
           (copy-alist byte-compile-initial-macro-environment))
          (byte-compile--outbuffer nil)
+         (byte-compile-plist-environment nil)
          (byte-compile-function-environment nil)
          (byte-compile-bound-variables nil)
          (byte-compile-lexical-variables nil)
@@ -4695,7 +4700,7 @@ byte-compile-file-form-defalias
              (if (null fun)
                  (message "Macro %s unrecognized, won't work in file" name)
                (message "Macro %s partly recognized, trying our luck" name)
-               (push (cons name (eval fun))
+               (push (cons name (eval fun t))
                      byte-compile-macro-environment)))
            (byte-compile-keep-pending form))))
 
@@ -4725,6 +4730,33 @@ byte-compile-make-variable-buffer-local
      'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local)
 (defun byte-compile-form-make-variable-buffer-local (form)
   (byte-compile-keep-pending form 'byte-compile-normal-call))
+
+(put 'function-put 'byte-hunk-handler 'byte-compile-function-put)
+(defun byte-compile-function-put (form)
+  (pcase form
+    ((and `(,op ,fun ,prop ,val)
+          (guard (and (macroexp-const-p fun)
+                      (macroexp-const-p prop)
+                      (or (macroexp-const-p val)
+                          ;; Also accept anonymous functions, since
+                          ;;  we're at top-level which implies they're
+                          ;;  also constants.
+                          (pcase val (`(function (lambda . ,_)) t))))))
+     (byte-compile-push-constant op)
+     (byte-compile-form fun)
+     (byte-compile-form prop)
+     (let* ((fun (eval fun t))
+            (prop (eval prop t))
+            (val (if (macroexp-const-p val)
+                     (eval val t)
+                   (byte-compile-lambda (cadr val)))))
+       (push (cons fun `(,prop ,val
+                         . ,(assq fun byte-compile-plist-environment)))
+             byte-compile-plist-environment)
+       (byte-compile-push-constant val)
+       (byte-compile-out 'byte-call 3)))
+
+    (_ (byte-compile-keep-pending form))))
 
 ;;; tags
 

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.