From d6849da7ec8ce00c56a959d0a695f599fa58a042 Mon Sep 17 00:00:00 2001
From: Alex Vondrak <ajvondrak@csupomona.edu>
Date: Fri, 3 Jun 2011 18:11:08 -0700
Subject: [PATCH] compiler.cfg.graphviz: refactoring

---
 basis/compiler/cfg/graphviz/graphviz.factor | 85 +++++++++++++--------
 1 file changed, 53 insertions(+), 32 deletions(-)

diff --git a/basis/compiler/cfg/graphviz/graphviz.factor b/basis/compiler/cfg/graphviz/graphviz.factor
index 4228a2a70c..2515c5585d 100644
--- a/basis/compiler/cfg/graphviz/graphviz.factor
+++ b/basis/compiler/cfg/graphviz/graphviz.factor
@@ -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* ;