Permalink
Browse files

Initial commit

  • Loading branch information...
0 parents commit 06c4327e1235e68a2497aec79cb8eac48d97d303 @batterseapower committed Jul 21, 2010
Showing with 131 additions and 0 deletions.
  1. +9 −0 .gitignore
  2. +30 −0 LICENSE
  3. +57 −0 Main.hs
  4. +13 −0 README.md
  5. +22 −0 haskell-call-graph.cabal
9 .gitignore
@@ -0,0 +1,9 @@
+# OS junk
+Thumbs.db
+.DS_Store
+
+# Haskell junk
+dist/
+*.hi
+*.o
+
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright Max Bolingbroke 2010.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Neil Mitchell nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
57 Main.hs
@@ -0,0 +1,57 @@
+module Main (main) where
+
+import Control.Monad
+
+import Language.Dot
+import Language.Haskell.Exts
+
+import System.Environment
+import System.Exit
+import System.FilePath
+import System.IO
+import System.Process
+
+import Data.Generics.Uniplate.Data
+
+
+main :: IO ()
+main = do
+ files <- getArgs
+ forM_ files $ \file -> do
+ ParseOk r <- parseFile file
+ let dot = uncurry renderGraph $ extractGraph r
+ putStrLn dot
+ (ec, out, err) <- readProcessWithExitCode "dot" ["-Tpng", "-o" ++ replaceExtension file ".png"] dot
+ hPutStr stdout out
+ hPutStr stderr err
+ exitWith ec
+
+extractGraph :: Module -> (Name, [(Name, [Name])])
+extractGraph (Module _loc _name _prags _mb_warn _mb_exports _imports decls)
+ = head [(head (calls root_e), extractGraphFromDecls bound_decls)
+ | PatBind _loc (PVar (Ident "root")) _mb_type (UnGuardedRhs (Let (BDecls bound_decls) root_e)) _binds <- decls]
+
+extractGraphFromDecls :: [Decl] -> [(Name, [Name])]
+extractGraphFromDecls decls = all_names `zip` map (filter (`elem` all_names)) all_callss
+ where
+ (all_names, all_callss) = unzip [(name, calls e) | PatBind _loc (PVar name) _mb_type e _binds <- decls]
+
+--calls :: Exp -> [Name]
+calls e = [name | Var (UnQual name) <- universeBi e]
+
+renderGraph :: Name -> [(Name, [Name])] -> String
+renderGraph root_name edges = renderDot graph
+ where
+ n2id :: Name -> Id
+ n2id (Ident x) = StringId x
+
+ n2nid :: Name -> NodeId
+ n2nid = flip NodeId Nothing . n2id
+
+ graph = Graph UnstrictGraph DirectedGraph (Just (n2id root_name)) $
+ [ stmt
+ | (name, other_names) <- edges
+ , stmt <- NodeStatement (n2nid name) [] :
+ [ EdgeStatement [ENodeId NoEdge (n2nid name),
+ ENodeId DirectedEdge (n2nid other_name)] []
+ | other_name <- other_names]]
13 README.md
@@ -0,0 +1,13 @@
+h1. Haskell call graph builder
+
+Currently this is very hacked up and only designed to be run on the output of the Cambridge Haskell Supercompiler. It is very
+useful for visualising the structure of the recursion in the output programs -- in particular, it can find where the inner loops are.
+
+
+h2. Usage
+
+Simply run with the name of the Haskell source file(s) to analyse:
+
+ haskell-call-graph Foo.hs Bar.hs
+
+The output will be saved in `Foo.png` and `Bar.png` respectively.
22 haskell-call-graph.cabal
@@ -0,0 +1,22 @@
+Cabal-Version: >= 1.2
+Build-Type: Simple
+Name: haskell-call-graph
+Version: 0.1
+Maintainer: Max Bolingbroke <batterseapower@hotmail.com>
+Homepage: http://www.github.com/batterseapower/haskell-call-graph
+License: BSD3
+License-File: LICENSE
+Author: Max Bolingbroke
+Synopsis: Simple call graph tool for Haskell
+Category: Language
+
+Executable haskell-call-graph
+ Main-Is: Main.hs
+ Build-Depends: base >= 4 && < 5,
+ process >= 1.0.1.2 && < 1.1,
+ filepath >= 1.1.0.3 && < 1.2,
+ haskell-src-exts >= 1.9 && < 1.10,
+ uniplate >= 1.5.1 && < 1.6,
+ language-dot >= 0.0.5 && < 0.13
+
+ Ghc-Options: -fwarn-unused-binds -fwarn-unused-imports -fwarn-unused-matches -fwarn-incomplete-patterns

0 comments on commit 06c4327

Please sign in to comment.