From 2f1b7bf9e1cd2b60fe2ff94566c902a8a46ccbd3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Fri, 11 Mar 2016 10:01:27 +0100 Subject: [PATCH] compiler.graphviz: this vocab can be removed I think The compiler.cfg.graphviz vocab implements all its features and is more complete. --- extra/compiler/graphviz/graphviz-tests.factor | 6 - extra/compiler/graphviz/graphviz.factor | 142 ------------------ extra/compiler/graphviz/platforms.txt | 1 - 3 files changed, 149 deletions(-) delete mode 100644 extra/compiler/graphviz/graphviz-tests.factor delete mode 100644 extra/compiler/graphviz/graphviz.factor delete mode 100644 extra/compiler/graphviz/platforms.txt diff --git a/extra/compiler/graphviz/graphviz-tests.factor b/extra/compiler/graphviz/graphviz-tests.factor deleted file mode 100644 index 768a7f42b1..0000000000 --- a/extra/compiler/graphviz/graphviz-tests.factor +++ /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 index 093169bcbd..0000000000 --- a/extra/compiler/graphviz/graphviz.factor +++ /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 index 47e0a6946a..0000000000 --- a/extra/compiler/graphviz/platforms.txt +++ /dev/null @@ -1 +0,0 @@ -unix \ No newline at end of file