From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.bugs Subject: bug#8457: 24.0.50; defadvice with BODY referencing args by name: void-var error Date: Sun, 10 Apr 2011 01:46:06 -0300 Message-ID: References: <21C5BDEF1EBA475C86898667CFA8E409@us.oracle.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: dough.gmane.org 1302412057 9130 80.91.229.12 (10 Apr 2011 05:07:37 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sun, 10 Apr 2011 05:07:37 +0000 (UTC) Cc: 8457@debbugs.gnu.org To: "Drew Adams" Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun Apr 10 07:07:33 2011 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Q8mry-00033o-N3 for geb-bug-gnu-emacs@m.gmane.org; Sun, 10 Apr 2011 07:07:31 +0200 Original-Received: from localhost ([127.0.0.1]:49839 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Q8mrx-0007c9-RZ for geb-bug-gnu-emacs@m.gmane.org; Sun, 10 Apr 2011 01:07:29 -0400 Original-Received: from [140.186.70.92] (port=34578 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Q8mrp-0007c2-RI for bug-gnu-emacs@gnu.org; Sun, 10 Apr 2011 01:07:23 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Q8mrn-0003Io-Sg for bug-gnu-emacs@gnu.org; Sun, 10 Apr 2011 01:07:21 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:33404) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Q8mrn-0003Ii-Nh for bug-gnu-emacs@gnu.org; Sun, 10 Apr 2011 01:07:19 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.69) (envelope-from ) id 1Q8mY9-00006v-TC; Sun, 10 Apr 2011 00:47:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-To: owner@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 10 Apr 2011 04:47:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 8457 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 8457-submit@debbugs.gnu.org id=B8457.1302410780374 (code B ref 8457); Sun, 10 Apr 2011 04:47:01 +0000 Original-Received: (at 8457) by debbugs.gnu.org; 10 Apr 2011 04:46:20 +0000 Original-Received: from localhost ([127.0.0.1] helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1Q8mXT-00005y-Bv for submit@debbugs.gnu.org; Sun, 10 Apr 2011 00:46:20 -0400 Original-Received: from fencepost.gnu.org ([140.186.70.10]) by debbugs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1Q8mXQ-00005l-Fa for 8457@debbugs.gnu.org; Sun, 10 Apr 2011 00:46:17 -0400 Original-Received: from 213-159-126-200.fibertel.com.ar ([200.126.159.213]:33611 helo=ceviche.home) by fencepost.gnu.org with esmtpsa (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1Q8mXJ-0001iP-8P; Sun, 10 Apr 2011 00:46:11 -0400 Original-Received: by ceviche.home (Postfix, from userid 20848) id A4FEB66119; Sun, 10 Apr 2011 00:46:06 -0400 (EDT) In-Reply-To: <21C5BDEF1EBA475C86898667CFA8E409@us.oracle.com> (Drew Adams's message of "Sat, 9 Apr 2011 09:45:13 -0700") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.50 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.11 Precedence: list Resent-Date: Sun, 10 Apr 2011 00:47:01 -0400 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:45726 Archived-At: > (elisp) `Argument Access in Advice' says that you should be able to > access the args using the original names: That's indeed not the case any more if the function is defined using lexical-binding mode or if it's a subroutine (i.e. defined in C). > START and END are the original arg names. Yes, the doc also says that > this method of referring to args is not the most robust. Still, it has > worked in general but no longer does. This is the error: > Just a guess: this has to do with the move to lexbind. Yup. I think the patch below may fix this problem. Stefan === modified file 'lisp/emacs-lisp/advice.el' --- lisp/emacs-lisp/advice.el 2011-03-11 20:04:22 +0000 +++ lisp/emacs-lisp/advice.el 2011-04-10 04:45:13 +0000 @@ -503,36 +503,6 @@ ;; exact structure of the original argument list as long as the new argument ;; list takes a compatible number/magnitude of actual arguments. -;; @@@ Definition of subr argument lists: -;; ====================================== -;; When advice constructs the advised definition of a function it has to -;; know the argument list of the original function. For functions and macros -;; the argument list can be determined from the actual definition, however, -;; for subrs there is no such direct access available. In Lemacs and for some -;; subrs in Emacs-19 the argument list of a subr can be determined from -;; its documentation string, in a v18 Emacs even that is not possible. If -;; advice cannot at all determine the argument list of a subr it uses -;; `(&rest ad-subr-args)' which will always work but is inefficient because -;; it conses up arguments. The macro `ad-define-subr-args' can be used by -;; the advice programmer to explicitly tell advice about the argument list -;; of a certain subr, for example, -;; -;; (ad-define-subr-args 'fset '(sym newdef)) -;; -;; is used by advice itself to tell a v18 Emacs about the arguments of `fset'. -;; The following can be used to undo such a definition: -;; -;; (ad-undefine-subr-args 'fset) -;; -;; The argument list definition is stored on the property list of the subr -;; name symbol. When an argument list could be determined from the -;; documentation string it will be cached under that property. The general -;; mechanism for looking up the argument list of a subr is the following: -;; 1) look for a definition stored on the property list -;; 2) if that failed try to infer it from the documentation string and -;; if successful cache it on the property list -;; 3) otherwise use `(&rest ad-subr-args)' - ;; @@ Activation and deactivation: ;; =============================== ;; The definition of an advised function does not change until all its advice @@ -1654,41 +1624,6 @@ ;; (fii 3 2) ;; 5 ;; -;; @@ Specifying argument lists of subrs: -;; ====================================== -;; The argument lists of subrs cannot be determined directly from Lisp. -;; This means that Advice has to use `(&rest ad-subr-args)' as the -;; argument list of the advised subr which is not very efficient. In Lemacs -;; subr argument lists can be determined from their documentation string, in -;; Emacs-19 this is the case for some but not all subrs. To accommodate -;; for the cases where the argument lists cannot be determined (e.g., in a -;; v18 Emacs) Advice comes with a specification mechanism that allows the -;; advice programmer to tell advice what the argument list of a certain subr -;; really is. -;; -;; In a v18 Emacs the following will return the &rest idiom: -;; -;; (ad-arglist (symbol-function 'car)) -;; (&rest ad-subr-args) -;; -;; To tell advice what the argument list of `car' really is we -;; can do the following: -;; -;; (ad-define-subr-args 'car '(list)) -;; ((list)) -;; -;; Now `ad-arglist' will return the proper argument list (this method is -;; actually used by advice itself for the advised definition of `fset'): -;; -;; (ad-arglist (symbol-function 'car)) -;; (list) -;; -;; The defined argument list will be stored on the property list of the -;; subr name symbol. When advice looks for a subr argument list it first -;; checks for a definition on the property list, if that fails it tries -;; to infer it from the documentation string and caches it on the property -;; list if it was successful, otherwise `(&rest ad-subr-args)' will be used. -;; ;; @@ Advising interactive subrs: ;; ============================== ;; For the most part there is no difference between advising functions and @@ -2538,50 +2473,8 @@ (require 'help-fns) (cond ((or (ad-macro-p definition) (ad-advice-p definition)) - (help-function-arglist (cdr definition))) - (t (help-function-arglist definition)))) - -;; Store subr-args as `((arg1 arg2 ...))' so I can distinguish -;; a defined empty arglist `(nil)' from an undefined arglist: -(defmacro ad-define-subr-args (subr arglist) - `(put ,subr 'ad-subr-arglist (list ,arglist))) -(defmacro ad-undefine-subr-args (subr) - `(put ,subr 'ad-subr-arglist nil)) -(defmacro ad-subr-args-defined-p (subr) - `(get ,subr 'ad-subr-arglist)) -(defmacro ad-get-subr-args (subr) - `(car (get ,subr 'ad-subr-arglist))) - -(defun ad-subr-arglist (subr-name) - "Retrieve arglist of the subr with SUBR-NAME. -Either use the one stored under the `ad-subr-arglist' property, -or try to retrieve it from the docstring and cache it under -that property, or otherwise use `(&rest ad-subr-args)'." - (if (ad-subr-args-defined-p subr-name) - (ad-get-subr-args subr-name) - ;; says jwz: Should use this for Lemacs 19.8 and above: - ;;((fboundp 'subr-min-args) - ;; ...) - ;; says hans: I guess what Jamie means is that I should use the values - ;; of `subr-min-args' and `subr-max-args' to construct the subr arglist - ;; without having to look it up via parsing the docstring, e.g., - ;; values 1 and 2 would suggest `(arg1 &optional arg2)' as an - ;; argument list. However, that won't work because there is no - ;; way to distinguish a subr with args `(a &optional b &rest c)' from - ;; one with args `(a &rest c)' using that mechanism. Also, the argument - ;; names from the docstring are more meaningful. Hence, I'll stick with - ;; the old way of doing things. - (let ((doc (or (ad-real-documentation subr-name t) ""))) - (if (not (string-match "\n\n\\((.+)\\)\\'" doc)) - ;; Signalling an error leads to bugs during bootstrapping because - ;; the DOC file is not yet built (which is an error, BTW). - ;; (error "The usage info is missing from the subr %s" subr-name) - '(&rest ad-subr-args) - (ad-define-subr-args - subr-name - (cdr (car (read-from-string - (downcase (match-string 1 doc)))))) - (ad-get-subr-args subr-name))))) + (help-function-arglist (cdr definition) 'faithful-names)) + (t (help-function-arglist definition 'faithful-names)))) (defun ad-docstring (definition) "Return the unexpanded docstring of DEFINITION." @@ -3921,10 +3814,6 @@ ;; Use the advice mechanism to advise `documentation' to make it ;; generate proper documentation strings for advised definitions: -;; This makes sure we get the right arglist for `documentation' -;; during bootstrapping. -(ad-define-subr-args 'documentation '(function &optional raw)) - ;; @@ Starting, stopping and recovering from the advice package magic: ;; =================================================================== === modified file 'lisp/help-fns.el' --- lisp/help-fns.el 2011-04-08 18:53:26 +0000 +++ lisp/help-fns.el 2011-04-10 04:45:42 +0000 @@ -99,14 +99,42 @@ (format "%S" (help-make-usage 'fn arglist)))))) ;; FIXME: Move to subr.el? -(defun help-function-arglist (def) +(defun help-function-arglist (def &optional faithful-names) + "Return a formal argument list for the function DEF. +IF FAITHFUL-NAMES is non-nil, try to return a formal arglist that uses +the same names as used in the original source code (this may not always work)." ;; Handle symbols aliased to other symbols. (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) ;; If definition is a macro, find the function inside it. (if (eq (car-safe def) 'macro) (setq def (cdr def))) (cond - ((and (byte-code-function-p def) (integerp (aref def 0))) - (let* ((args-desc (aref def 0)) + ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0)) + ((eq (car-safe def) 'lambda) (nth 1 def)) + ((eq (car-safe def) 'closure) (nth 2 def)) + ((or (and (byte-code-function-p def) (integerp (aref def 0))) + (subrp def)) + (or (when faithful-names + (let* ((doc (condition-case nil (documentation def) (error nil))) + (docargs (if doc (car (help-split-fundoc doc nil)))) + (arglist (if docargs + (cdar (read-from-string (downcase docargs))))) + (valid t)) + ;; Check validity. + (dolist (arg arglist) + (unless (and (symbolp arg) + (let ((name (symbol-name arg))) + (if (eq (aref name 0) ?&) + (memq arg '(&rest &optional)) + (not (string-match "\\." name))))) + (setq valid nil))) + (when valid arglist))) + (let* ((args-desc (if (not (subrp def)) + (aref def 0) + (let ((a (subr-arity def))) + (logior (car a) + (if (numberp (cdr a)) + (lsh (cdr a) 8) + (lsh 1 7)))))) (max (lsh args-desc -8)) (min (logand args-desc 127)) (rest (logand args-desc 128)) @@ -119,26 +147,7 @@ (push (intern (concat "arg" (number-to-string (+ 1 i min)))) arglist))) (unless (zerop rest) (push '&rest arglist) (push 'rest arglist)) - (nreverse arglist))) - ((byte-code-function-p def) (aref def 0)) - ((eq (car-safe def) 'lambda) (nth 1 def)) - ((eq (car-safe def) 'closure) (nth 2 def)) - ((subrp def) - (let ((arity (subr-arity def)) - (arglist ())) - (dotimes (i (car arity)) - (push (intern (concat "arg" (number-to-string (1+ i)))) arglist)) - (cond - ((not (numberp (cdr arglist))) - (push '&rest arglist) - (push 'rest arglist)) - ((< (car arity) (cdr arity)) - (push '&optional arglist) - (dotimes (i (- (cdr arity) (car arity))) - (push (intern (concat "arg" (number-to-string - (+ 1 i (car arity))))) - arglist)))) - (nreverse arglist))) + (nreverse arglist)))) ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap))) "[Arg list not available until function definition is loaded.]") (t t)))