[Gd-chatter] r11199 - in trunk/libraries: graphviz-renderer network/koala/sources/examples/code-browser registry/generic
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Wed Feb 21 14:44:02 CET 2007
Author: hannes
Date: Wed Feb 21 14:44:00 2007
New Revision: 11199
Added:
trunk/libraries/graphviz-renderer/
trunk/libraries/graphviz-renderer/dot-generator.dylan (contents, props changed)
trunk/libraries/graphviz-renderer/graph-classes.dylan
- copied, changed from r11193, trunk/libraries/graph-viewer/graph-viewer.dylan
trunk/libraries/graphviz-renderer/graphviz-renderer.lid (contents, props changed)
trunk/libraries/graphviz-renderer/graphviz.dylan (contents, props changed)
trunk/libraries/graphviz-renderer/library.dylan (contents, props changed)
trunk/libraries/registry/generic/graphviz-renderer (contents, props changed)
Modified:
trunk/libraries/network/koala/sources/examples/code-browser/library.dylan
trunk/libraries/network/koala/sources/examples/code-browser/main.dylan
Log:
Job: minor
initial graphviz-wrapper, testcase in codebrowser
Added: trunk/libraries/graphviz-renderer/dot-generator.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/graphviz-renderer/dot-generator.dylan Wed Feb 21 14:44:00 2007
@@ -0,0 +1,35 @@
+module: graphviz-renderer
+author: Hannes Mehnert <hannes at mehnert.org>
+copyright: (C) 2007, All rights reversed.
+
+define function generate-dot
+ (graph :: <graph>, output :: <stream>, #key top-node) => ()
+ let top-node = top-node | graph.nodes[0];
+ write(output, "digraph G {\n");
+ process-nodes(top-node, output);
+ write(output, "}\n");
+end;
+
+define function process-nodes
+ (top-node :: <node>, output :: <stream>) => ()
+ let nodes-queue = make(<deque>);
+ push(nodes-queue, top-node);
+ let visited = make(<stretchy-vector>);
+ while (nodes-queue.size > 0)
+ let node = nodes-queue.pop;
+ process-node(node, output);
+ add!(visited, node);
+ do(curry(push-last, nodes-queue),
+ choose(method(x) ~ member?(x, nodes-queue) & ~ member?(x, visited) end,
+ successors(node)))
+ end;
+end;
+
+define function process-node (node :: <node>, output :: <stream>) => ()
+ local method print-edge (target :: <node>)
+ write(output, concatenate(" \"", node.label, "\" -> \"",
+ target.label, "\"\n"));
+ end;
+ do(print-edge, node.successors);
+end;
+
Copied: trunk/libraries/graphviz-renderer/graph-classes.dylan (from r11193, trunk/libraries/graph-viewer/graph-viewer.dylan)
==============================================================================
--- trunk/libraries/graph-viewer/graph-viewer.dylan (original)
+++ trunk/libraries/graphviz-renderer/graph-classes.dylan Wed Feb 21 14:44:00 2007
@@ -1,105 +1,102 @@
-Module: graph-viewer
+Module: graphviz-renderer
Synopsis: We want to see graphs
Author: Andreas Bogk, Hannes Mehnert
-Copyright: (C) 2005, All rights reserved.
+Copyright: (C) 2005, All rights reversed.
define sealed class <graph> (<object>)
- slot nodes :: <stretchy-vector> = make(<stretchy-vector>);
- slot edges :: <stretchy-vector> = make(<stretchy-vector>);
+ constant slot nodes :: <stretchy-vector> = make(<stretchy-vector>);
+ constant slot edges :: <stretchy-vector> = make(<stretchy-vector>);
end;
define sealed class <node> (<object>)
- slot graph, required-init-keyword: graph:;
- slot label = "", init-keyword: label:;
- slot outgoing-edges :: <stretchy-vector> = make(<stretchy-vector>);
- slot incoming-edges :: <stretchy-vector> = make(<stretchy-vector>);
+ constant slot graph, required-init-keyword: graph:;
+ constant slot label :: <string> = "", init-keyword: label:;
+ constant slot outgoing-edges :: <stretchy-vector> = make(<stretchy-vector>);
+ constant slot incoming-edges :: <stretchy-vector> = make(<stretchy-vector>);
end;
define sealed class <edge> (<object>)
- slot graph, required-init-keyword: graph:;
- slot label = "", init-keyword: label:;
- slot source :: <node>, required-init-keyword: source:;
- slot target :: <node>, required-init-keyword: target:;
+ constant slot graph, required-init-keyword: graph:;
+ constant slot label :: <string> = "", init-keyword: label:;
+ constant slot source :: <node>, required-init-keyword: source:;
+ constant slot target :: <node>, required-init-keyword: target:;
end;
-define method create-node (graph :: <graph>, #key label)
+define function create-node (graph :: <graph>, #key label)
=> (node :: <node>)
let node = make(<node>,
graph: graph,
- label: label | graph.nodes.size);
+ label: label | integer-to-string(graph.nodes.size));
add!(graph.nodes, node);
node
end;
-define method create-edge (graph :: <graph>,
- source :: <node>,
- target :: <node>,
- #key label)
+define function create-edge
+ (graph :: <graph>, source :: <node>, target :: <node>, #key label)
=> (edge :: <edge>);
let edge = make(<edge>,
graph: graph,
source: source,
target: target,
- label: label | graph.edges.size);
+ label: label | integer-to-string(graph.edges.size));
add!(graph.edges, edge);
add!(source.outgoing-edges, edge);
add!(target.incoming-edges, edge);
edge
end;
-define method adjacent-edges (node :: <node>)
+define function maybe-create-nodes (graph :: <graph>, pres :: <collection>)
+ => (res :: <collection>)
+ let all = graph.nodes;
+ let nodes-to-connect = choose-by(rcurry(member?, pres, test: \=),
+ map(label, all),
+ all);
+ let missing-nodes = choose(complement(curry(find-node, graph)), pres);
+ let new-nodes = map(curry(create-node, graph, label:), missing-nodes);
+ concatenate(new-nodes, nodes-to-connect);
+end;
+
+define function find-node (graph :: <graph>, name :: <string>)
+ => (res :: false-or(<node>))
+ let res = choose(compose(curry(\=, name), label), graph.nodes);
+ if (res & res.size = 1)
+ res[0];
+ end;
+end;
+
+define function add-predecessors (node :: <node>, pres :: <collection>) => ()
+ let nodes-to-connect = maybe-create-nodes(node.graph, pres);
+ map(curry(create-edge, node.graph, node), nodes-to-connect);
+end;
+
+define function add-successors (node :: <node>, succs :: <collection>) => ()
+ let nodes-to-connect = maybe-create-nodes(node.graph, succs);
+ map(rcurry(curry(create-edge, node.graph), node), nodes-to-connect);
+end;
+
+define function adjacent-edges (node :: <node>)
=> (edges :: <collection>);
concatenate(node.incoming-edges, node.outgoing-edges)
end;
-define method remove-edge (graph :: <graph>,
+define function remove-edge (graph :: <graph>,
edge :: <edge>)
remove!(edge.source.outgoing-edges, edge);
remove!(edge.target.incoming-edges, edge);
remove!(graph.edges, edge);
end;
-/*
-define method remove-node (graph :: <graph>,
- node :: <node>)
- do(curry(remove-edge, graph), node.adjacent-edges);
- remove!(graph.nodes, node)
-end;
-*/
-
-define method predecessors (node :: <node>)
+define function predecessors (node :: <node>)
=> (predecessors :: <collection>);
map(source, node.incoming-edges)
end;
-define method successors (node :: <node>)
+define function successors (node :: <node>)
=> (predecessors :: <collection>);
map(target, node.outgoing-edges)
end;
-define method neighbours (node :: <node>)
+define function neighbours (node :: <node>)
=> (predecessors :: <collection>);
concatenate(node.predecessors, node.successors)
end;
-
-define method incoming-degree (node :: <node>)
- => (in-degree :: <integer>)
- node.incoming-edges.size
-end;
-
-define method outgoing-degree (node :: <node>)
- => (out-degree :: <integer>)
- node.outgoing-edges.size
-end;
-
-define method degree (node :: <node>)
- => (degree :: <integer>)
- node.incoming-degree + node.outgoing-degree
-end;
-
-
-
-
-
-
-
Added: trunk/libraries/graphviz-renderer/graphviz-renderer.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/graphviz-renderer/graphviz-renderer.lid Wed Feb 21 14:44:00 2007
@@ -0,0 +1,5 @@
+library: graphviz-renderer
+files: library
+ graph-classes
+ dot-generator
+ graphviz
\ No newline at end of file
Added: trunk/libraries/graphviz-renderer/graphviz.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/graphviz-renderer/graphviz.dylan Wed Feb 21 14:44:00 2007
@@ -0,0 +1,17 @@
+module: graphviz-renderer
+author: Hannes Mehnert <hannes at mehnert.org>
+copyright: (C) 2007, All rights reversed.
+
+
+define function generate-graph (graph :: <graph>, top :: <node>)
+ => (result-filename :: <string>)
+ let file-prefix = concatenate("/tmp/foo", integer-to-string(random(10000)));
+ let dot = concatenate(file-prefix, ".dot");
+ let png = concatenate(file-prefix, ".png");
+ with-open-file (stream = dot, direction: #"output")
+ generate-dot(graph, stream, top-node: top);
+ end;
+ run-application(concatenate("dot -Tpng -o ", png, " ", dot));
+ png;
+end;
+
Added: trunk/libraries/graphviz-renderer/library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/graphviz-renderer/library.dylan Wed Feb 21 14:44:00 2007
@@ -0,0 +1,28 @@
+module: dylan-user
+author: Hannes Mehnert <hannes at mehnert.org>
+copyright: (C) 2007, All rights reversed.
+
+define library graphviz-renderer
+ use dylan;
+ use system;
+ use io;
+ use common-dylan;
+ export graphviz-renderer;
+end;
+
+define module graphviz-renderer
+ use dylan;
+ use operating-system;
+ use file-system;
+ use format;
+ use streams;
+ use standard-io;
+ use common-dylan;
+ use simple-random;
+
+ export <graph>, <node>, <edge>,
+ create-node, create-edge,
+ generate-dot, generate-graph,
+ find-node, add-successors,
+ add-predecessors;
+end;
\ No newline at end of file
Modified: trunk/libraries/network/koala/sources/examples/code-browser/library.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/code-browser/library.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/code-browser/library.dylan Wed Feb 21 14:44:00 2007
@@ -7,7 +7,7 @@
use common-dylan,
import: { common-extensions };
use io,
- import: { format, streams };
+ import: { format, format-out, streams };
use system,
import: { locators, threads };
use koala,
@@ -23,6 +23,7 @@
use source-records;
use release-info;
use regular-expressions;
+ use graphviz-renderer;
//use environment-deuce;
end;
@@ -31,11 +32,12 @@
use dylan;
use threads;
use common-extensions,
- exclude: { format-to-string, split };
+ exclude: { format-to-string };
use locators;
use format;
+ use format-out;
use streams;
- use dsp;
+ use dsp, exclude: { split };
use regular-expressions, import: { regexp-replace };
use source-records;
use source-records-implementation;
@@ -44,6 +46,7 @@
application-filename,
application-arguments };
use release-info;
+ use graphviz-renderer;
// use environment-deuce;
end;
Modified: trunk/libraries/network/koala/sources/examples/code-browser/main.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/code-browser/main.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/code-browser/main.dylan Wed Feb 21 14:44:00 2007
@@ -178,6 +178,55 @@
end;
begin
- main();
+ main()
+end;
+
+/*
+begin
+ let class-graph = generate-class-graph("<string>");
+ let filename = generate-graph(class-graph, find-node(class-graph, "<object>"));
+ format-out("filename %s\n", filename);
+end;
+*/
+
+define function generate-class-graph (class-name :: <string>) => (res :: <graph>)
+ let project = find-project("code-browser");
+ open-project-compiler-database(project,
+ warning-callback: callback-handler,
+ error-handler: callback-handler);
+ parse-project-source(project);
+
+ let library-object = project-library(project);
+ let module-object
+ = first(library-modules(project, project-library(project)));
+ let class
+ = find-environment-object(project, class-name, library: library-object, module: module-object);
+ let todo = make(<deque>);
+ let visited = make(<stretchy-vector>);
+ push(todo, class);
+ let graph = make(<graph>);
+
+ local method get-class-name (class)
+ split(environment-object-display-name(project, class, #f), ':')[0];
+ end;
+ while (todo.size > 0)
+ let class = pop(todo);
+ let class-name = get-class-name(class);
+ let class-node = find-node(graph, class-name);
+ unless (class-node)
+ format-out("class node for %s was not found, creating\n", class-name);
+ class-node := create-node(graph, label: class-name);
+ end;
+ add!(visited, class);
+ let superclasses
+ = class-direct-superclasses(project, class);
+ format-out("superclasses for %s %=\n",
+ class-name, map(get-class-name, superclasses));
+ add-successors(class-node, map(get-class-name, superclasses));
+ do(curry(push-last, todo),
+ choose(method(x) ~ member?(x, visited) & ~ member?(x, todo) end,
+ superclasses))
+ end;
+ graph;
end;
Added: trunk/libraries/registry/generic/graphviz-renderer
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/graphviz-renderer Wed Feb 21 14:44:00 2007
@@ -0,0 +1 @@
+abstract://dylan/graphviz-renderer/graphviz-renderer.lid
More information about the chatter
mailing list