2007/10/14

[Common Lisp] condition のクラス階層

Common Lisp のコンディションシステムでは全てのコンディションは condition クラスを継承します。
どんなクラスがあらかじめ定義されているか調べてみようと思います。
サブクラスは sb-mop:class-direct-subclasses で取得できます。
今回は common-lisp パッケージのクラスだけに限定します。
表示は cl-dot を使用して condition のクラス階層のグラフを作成してみます。
cl-dot は dot コマンドを使用するため Graphviz をインストールしておく必要があります。
以下のコードで condition クラスを頂点としたクラス階層が表示されます。
表示には evince を使用しています。また後の方は日本語とテストなので気にしないでください。
画像にして表示してみると面白いです。

(require :cl-dot)

(defmethod cl-dot:object-node ((object class))
(make-instance 'cl-dot:node
:attributes (list :label (class-name object)
:shape :box
:fontname "Arial")))

(defmethod cl-dot:object-points-to ((object class))
(loop for each in (sb-mop:class-direct-subclasses object)
if (eq (find-package :common-lisp)
(symbol-package (class-name each)))
collect each))

(defun my-dot-graph (graph outfile &optional (format (pathname-type outfile)))
"cl-dot:dot-graph を出力ファイルの拡張子に合せたフォーマットを使うようにしたもの。
データをファイル経由で dot に渡すようにして日本語が出力できるようにした。"

(let ((dot-file (make-pathname :defaults outfile :type "dot")))
(with-open-file (out dot-file
:direction :output
:if-exists :supersede
:external-format :utf-8)
(cl-dot:print-graph graph out))
(sb-ext:run-program cl-dot:*dot-path*
(list (format nil "-T~a" format) "-o" outfile)
:input dot-file
:output *standard-output*)))

(let ((file "/tmp/condition.png"))
(my-dot-graph (cl-dot:generate-graph (find-class 'condition)) file)
(asdf:run-shell-command (format nil "evince ~a" file)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; 日本語のテスト
(defclass ばの () ())

(defclass びの (ばの) ())

(defclass がの (ばの) ())

(defclass なの (びの がの) ())

(defmethod cl-dot:object-points-to ((object class))
(sb-mop:class-direct-subclasses object))

(let ((file "/tmp/jp.pdf"))
(my-dot-graph (cl-dot:generate-graph (find-class 'ばの)) file)
(asdf:run-shell-command (format nil "evince ~a" file)))


それにしても、cl-dot の API は Common Lisp らしいです。おもしろい。

0 件のコメント: