compiler.cfg.graphviz: refactoring
parent
64b541759e
commit
d6849da7ec
|
@ -1,9 +1,9 @@
|
||||||
! Copyright (C) 2011 Alex Vondrak.
|
! Copyright (C) 2011 Alex Vondrak.
|
||||||
! See http://factorcode.org/license.txt for BSD license
|
! See http://factorcode.org/license.txt for BSD license
|
||||||
|
|
||||||
USING: accessors fry io io.streams.string kernel math.parser
|
USING: accessors fry io io.directories io.pathnames
|
||||||
namespaces prettyprint sequences splitting strings
|
io.streams.string kernel math math.parser namespaces
|
||||||
tools.annotations
|
prettyprint sequences splitting strings tools.annotations
|
||||||
|
|
||||||
compiler.cfg
|
compiler.cfg
|
||||||
compiler.cfg.builder
|
compiler.cfg.builder
|
||||||
|
@ -53,37 +53,58 @@ linearize? off
|
||||||
add
|
add
|
||||||
] [ drop ] if ;
|
] [ 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
|
begin-watching-passes
|
||||||
dup \ optimize-cfg def>> [
|
watch-passes
|
||||||
[ def>> call( cfg -- cfg' ) ] keep
|
finish-watching-passes
|
||||||
name>> cfgviz
|
|
||||||
] with each
|
|
||||||
finalize-cfg "finalize-cfg" cfgviz
|
|
||||||
] with-cfg
|
] with-cfg
|
||||||
] with-variable ;
|
] curry with-directory ;
|
||||||
|
|
||||||
: watch-cfgs ( quot -- )
|
: watch-cfgs ( path cfgs -- )
|
||||||
test-builder [ (watch-cfgs) ] each ;
|
[
|
||||||
|
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* ;
|
||||||
|
|
Loading…
Reference in New Issue