visual-prof 0.1 → 0.2
raw patch · 3 files changed
+67/−57 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- LICENSE +21/−21
- Prof2Html.hs +44/−34
- visual-prof.cabal +2/−2
LICENSE view
@@ -1,27 +1,27 @@-Copyright (c) 2007, 2008 Antiope Associates LLC-+Copyright (c) 2010, Daniel Velkov <djvelkov@gmail.com>+Copyright (c) 2011, Kevin Cantu <me@kevincantu.org> All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:-1. Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.-2. 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.-3. Neither the name of the author nor the names of his contributors- may be used to endorse or promote products derived from this software- without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY ANTIOPE ASSOCIATES 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 AUTHORS 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.+ * 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.++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.
Prof2Html.hs view
@@ -12,7 +12,9 @@ import System.Process import System.Directory import System.Environment+import System.FilePath import System.IO.Error+import System.IO import Data.Maybe import GraphUtils import Data.Char@@ -28,20 +30,20 @@ ++ P.prettyPrint 120 tm ++ "</pre>" assignSCC :: Module -> Module-assignSCC m = evalState (transformBiM f m) 0 where- f e = do st <- get- put (st + 1)- return $ addSCC st $ strip e-- strip :: Exp_ -> Exp_- strip (SCCPragma _ e) = e- strip e = e-- addSCC :: Int -> Exp_ -> Exp_- addSCC _ e@(Var _) = e- addSCC _ e@(Lit _) = e- addSCC num e = Paren $ SCCPragma (show num) e+assignSCC m = evalState (transformBiM f m) 0+ where f e+ = do st <- get+ put (st + 1)+ return $ addSCC st $ strip e + strip :: Exp_ -> Exp_+ strip (SCCPragma _ e) = e+ strip e = e+ + addSCC :: Int -> Exp_ -> Exp_+ addSCC _ e@(Var _) = e+ addSCC _ e@(Lit _) = e+ addSCC num e = Paren $ SCCPragma (show num) e addColour m s = gsubRegexPRBy (pref ++ ".*?" ++ suf) (\ str -> pref ++ sccNumToColour str ++ suf)@@ -69,7 +71,7 @@ ++ "00" where pad :: String -> String- pad str = if length str == 1 then '0':str else str+ pad str = if length str == 1 then '0' : str else str yellow = 0.1 parseModuleFromFile :: FilePath -> IO Module@@ -105,44 +107,52 @@ trd3 :: (Integer, Integer, Integer) -> Integer trd3 (_, _, x) = x ind l n = if length l > n then Just $ l !! n else Nothing+outputHTML file profName tm+ = do putStrLn "parsing profiling results"+ profFile <- readFile $ profName+ let prof = fromJust $ parseProfile profName profFile+ when (profileTicks prof == 0)+ (error "the program has to run longer to get enough information")+ let profMap = computeTicksMap prof+ putStrLn "printing output html file"+ let html = addColour profMap $ pprint tm+ writeFile (file ++ ".html") html main :: IO () main = do args <- getArgs let mode = args !! 0- unless ("-h" `isPrefixOf` mode || "-px" `isPrefixOf` mode)- (error "mode should be -h or -px") let file = args !! 1 let run = args !! 2+ unless ("-h" `isPrefixOf` mode || "-px" `isPrefixOf` mode)+ (error "mode should be -h or -px") let programArgs = ind args 3 let inpFile = ind args 4 let bak = file ++ ".bak"+ let profName = (takeBaseName run) ++ ".prof" (do removeFile bak `catch`- (\ e -> if isDoesNotExistError e then return () else ioError e)+ (\ e -> unless (isDoesNotExistError e) $ ioError e) renameFile file bak putStrLn "started parsing original file" m <- parseModuleFromFile bak let tm = assignSCC m putStrLn "writing modified file" writeFile file $ PP.prettyPrint tm- let buildStr- = "ghc -prof -O2 --make " ++- run ++ ".hs && ./" ++ run ++ " +RTS " ++ mode ++ " -RTS"- let buildStrArgs- = buildStr ++ " " ++ fromMaybe "" programArgs ++ " "- let buildStrInp- = maybe buildStrArgs ((buildStrArgs ++ " < ") ++) inpFile- putStrLn buildStrInp- buildCommand <- runCommand buildStrInp++ let buildStr = "ghc -prof -rtsopts -O2 --make " ++ run ++ ".hs"+ putStrLn buildStr+ buildCommand <- runCommand buildStr waitForProcess buildCommand- (when ("-px" `isPrefixOf` mode) $- do putStrLn "parsing profiling results"- profFile <- readFile $ run ++ ".prof"- let prof = fromJust $ parseProfile (run ++ ".prof") profFile- let profMap = computeTicksMap prof- putStrLn "printing output html file"- let html = addColour profMap $ pprint tm- writeFile (file ++ ".html") html)++ let runRTS = ["+RTS", mode, "-RTS"]+ let runArgs = runRTS ++ maybe [] words programArgs+ inp <- maybe (return Inherit)+ (\file -> UseHandle <$> openFile file ReadMode) inpFile+ putStrLn $ run ++ " " ++ unwords runArgs+ (_,_,_,runCommand) <- createProcess (proc ("./" ++ run) runArgs){std_in = inp}+ waitForProcess runCommand++ (when ("-px" `isPrefixOf` mode) (outputHTML file profName tm)) renameFile file (file ++ ".scc")) `Exc.finally` (do copyFile bak file
visual-prof.cabal view
@@ -1,5 +1,5 @@ Name: visual-prof-Version: 0.1+Version: 0.2 Cabal-Version: >= 1.2 License: BSD3 License-file: LICENSE@@ -29,7 +29,7 @@ Executable visual-prof if flag(splitBase)- Build-Depends: base >= 3 && < 4, containers+ Build-Depends: base >= 3 && < 5, containers else Build-Depends: base < 3 Build-depends: parsec, filepath, haskell-src-exts, regexpr, directory, process, pretty, mtl, uniplate