inheritance graph

inheritance-graph.lisp

(defpackage #:snippets/inheritance-graph
  (:use #:cl)
  (:import-from #:sb-mop
                #:class-direct-subclasses))

(in-package #:snippets/inheritance-graph)

(defstruct digraph
  (strict-p t)
  (name "unnamed")
  (contents '()))

(defun write-digraph (digraph &optional (stream *standard-output*))
  (format stream
          "~<~;~:[~;strict ~]digraph ~A {~2I~{~:@_\"~A\"~:_ -> ~:_\"~A\"~}~%}~%~:>"
          (list
           (digraph-strict-p digraph)
           (digraph-name digraph)
           (digraph-contents digraph))))

(defun edgify (superclass subclasses)
  (let ((superclass-name (class-name superclass)))
    (mapcan (lambda (subclass)
              (list superclass-name (class-name subclass)))
            subclasses)))

(defun traverse-hierarchy (root-class)
  (let ((direct-subclasses (class-direct-subclasses root-class)))
    (when direct-subclasses
      (nconc (edgify root-class direct-subclasses)
             (mapcan #'traverse-hierarchy direct-subclasses)))))

(defvar *digraph*
  (make-digraph
   :name "inheritance"
   :contents (traverse-hierarchy (find-class 't))))