]> gitweb.factorcode.org Git - factor.git/commitdiff
compiler.graphviz: this vocab can be removed I think
authorBjörn Lindqvist <bjourne@gmail.com>
Fri, 11 Mar 2016 09:01:27 +0000 (10:01 +0100)
committerBjörn Lindqvist <bjourne@gmail.com>
Fri, 11 Mar 2016 09:01:27 +0000 (10:01 +0100)
The compiler.cfg.graphviz vocab implements all its features and is more complete.

extra/compiler/graphviz/graphviz-tests.factor [deleted file]
extra/compiler/graphviz/graphviz.factor [deleted file]
extra/compiler/graphviz/platforms.txt [deleted file]

diff --git a/extra/compiler/graphviz/graphviz-tests.factor b/extra/compiler/graphviz/graphviz-tests.factor
deleted file mode 100644 (file)
index 768a7f4..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-IN: compiler.graphviz.tests
-USING: compiler.graphviz io.files kernel tools.test ;
-
-{ t } [ [ [ 1 ] [ 2 ] if ] render-cfg exists? ] unit-test
-{ t } [ [ [ 1 ] [ 2 ] if ] render-dom exists? ] unit-test
-{ t } [ [ [ 1 ] [ 2 ] if ] render-call-graph exists? ] unit-test
diff --git a/extra/compiler/graphviz/graphviz.factor b/extra/compiler/graphviz/graphviz.factor
deleted file mode 100644 (file)
index 093169b..0000000
+++ /dev/null
@@ -1,142 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license
-USING: accessors arrays assocs combinators compiler.cfg
-compiler.cfg.debugger compiler.cfg.dominance
-compiler.cfg.dominance.private compiler.cfg.rpo
-compiler.tree.builder compiler.tree.recursive graphviz.render io
-io.encodings.ascii io.files io.files.unique io.launcher kernel
-make math math.parser namespaces quotations sequences words ;
-QUALIFIED: assocs
-IN: compiler.graphviz
-
-: quotes ( str -- str' ) "\"" "\"" surround ;
-
-: graph, ( quot title -- )
-    [
-        quotes "digraph " " {" surround ,
-        call
-        "}" ,
-    ] { } make , ; inline
-
-: render-graph ( quot -- name )
-    { } make
-    "cfg" ".dot" make-unique-file
-    dup "Wrote " prepend print
-    [ [ concat ] dip ascii set-file-lines ]
-    [ [ ?default-graphviz-program "-Tpng" "-O" ] dip 4array try-process ]
-    [ ".png" append ]
-    tri ; inline
-
-: display-graph ( name -- )
-    "open" swap 2array try-process ;
-
-: attrs>string ( seq -- str )
-    [ "" ] [ "," join "[" "]" surround ] if-empty ;
-
-: edge,* ( from to attrs -- )
-    [
-        [ quotes % " -> " % ] [ quotes % " " % ] [ attrs>string % ] tri*
-        ";" %
-    ] "" make , ;
-
-: edge, ( from to -- )
-    { } edge,* ;
-
-: bb-edge, ( from to -- )
-    [ number>> number>string ] bi@ edge, ;
-
-: node-style, ( str attrs -- )
-    [ [ quotes % " " % ] [ attrs>string % ";" % ] bi* ] "" make , ;
-
-: cfg-title ( cfg/mr -- string )
-    [
-        "=== word: " %
-        [ word>> name>> % ", label: " % ]
-        [ label>> name>> % ]
-        bi
-    ] "" make ;
-
-: cfg-vertex, ( bb -- )
-    [ number>> number>string ]
-    [ kill-block?>> { "color=grey" "style=filled" } { } ? ]
-    bi node-style, ;
-
-: cfgs ( cfgs -- )
-    [
-        [
-            [ [ cfg-vertex, ] each-basic-block ]
-            [
-                [
-                    dup successors>> [
-                        bb-edge,
-                    ] with each
-                ] each-basic-block
-            ] bi
-        ] over cfg-title graph,
-    ] each ;
-
-: optimized-cfg ( quot -- cfgs )
-    {
-        { [ dup cfg? ] [ 1array ] }
-        { [ dup quotation? ] [ test-ssa ] }
-        { [ dup word? ] [ test-ssa ] }
-        [ ]
-    } cond ;
-
-: render-cfg ( cfg -- name )
-    optimized-cfg [ cfgs ] render-graph ;
-
-: dom-trees ( cfgs -- )
-    [
-        [
-            needs-dominance
-            dom-childrens get [
-                [
-                    bb-edge,
-                ] with each
-            ] assoc-each
-        ] over cfg-title graph,
-    ] each ;
-
-: render-dom ( cfg -- name )
-    optimized-cfg [ dom-trees ] render-graph ;
-
-SYMBOL: word-counts
-SYMBOL: vertex-names
-
-: vertex-name ( call-graph-node -- string )
-    label>> vertex-names get [
-        word>> name>>
-        dup word-counts get [ 0 or 1 + dup ] assocs:change-at
-        number>string " #" glue
-    ] cache ;
-
-: vertex-attrs ( obj -- string )
-    tail?>> { "style=bold,label=\"tail\"" } { } ? ;
-
-: call-graph-edge, ( from to attrs -- )
-    [ [ vertex-name ] [ vertex-attrs ] bi ] dip append edge,* ;
-
-: (call-graph-back-edges) ( string calls -- )
-    [ { "color=red" } call-graph-edge, ] with each ;
-
-: (call-graph-edges) ( string children -- )
-    [
-        {
-            [ { } call-graph-edge, ]
-            [ [ vertex-name ] [ label>> loop?>> { "shape=box" } { } ? ] bi node-style, ]
-            [ [ vertex-name ] [ calls>> ] bi (call-graph-back-edges) ]
-            [ [ vertex-name ] [ children>> ] bi (call-graph-edges) ]
-        } cleave
-    ] with each ;
-
-: call-graph-edges ( call-graph-node -- )
-    H{ } clone word-counts set
-    H{ } clone vertex-names set
-    [ "ROOT" ] dip (call-graph-edges) ;
-
-: render-call-graph ( tree -- name )
-    dup quotation? [ build-tree ] when
-    analyze-recursive drop
-    [ [ call-graph get call-graph-edges ] "Call graph" graph, ]
-    render-graph ;
diff --git a/extra/compiler/graphviz/platforms.txt b/extra/compiler/graphviz/platforms.txt
deleted file mode 100644 (file)
index 47e0a69..0000000
+++ /dev/null
@@ -1 +0,0 @@
-unix
\ No newline at end of file