xyzzyでarglist関数っぽいの

(defun arglist (symbol)
  "シンボル関数の引数をリストで返す."
  (if (symbolp symbol)
      (let* ((fn (symbol-function symbol))
             (cl (and (si:*closurep fn) (si:closure-body fn))))
        (cond ((si:*builtin-function-p fn)
               (get symbol 'si::builtin-function-argument))
              ((eq (car cl) 'lambda)
               (cadr cl))
              ((eq (car fn) 'macro)
               (cadr fn))))
    (error "not symbol: ~S" symbol)))

(arglist 'nth)            ; =>(lisp::n list)

マクロ使えば関数引数(arglist #'car)とかにも使えそうだけど、組み込み関数からのシンボルの取り出し方が分からない。

2008-09-25T19:36:19+09:00 [追記]

マクロで無理やり書き直してみた。見た目ほとんど変わってない。

(defmacro arglist (x)
  (let* ((fn (coerce (if (eq (car x) 'lambda)
                         x (cadr x))
                     'function))
         (cl (and (si:*closurep fn) (si:closure-body fn))))
    (cond ((si:*builtin-function-p fn)
           `(get (cadr ',x) 'si::builtin-function-argument))
          ((eq (car cl) 'lambda)
           `(cadr ',cl))
          ((eq (car fn) 'macro)
           `(cadr ',fn)))))

これで関数シンボルとかラムダ式とかにも使えるはず。

# マクロの側面しか見てない使い方だなあ…

2008-10-01T08:28:28+09:00 [追記の追記]

NANRI さんのコメントを受けてもう一度関数で書き直す。

横幅が狭いので多少インデントに無理があるのはご愛嬌ということで。

(defun arglist (x)
  (let* ((fn (or (and (consp x) (eq (car x) 'macro) x)
                 (coerce x 'function)))
         (cl (and (si:*closurep fn) (si:closure-body fn))))
    (cond ((si:*builtin-function-p fn)
           (labels ((symbol-builtin-function-name-p (sym)
                      (and (fboundp sym)
                           (si:*builtin-function-p 
                            (symbol-function sym))
                           sym))
                    (builtin-function-name (f)
                      (when (string-match "#<function: \\(.+\\)>"
                                          (princ-to-string f))
                        (match-string 1))))
             (get (some #'symbol-builtin-function-name-p
                        (find-all-symbols
                         (builtin-function-name fn)))
                  'si::builtin-function-argument)))
          ((eq (car cl) 'lambda)
           (cadr cl))
          ((eq (car fn) 'macro)
           (cadr fn)))))

;;; テスト
;;; 関数オブジェクト (組み込み、普通の、ラムダ)
(arglist #'car)                 ; (list)
(arglist #'arglist)             ; (x)
(arglist #'(lambda (n) (1+ n))) ; (n)
;;; シンボル (組み込み、普通の、マクロの)
(arglist 'car)                  ; (list)
(arglist 'arglist)              ; (x)
(arglist 'when)                 ; (lisp::test &body lisp::body)
;;; コンスセル (ラムダ式、マクロ)
(arglist '(lambda (n) (1+ n)))  ; (n)
(arglist #'when)                ; (lisp::test &body lisp::body)

いい感じです。

問題は実用性が無いことかな。