compiler.cfg.graphviz: refactoring

db4
Alex Vondrak 2011-06-03 18:11:08 -07:00 committed by John Benediktsson
parent 64b541759e
commit d6849da7ec
1 changed files with 53 additions and 32 deletions
basis/compiler/cfg/graphviz

View File

@ -1,9 +1,9 @@
! Copyright (C) 2011 Alex Vondrak.
! See http://factorcode.org/license.txt for BSD license
USING: accessors fry io io.streams.string kernel math.parser
namespaces prettyprint sequences splitting strings
tools.annotations
USING: accessors fry io io.directories io.pathnames
io.streams.string kernel math math.parser namespaces
prettyprint sequences splitting strings tools.annotations
compiler.cfg
compiler.cfg.builder
@ -53,37 +53,58 @@ linearize? off
add
] [ drop ] if ;
SYMBOL: step
: cfgviz ( cfg filename -- cfg )
over
<digraph>
graph[ "t" =labelloc ];
node[ "box" =shape "Courier" =fontname 10 =fontsize ];
swap
[ ?linearize ]
[ [ add-cfg-vertex ] each-basic-block ]
[ [ add-cfg-edges ] each-basic-block ]
tri
swap png ;
: (cfgviz) ( cfg label filename -- )
: perform-pass ( cfg pass -- cfg' )
def>> call( cfg -- cfg' ) ;
: pass-file ( pass pass# -- path )
[ name>> ] [ number>string "-" append ] bi* prepend ;
: watch-pass ( cfg pass pass# -- cfg' )
[ drop perform-pass ] 2keep
pass-file cfgviz ;
: begin-watching-passes ( cfg -- cfg )
"0-build-cfg" cfgviz ;
: watch-passes ( cfg -- cfg' )
\ optimize-cfg def>> [ 1 + watch-pass ] each-index ;
: finish-watching-passes ( cfg -- )
\ finalize-cfg
\ optimize-cfg def>> length 1 +
watch-pass drop ;
: watch-cfg ( path cfg -- )
over make-directories
[
<digraph>
graph[ "t" =labelloc ];
node[ "box" =shape "Courier" =fontname 10 =fontsize ];
swap drop ! =label
swap
[ ?linearize ]
[ [ add-cfg-vertex ] each-basic-block ]
[ [ add-cfg-edges ] each-basic-block ]
tri
] dip png ;
: cfgviz ( cfg pass -- )
"After " prepend
step inc step get number>string
(cfgviz) ;
: (watch-cfgs) ( cfg -- )
0 step [
[
dup "build-cfg" cfgviz
dup \ optimize-cfg def>> [
[ def>> call( cfg -- cfg' ) ] keep
name>> cfgviz
] with each
finalize-cfg "finalize-cfg" cfgviz
begin-watching-passes
watch-passes
finish-watching-passes
] with-cfg
] with-variable ;
] curry with-directory ;
: watch-cfgs ( quot -- )
test-builder [ (watch-cfgs) ] each ;
: watch-cfgs ( path cfgs -- )
[
number>string "cfg" prepend append-path
swap watch-cfg
] with each-index ;
: watch-optimizer* ( path quot -- )
test-builder
dup length 1 = [ first watch-cfg ] [ watch-cfgs ] if ;
: watch-optimizer ( quot -- )
[ "" ] dip watch-optimizer* ;