update simplifyprof.hs

tools/simplifyprof.hs

@@ -1,14 +1,33 @@
 #!/usr/bin/env runhaskell
--- filters uninteresting fields from profile data lines
+-- simplifyprof.hs somefile.prof
--- Simon Michael 2007
+-- filter uninteresting fields from GHC profile output
+-- tested with GHC 6.8
+-- Simon Michael 2007,2008
+
 import Data.List
-main = interact $ unlines . map print . filter (/=[]) . 
+import System.Environment
-       (["cost-centre - - entries %time %mem %t-inh %m-inh"]++) . tail . 
+import Text.Printf
-       dropWhile (notElem "entries" . words) . lines
+
+main = do
+  args <- getArgs 
+  let f = head args
+  s <- readFile f
+  let ls = lines s
+  let (firstpart, secondpart) = break ("individual    inherited" `isInfixOf`) ls
+  putStr $ unlines firstpart
+  let fields = map getfields $ filter (not . null) $ drop 2 $ secondpart
+  let maxnamelen = maximum $ map (length . head) fields
+  let fmt = "%-"++(show maxnamelen)++"s %10s %5s %6s %9s %10s"
+  putStrLn $ showheading fmt
+  putStr $ unlines $ map (format fmt) fields
+
+getfields s = name:rest
     where
-      print line = tabcat [paddedfirst, field 3, field 4, field 5, field 6, field 7]
+      space = takeWhile (==' ') s
-          where
+      fields = words s
-            tabcat = concat . intersperse "\t"
+      name = space ++ head fields
-            first = takeWhile (==' ') line ++ (takeWhile (/=' ') $ dropWhile (==' ') line)
+      rest = drop 3 fields
-            paddedfirst = first ++ (take (60 - (length first)) $ repeat ' ')
+
-            field n = words line !! n
+showheading fmt = format fmt ["cost centre","entries","%time","%alloc","%time-inh","%alloc-inh"]
+
+format fmt (s1:s2:s3:s4:s5:s6:[]) = printf fmt s1 s2 s3 s4 s5 s6