[add -dgrin-graph to dump a call graph in dot format
John Meacham <john@repetae.net>**20060429022040] hunk ./FlagDump.flags 60
+grin-graph print dot file of final grin code to outputname_grin.dot
hunk ./Grin/Grin.hs 49
+    mapBodyM,
+    mapExpExp,
hunk ./Grin/Grin.hs 228
+mapBodyM f (x :-> y) = f y >>= return . (x :->)
+
+mapExpExp f (a :>>= v :-> b) = do
+    a <- f a
+    b <- f b
+    return (a :>>= v :-> b)
+mapExpExp f (Case e as) = do
+    as' <- mapM (mapBodyM f) as
+    return (Case e as')
+mapExpExp _ x = return x
+
hunk ./Grin/Optimize.hs 109
-mapBodyM f (x :-> y) = f y >>= return . (x :->)
-
-mapExpExp f (a :>>= v :-> b) = do
-    a <- f a
-    b <- f b
-    return (a :>>= v :-> b)
-mapExpExp f (Case e as) = do
-    as' <- mapM (mapBodyM f) as
-    return (Case e as')
-mapExpExp _ x = return x
hunk ./Grin/Show.hs 1
-module Grin.Show(prettyFun,prettyVal,prettyExp,printGrin,render) where
+module Grin.Show(
+    prettyFun,
+    prettyVal,
+    prettyExp,
+    printGrin,
+    graphGrin,
+    render
+    ) where
hunk ./Grin/Show.hs 13
+import Control.Monad.Writer
+import qualified Data.Map as Map
hunk ./Grin/Show.hs 28
+import Data.Graph.Inductive.Graph(mkGraph,nmap)
+import Data.Graph.Inductive.Graphviz
+import Data.Graph.Inductive.Tree
+import Support.FreeVars
hunk ./Grin/Show.hs 153
+
+
+graphGrin :: Grin -> String
+graphGrin grin = graphviz' (gr :: Gr Atom CallType) where
+    nodes = zip [0..] (grinFunctions grin)
+    nodeMap = Map.fromList [ (y,x) | (x,(y,_)) <- nodes]
+    gr = nmap fst $ mkGraph nodes [ (n,n2,tc) | (n,(_,_ :-> l)) <- nodes, (tc,fv) <- Set.toList (freeVars l), n2 <- Map.lookup fv nodeMap ]
+
+
+data CallType = TailCall | StandardCall
+    deriving(Ord,Show,Eq)
+
+instance FreeVars Exp (Set.Set (CallType,Atom)) where
+    freeVars (a :>>= _ :-> b) = freeVars b `Set.union` Set.map (\ (_ :: CallType,y) -> (StandardCall, y)) (freeVars a)
+    freeVars (App a _ _) = Set.singleton (TailCall,a)
+    freeVars e = execWriter $ mapExpExp (\e -> tell (freeVars e) >> return e) e
+
+
+
hunk ./Main.hs 683
-        wdump FD.Grin $ printGrin x
+        dumpFinalGrin x
hunk ./Main.hs 689
-        wdump FD.Grin $ printGrin x
+        dumpFinalGrin x
hunk ./Main.hs 692
+dumpFinalGrin grin = do
+    wdump FD.GrinGraph $ do
+        let dot = graphGrin grin
+            fn = optOutName options
+        writeFile (fn ++ "_grin.dot") dot
+    wdump FD.Grin $ printGrin grin
+
+