diff --git a/extra/compiler/graphviz/graphviz-tests.factor b/extra/compiler/graphviz/graphviz-tests.factor new file mode 100644 index 0000000000..23f5f6fb60 --- /dev/null +++ b/extra/compiler/graphviz/graphviz-tests.factor @@ -0,0 +1,6 @@ +IN: compiler.graphviz.tests +USING: compiler.graphviz io.files ; + +[ 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 index 9823f93d4e..7378d3284c 100644 --- a/extra/compiler/graphviz/graphviz.factor +++ b/extra/compiler/graphviz/graphviz.factor @@ -18,15 +18,18 @@ IN: compiler.graphviz "}" , ] { } make , ; inline -: render-graph ( quot -- ) +: render-graph ( quot -- name ) { } make "cfg" ".dot" make-unique-file dup "Wrote " prepend print [ [ concat ] dip ascii set-file-lines ] [ { "dot" "-Tpng" "-O" } swap suffix try-process ] - [ ".png" append "open" swap 2array try-process ] + [ ".png" append ] tri ; inline +: display-graph ( name -- ) + "open" swap 2array try-process ; + : attrs>string ( seq -- str ) [ "" ] [ "," join "[" "]" surround ] if-empty ; @@ -75,12 +78,12 @@ IN: compiler.graphviz : optimized-cfg ( quot -- cfgs ) { { [ dup cfg? ] [ 1array ] } - { [ dup quotation? ] [ test-cfg [ optimize-cfg ] map ] } - { [ dup word? ] [ test-cfg [ optimize-cfg ] map ] } + { [ dup quotation? ] [ test-cfg [ dup cfg set optimize-cfg ] map ] } + { [ dup word? ] [ test-cfg [ dup cfg set optimize-cfg ] map ] } [ ] } cond ; -: render-cfg ( cfg -- ) +: render-cfg ( cfg -- name ) optimized-cfg [ cfgs ] render-graph ; : dom-trees ( cfgs -- ) @@ -95,7 +98,7 @@ IN: compiler.graphviz ] over cfg-title graph, ] each ; -: render-dom ( cfg -- ) +: render-dom ( cfg -- name ) optimized-cfg [ dom-trees ] render-graph ; SYMBOL: word-counts @@ -131,7 +134,7 @@ SYMBOL: vertex-names H{ } clone vertex-names set [ "ROOT" ] dip (call-graph-edges) ; -: render-call-graph ( tree -- ) +: render-call-graph ( tree -- name ) dup quotation? [ build-tree ] when analyze-recursive drop [ [ call-graph get call-graph-edges ] "Call graph" graph, ]