1 (in-package metabang.graph)
3 (defun roots-and-child-function->graph (roots child-function max-depth)
4 (let ((g (make-graph 'graph-container)))
5 (labels ((init-vertex (vertex depth)
6 (when (or (not max-depth) (< depth max-depth))
7 (unless (find-vertex g vertex nil)
9 (loop for child in (funcall child-function vertex) do
10 (init-vertex child (1+ depth))
11 (add-edge-between-vertexes g vertex child))))))
12 (loop for root in roots do
13 (init-vertex root 0)))
16 ;;; ---------------------------------------------------------------------------
18 (defun class-hierarchy->dot (base-class-or-classes output &key (filter (constantly t)))
19 (metabang.graph:graph->dot
20 (roots-and-child-function->graph
21 (ensure-list base-class-or-classes)
23 (when (funcall filter cname)
24 (mapcar #'class-name (mopu:direct-subclasses (find-class cname)))))
27 :graph-formatter (lambda (g stream)
29 (format stream "rankdir=LR"))
31 :vertex-labeler (lambda (vertex stream)
32 (format stream "~(~A~)" (symbol-name (element vertex))))
34 :vertex-formatter (lambda (vertex stream)
35 (when (subtypep (element vertex) 'containers::concrete-container)
36 (format stream "color=\"blue\", style=\"filled\", fontcolor=\"white\", fillcolor=\"blue\"")))))
38 ;;; ---------------------------------------------------------------------------
41 (class-hierarchy->dot 'abstract-container
43 :filter (lambda (class-name)
44 (not (subtypep class-name 'containers::abstract-generator))))
48 (class-hierarchy->dot '(containers::abstract-generator
49 containers::transforming-iterator-mixin
50 containers::basic-filtered-iterator-mixin
51 containers::circular-iterator-mixin)
52 "thousand-parsers:iterators.dot")