Emacs 24のバイトコード関数のArgspecまたはArity


8

関数のアリティをテストするコードがあります。これを使用して、パッケージの最新バージョンで追加されたオプションの引数が存在するかどうかを判断します。subr-arity組み込み関数を呼び出し、バイトコードオブジェクトとラムダのarglistを解析します。

(defun function-argspec (func)
  (if (symbolp func) (setq func (indirect-function func)))
  (cond
   ((byte-code-function-p func)
    (aref func 0))
   ((and (consp func)
         (eq (car func) 'lambda)
         (consp (cdr func)))
    (car (cdr func)))
  ))

これはEmacs 23までうまく機能しました。Ubuntu14.04上のEmacs 24.3では、一部の機能ではうまく機能しますが、他の機能では機能しません。

(function-argspec 'revert-buffer)
(&optional ignore-auto noconfirm preserve-modes)
(require 'vc)
vc
(function-argspec 'vc-print-log-internal)
1283

どうやら、バイトコード形式がマニュアルに反映されていない方法で変更されました。

(symbol-function 'vc-print-log-internal)
#[1283 \301\211\302\301\211\203\211@\303!\203\304\262A\266\202\202\210\203'\305>\202*\306>??\262\2036\307\2027\310\262\311
\312\313\314\315\316
$\317"\320\321%\312\322\323\315\316#\324"\325\326%\312\327\330\315\316!\331"\332\333%\312\334\335\315\316%\336"\325\337%&\262\207 [vc-log-short-style nil *vc-change-log* file-directory-p t directory file short long vc-log-internal-common make-byte-code 1028 \304\305\303\301\205\300\302&\207 vconcat vector [vc-call-backend print-log] 12 

(fn BK BUF TYPE-ARG FILES-ARG) 771 \303\300\301\302$\207 [vc-print-log-setup-buttons] 8 

(fn BK FILES-ARG RET) 257 \301\302\300#\207 [vc-call-backend show-log-entry] 5 

(fn BK) 514 \305\300\301\302\303\304%\207 [vc-print-log-internal] 

(fn IGNORE-AUTO NOCONFIRM)] 28 

(fn BACKEND FILES WORKING-REVISION &optional IS-START-REVISION LIMIT)]

バイトコードオブジェクトの引数リストに確実にアクセスするにはどうすればよいですか?アリティが行うことを知っているだけで、引数の名前は気にしません。より正確には、必須の引数の数とオプションの引数の数を知りたいですsubr-arity。つまり、から取得したのと同じ情報が必要です。もちろん、私のコードは古いスタイルのバイトコードと新しいスタイルのバイトコードの両方に対応している必要があるので、どこを掘るかだけでなく、いつどこで掘るかを知る必要があります。


接線:この部分を削除して例を削減したかもしれませんが、にクロージャーのサポートを追加したい場合がありますfunction-argspec
Malabarba 2014年

Gilles、function-argspecバイトコード関数やクロージャーを含む、どこかに関数の最終版がありますか?
Jordon Biondo

@JordonBiondoここに回答として追加しました。
Gilles「SO-邪悪なことをやめよう」

回答:


8

編集:ウー!通常の引数リストまたは整数バージョンのいずれかbyte-compile-arglist-signatureを受け取り、署名のいくらかを返す関数を見つけました:bytecomp.el!

(byte-compile-arglist-signature 1283) ;; => (3 . 5)

最初の回答:

これがどこかで文書化されているかどうかについて、他の誰かが力を貸してくれることを願っていますが、これは私exec_byte_codeがEmacsソースのbytecode.cを読んで学んだことです。

あなたが見る数字は、バイトコードが実際に実行されているときにargspecを計算するために使用されます。パフォーマンスのためにこれを想定していますが、実際には非常に賢いです。

このコードを書いて、その数を与えられた関数のアリティを計算する方法を示します:

(defun arity-info (byte-code-int)
  (let* ((required  (logand byte-code-int 127))
         (total-named  (lsh byte-code-int -8))
         (optional (- total-named required))
         (allow-rest  (if (not (zerop (logand byte-code-int 128))) "yes" "no")))
    (list
     (cons 'required required)
     (cons 'total-named total-named)
     (cons 'optional optional)
     (cons 'allow-rest allow-rest))))

arity-info1283で実行すると、次のようになることがわかります。

((required . 3) (total-named . 5) (optional . 2) (allow-rest . "no"))

あなたが見ることができるものは、vc-print-log-internal完全に5つの引数、3つは必須、2つはオプションで、&restを許可しません。

(vc-print-log-internal BACKEND FILES WORKING-REVISION &optional IS-START-REVISION LIMIT)

よくやった。[フィラー文字]
2014年

2

リクエストに応じて、との実装を以下function-argspecに示しfunction-arityます。Jordon Biondoのオリジナルの Emacs 24バイトコードソリューションを使用しました。

(cond
 ;; XEmacs
 ((fboundp 'compiled-function-arglist)
  (defalias 'emacsen-compiled-function-arglist 'compiled-function-arglist))
 ;; GNU Emacs
 (t
  (defun emacsen-make-up-number-arglist (start end tail)
    (while (< start end)
      (setq end (1- end))
      (setq tail (cons (intern (format "a%d" end)) tail)))
    tail)
  (defun emacsen-compiled-function-arglist (func)
    (let ((a (aref func 0)))
      (if (integerp a)
          ;; An integer encoding the arity. Encountered in Emacs 24.3.
          ;; /emacs/971/argspec-or-arity-of-a-bytecode-function-in-emacs-24/973#973
          (let ((arglist (if (zerop (logand a 128))
                             nil
                           '(&rest rest)))
                (mandatory (logand a 127))
                (nonrest (lsh a -8)))
            (if (> nonrest mandatory)
                (setq arglist (cons '&optional (emacsen-make-up-number-arglist mandatory nonrest arglist))))
            (emacsen-make-up-number-arglist 0 mandatory arglist))
        ;; Otherwise: this is the arglist. The only format I've seen up to GNU 23.
        a)))))

(defun function-argspec (func)
  "Return a function's argument list.
For byte-compiled functions in Emacs >=24, some information may be lost as the
byte compiler sometimes erases argument names. In this case, fake argument names
are reconstructed."
  (if (symbolp func) (setq func (indirect-function func)))
  (cond
   ((subrp func)
    (let ((docstring (documentation func)))
      (save-match-data
        (if (string-match "\n.*\\'" docstring)
            (let ((form (read (match-string 0 docstring))))
              (cdr form))
          nil))))
   ((byte-code-function-p func)
    (emacsen-compiled-function-arglist func))
   ((and (consp func)
         (eq (car func) 'lambda)
         (consp (cdr func)))
    (car (cdr func)))
   ((and (consp func)
         (eq (car func) 'closure)
         (consp (cdr func))
         (consp (cdr (cdr func))))
    (car (cdr (cdr func))))
   (t (signal 'wrong-type-argument
              (list 'functionp func)))))

(defun function-arity (func)
  "Return a function's arity as (MIN . MAX).
Return minimum and maximum number of args allowed for SUBR.
The returned value is a pair (MIN . MAX).  MIN is the minimum number
of args.  MAX is the maximum number or the symbol `many', for a
function with `&rest' args, or `unevalled' for a special form.

This function is like `subr-arity', but also works with user-defined
and byte-code functions. Symbols are dereferenced through
`indirect-function'."
  ;; TODO: keyword support
  (if (symbolp func) (setq func (indirect-function func)))
  (cond
   ((subrp func)
    (subr-arity func))
   (t
    (let ((mandatory 0) (optional 0) (rest nil)
          (where 'mandatory))
      (when (and (consp func) (eq 'macro (car func)))
        (setq func (cdr func))
        (setq rest 'unevalled))
      (let ((argspec (function-argspec func)))
        (dolist (arg argspec)
          (cond
           ((eq arg '&optional) (setq where 'optional))
           ((eq arg '&rest) (unless rest (setq rest 'many)))
           (t (set where (+ (symbol-value where) 1)))))
        (cons mandatory (or rest (+ mandatory optional))))))))
弊社のサイトを使用することにより、あなたは弊社のクッキーポリシーおよびプライバシーポリシーを読み、理解したものとみなされます。
Licensed under cc by-sa 3.0 with attribution required.