apropos+describe

aproposとdescribeを一緒にしたような関数を作成。
名前はそのままapropos-desc。

aproposを使えば、シンボル一覧が取得できるが、それに(そのシンボルにバインドしている)関数などの簡単な情報(引数、返り値、ドキュメント)も一緒に表示されるようにした。

基本的には、apropos-listの結果にdescribeを適用しただけだが、sbclの標準のdescribe出力は若干量が多すぎることがあるので、自分に必要な情報だけを出力するようにして、一覧性を上げている。

例

;; 第三引数までは、apropos関数と同様
;; "multiple"を含むシンボルをcommon-lispパッケージから探して、その名前と簡易的な情報を表示する。
> (apropos-desc "multiple" :common-lisp t)
=== multiple-value-bind [:MACRO]===
ARGUMENTS  : (vars value-form &body body)

=== multiple-value-call [:SPECIAL-OPERATOR]===
ARGUMENTS  : (fun &rest args)
ARGS   TYPE: *
RETURN TYPE: ()
DOCUMENT   :
MULTIPLE-VALUE-CALL function values-form*

Call FUNCTION, passing all the values of each VALUES-FORM as arguments,
values from the first VALUES-FORM making up the first argument, etc.

=== multiple-value-list [:MACRO]===
ARGUMENTS  : (value-form)

=== multiple-value-prog1 [:SPECIAL-OPERATOR]===
ARGUMENTS  : (values-form &rest forms)
ARGS   TYPE: *
RETURN TYPE: ()
DOCUMENT   :
MULTIPLE-VALUE-PROG1 values-form form*

Evaluate VALUES-FORM and then the FORMS, but return all the values of
VALUES-FORM.

=== multiple-value-setq [:MACRO]===
ARGUMENTS  : (vars value-form)

=== multiple-values-limit [:CONSTANT]===
TYPE: (integer 0 536870911)
DOCUMENT:
The exclusive upper bound on the number of multiple VALUES that you can
  return.


;; 第四引数にTを指定すれば、一行に収まらないドキュメント(+その他)の二行目以降が省略される
>  (apropos-desc "multiple" :common-lisp t t)
=== multiple-value-bind [:MACRO]===
ARGUMENTS  : (vars value-form &body body)

=== multiple-value-call [:SPECIAL-OPERATOR]===
ARGUMENTS  : (fun &rest args)
ARGS   TYPE: *
RETURN TYPE: ()
DOCUMENT   : MULTIPLE-VALUE-CALL function values-form* .. ;;;

=== multiple-value-list [:MACRO]===
ARGUMENTS  : (value-form)

=== multiple-value-prog1 [:SPECIAL-OPERATOR]===
ARGUMENTS  : (values-form &rest forms)
ARGS   TYPE: *
RETURN TYPE: ()
DOCUMENT   : MULTIPLE-VALUE-PROG1 values-form form* .. ;;;

=== multiple-value-setq [:MACRO]===
ARGUMENTS  : (vars value-form)

=== multiple-values-limit [:CONSTANT]===
TYPE: (integer 0 536870911)
DOCUMENT: The exclusive upper bound on the number of multiple VALUES that you can .. ;;;

定義

(defun print-function-desc (sym one-line &aux (fn (symbol-function sym)))
  (let ((type-spec (sb-kernel:type-specifier (sb-kernel::info :function :type sym))))
    (format t "ARGUMENTS  : ~:[()~;~:*~(~A~)~]~%"
            (sb-kernel:%simple-fun-arglist
             (if (not (typep fn 'generic-function))
                 (sb-kernel::%closure-fun fn)
               fn)))
    (when (listp type-spec)
      (format t "ARGS   TYPE: ~:[()~;~:*~(~A~)~]~%" (second type-spec))
      (format t "RETURN TYPE: ~:[()~;~:*~(~A~)~]~%" (third type-spec)))
    (when #1=(documentation sym 'function)
      (format t "DOCUMENT   :~:[ ~;~%~]~A~%" one-line #1#))))

(defun print-macro-desc (sym one-line &aux (mc (macro-function sym)))
  (format t "ARGUMENTS  : ~:[()~;~:*~(~A~)~]~%" (sb-kernel:%simple-fun-arglist mc))
  (when #1=(documentation sym 'function)
    (format t "DOCUMENT:~:[ ~;~%~]~A~%"   one-line #1#)))

(defun print-variable-desc (sym one-line &aux (val (symbol-value sym)))
  (format t "TYPE: ~(~A~)~%" (type-of val))
  (when #1=(documentation sym 'variable)
    (format t "DOCUMENT:~:[ ~;~%~]~A~%" one-line #1#)))
 
(defun symbol-type (sym)
  (if (fboundp sym)
      (if (macro-function sym)
          :macro
        (if (special-operator-p sym)
            :special-operator
          (if (typep (symbol-function sym) 'generic-function)
              :generic-function
            :function)))
    (if (constantp sym)
        :constant
      :special)))

(defun symbol-boundp (sym)
  (or (boundp sym) (fboundp sym)))

(defun apropos-desc (string-designator &optional package external-only one-line)
  (let ((*print-lines* (if one-line 1 *print-lines*)))
    (dolist (sym (apropos-list string-designator package external-only))
      (when (symbol-boundp sym)
        (format t "~&=== ~(~S~) [~S]===~%" sym (symbol-type sym))
        (case (symbol-type sym)
          ((:function :generic-function :special-operator)
           (print-function-desc sym (not one-line)))
          (:macro
           (print-macro-desc sym (not one-line)))
          ((:constant :special)
           (print-variable-desc sym (not one-line))))
      (terpri))))
  (values))