Add another example program.

examples/CallGraph0.hs

@@ -0,0 +1,53 @@
+module Main where
+
+import WriteDotGraph
+
+import GHC
+import Scion
+import Scion.Inspect
+import Bag ( bagToList )
+import Outputable
+--import TcRnTypes
+import HscTypes
+import SrcLoc
+
+import GHC.Uniplate.Instances
+
+import Control.Monad
+import System.Exit
+
+main = runScion $ do
+  setWorkingDir "../ghc/compiler" -- "../mtl-1.1.0.2" --"../ghc/compiler"
+  openCabalProject "./dist-stage2" --"dist" --"./dist-stage2"
+  setDynFlagsFromCabal Library
+  setTargetsFromCabal Library
+  addCmdLineFlags ["-DSTAGE=2"]
+  handleSourceError print_error_and_exit $ do
+    mss <- modulesInDepOrder
+    io $ print (length mss)
+    deps <- forM mss $ \ms -> do
+      --mod <- loadModule =<< typecheckModule =<< parseModule ms
+      --clearWarnings
+      return ( moduleNameString (ms_mod_name ms) 
+                 ++ hscSourceString (ms_hsc_src ms),
+               map (moduleNameString . unLoc) (ms_srcimps ms)
+                ++ map (moduleNameString . unLoc) (ms_imps ms) )
+    io $ writeFile "deps.dot" $ 
+       writeDotGraph [ (mod, imp) | (mod, imps) <- deps
+                                  , imp <- imps ]
+
+{-
+      let binds = bagToList (typecheckedSource mod)
+      let Just rn@(grp, _, _, _, _) = renamedSource mod
+      io $ putStrLn $ moduleNameString (ms_mod_name ms)
+--       io $ putStrLn $ showSDoc $ nest 4 $ ppr $ typeDecls mod
+--       io $ putStrLn $ showSDoc $ nest 4 $ ppr $ classDecls rn
+      pp $ ppr $ tcg_dus (fst (tm_internals mod))
+      return ()
+-}
+print_error_and_exit err = do
+  printExceptionAndWarnings err
+  io $ exitWith (ExitFailure 1)
+
+pp :: SDoc -> ScionM ()
+pp = io . putStrLn . showSDoc

examples/WriteDotGraph.hs

@@ -0,0 +1,27 @@
+
+module WriteDotGraph (writeDotGraph) where
+
+import Data.List (nub)
+
+writeDotGraph :: (Show node, Eq node) => [(node, node)] -> String
+writeDotGraph edges = 
+  unlines (
+      [header
+      ,graphDefaultAtribs
+      ,nodeDefaultAtribs
+      ,edgeDefaultAtribs]
+    ++ map makeNode nodes
+    ++ map makeEdge edges
+    ++ [footer]
+  )
+  where nodes = nub $ concat [ [a,b] | (a,b) <- edges ]
+        makeNode name = "\t" ++ show (show name) ++ " [];"
+        makeEdge (node1, node2) = 
+            "\t" ++ show (show node1) ++ " -> " ++ show (show node2) ++ "[];"
+
+header = "digraph g {"
+footer = "}"
+
+graphDefaultAtribs = "\tgraph [fontsize=14, fontcolor=black, color=black];" 
+nodeDefaultAtribs  = "\tnode [label=\"\\N\", width=\"0.75\", shape=ellipse];"
+edgeDefaultAtribs  = "\tedge [fontsize=10];"

scion.cabal

@@ -39,4 +39,12 @@ executable test_get_imports
   build-depends: ghc-paths >= 0.1 && < 0.2,
                  ghc >= 6.10 && < 6.12,
                  ghc-syb >= 0.1 && < 0.2
-  other-modules: Scion
+  other-modules: Scion
+
+executable test_call_graph
+  main-is:       CallGraph0.hs
+  hs-source-dirs: examples
+                  src
+  build-depends: ghc >= 6.10 && < 6.12,
+                 ghc-uniplate == 0.1.*
+  other-modules: Scion