diff options
Diffstat (limited to 'ghc/utils/heap-view/HpView.lhs')
| -rw-r--r-- | ghc/utils/heap-view/HpView.lhs | 296 |
1 files changed, 0 insertions, 296 deletions
diff --git a/ghc/utils/heap-view/HpView.lhs b/ghc/utils/heap-view/HpView.lhs deleted file mode 100644 index a7b4cbb78e..0000000000 --- a/ghc/utils/heap-view/HpView.lhs +++ /dev/null @@ -1,296 +0,0 @@ -> module Main where -> import PreludeGlaST -> import LibSystem - -> import Parse - -Program to interpret a heap profile. - -Started 28/11/93: parsing of profile -Tweaked 28/11/93: parsing fiddled till it worked and graphical backend added - -To be done: - -0) think about where I want to go with this -1) further processing... sorting, filtering, ... -2) get dynamic display -3) maybe use widgets - -Here's an example heap profile - - JOB "a.out -p" - DATE "Fri Apr 17 11:43:45 1992" - SAMPLE_UNIT "seconds" - VALUE_UNIT "bytes" - BEGIN_SAMPLE 0.00 - SYSTEM 24 - END_SAMPLE 0.00 - BEGIN_SAMPLE 1.00 - elim 180 - insert 24 - intersect 12 - disin 60 - main 12 - reduce 20 - SYSTEM 12 - END_SAMPLE 1.00 - MARK 1.50 - MARK 1.75 - MARK 1.80 - BEGIN_SAMPLE 2.00 - elim 192 - insert 24 - intersect 12 - disin 84 - main 12 - SYSTEM 24 - END_SAMPLE 2.00 - BEGIN_SAMPLE 2.82 - END_SAMPLE 2.82 - -By inspection, the format seems to be: - -profile :== header { sample } -header :== job date { unit } -job :== "JOB" command -date :== "DATE" dte -unit :== "SAMPLE_UNIT" string | "VALUE_UNIT" string - -sample :== samp | mark -samp :== "BEGIN_SAMPLE" time {pairs} "END_SAMPLE" time -pairs :== identifer count -mark :== "MARK" time - -command :== string -dte :== string -time :== float -count :== integer - -But, this doesn't indicate the line structure. The simplest way to do -this is to treat each line as a single token --- for which the -following parser is useful: - -Special purpose parser that recognises a string if it matches a given -prefix and returns the remainder. - -> prefixP :: String -> P String String -> prefixP p = -> itemP `thenP` \ a -> -> let (p',a') = splitAt (length p) a -> in if p == p' -> then unitP a' -> else zeroP - - -To begin with I want to parse a profile into a list of readings for -each identifier at each time. - -> type Sample = (Float, [(String, Int)]) - -> type Line = String - - -> profile :: P Line [Sample] -> profile = -> header `thenP_` -> zeroOrMoreP sample - -> header :: P Line () -> header = -> job `thenP_` -> date `thenP_` -> zeroOrMoreP unit `thenP_` -> unitP () - -> job :: P Line String -> job = prefixP "JOB " - -> date :: P Line String -> date = prefixP "DATE " - -> unit :: P Line String -> unit = -> ( prefixP "SAMPLE_UNIT " ) -> `plusP` -> ( prefixP "VALUE_UNIT " ) - -> sample :: P Line Sample -> sample = -> samp `plusP` mark - -> mark :: P Line Sample -> mark = -> prefixP "MARK " `thenP` \ time -> -> unitP (read time, []) - -ToDo: check that @time1 == time2@ - -> samp :: P Line Sample -> samp = -> prefixP "BEGIN_SAMPLE " `thenP` \ time1 -> -> zeroOrMoreP pair `thenP` \ pairs -> -> prefixP "END_SAMPLE " `thenP` \ time2 -> -> unitP (read time1, pairs) - -> pair :: P Line (String, Int) -> pair = -> prefixP " " `thenP` \ sample_line -> -> let [identifier,count] = words sample_line -> in unitP (identifier, read count) - -This test works fine - -> {- -> test :: String -> String -> test str = ppSamples (theP profile (lines str)) - -> test1 = test example - -> test2 :: String -> Dialogue -> test2 file = -> readFile file exit -> (\ hp -> appendChan stdout (test hp) exit -> done) -> -} - -Inefficient pretty-printer (uses ++ excessively) - -> ppSamples :: [ Sample ] -> String -> ppSamples = unlines . map ppSample - -> ppSample :: Sample -> String -> ppSample (time, samps) = -> (show time) ++ unwords (map ppSamp samps) - -> ppSamp :: (String, Int) -> String -> ppSamp (identifier, count) = identifier ++ ":" ++ show count - -To get the test1 to work in gofer, you need to fiddle with the input -a bit to get over Gofer's lack of string-parsing code. - -> example = -> "JOB \"a.out -p\"\n" ++ -> "DATE \"Fri Apr 17 11:43:45 1992\"\n" ++ -> "SAMPLE_UNIT \"seconds\"\n" ++ -> "VALUE_UNIT \"bytes\"\n" ++ -> "BEGIN_SAMPLE 0.00\n" ++ -> " SYSTEM 24\n" ++ -> "END_SAMPLE 0.00\n" ++ -> "BEGIN_SAMPLE 1.00\n" ++ -> " elim 180\n" ++ -> " insert 24\n" ++ -> " intersect 12\n" ++ -> " disin 60\n" ++ -> " main 12\n" ++ -> " reduce 20\n" ++ -> " SYSTEM 12\n" ++ -> "END_SAMPLE 1.00\n" ++ -> "MARK 1.50\n" ++ -> "MARK 1.75\n" ++ -> "MARK 1.80\n" ++ -> "BEGIN_SAMPLE 2.00\n" ++ -> " elim 192\n" ++ -> " insert 24\n" ++ -> " intersect 12\n" ++ -> " disin 84\n" ++ -> " main 12\n" ++ -> " SYSTEM 24\n" ++ -> "END_SAMPLE 2.00\n" ++ -> "BEGIN_SAMPLE 2.82\n" ++ -> "END_SAMPLE 2.82" - - - - -Hack to let me test this code... Gofer doesn't have integer parsing built in. - -> {- -> read :: String -> Int -> read s = 0 -> -} - -> screen_size = 200 - -ToDo: - -1) the efficiency of finding slices can probably be dramatically - improved... if it matters. - -2) the scaling should probably depend on the slices used - -3) labelling graphs, colour, ... - -4) responding to resize events - -> main :: IO () -> main = -> getArgs >>= \ r -> -> case r of -> filename:idents -> -> readFile filename >>= \ hp -> -> let samples = theP profile (lines hp) -> -> times = [ t | (t,ss) <- samples ] -> names = [ n | (t,ss) <- samples, (n,c) <- ss ] -> counts = [ c | (t,ss) <- samples, (n,c) <- ss ] -> -> time = maximum times -> x_scale = (fromInt screen_size) / time -> -> max_count = maximum counts -> y_scale = (fromInt screen_size) / (fromInt max_count) -> -> slices = map (slice samples) idents -> in -> xInitialise [] screen_size screen_size >> -> -- drawHeap x_scale y_scale samples >> -> sequence (map (drawSlice x_scale y_scale) slices) >> -> freeze -> _ -> error "usage: hpView filename identifiers\n" - -> freeze :: IO () -> freeze = -> xHandleEvent >> -> usleep 100 >> -> freeze - - -Slice drawing stuff... shows profile for each identifier - -> slice :: [Sample] -> String -> [(Float,Int)] -> slice samples ident = -> [ (t,c) | (t,ss) <- samples, c <- [lookupPairs ss ident 0] ] - -> lookupPairs :: Eq a => [(a, b)] -> a -> b -> b -> lookupPairs ((a', b') : hs) a b = -> if a == a' then b' else lookupPairs hs a b -> lookupPairs [] a b = b - -> drawSlice :: Float -> Float -> [(Float,Int)] -> IO () -> drawSlice x_scale y_scale slc = -> drawPoly -> [ (round (x*x_scale), screen_size - (round ((fromInt y)*y_scale))) | (x,y) <- slc ] - -> drawPoly :: [(Int, Int)] -> IO () -> drawPoly ((x1,y1):(x2,y2):poly) = -> xDrawLine x1 y1 x2 y2 >> -> drawPoly ((x2,y2):poly) -> drawPoly _ = return () - - -Very simple heap profiler... doesn't do a proper job at all. Good for -testing. - -> drawHeap :: Float -> Float -> [Sample] -> IO () -> drawHeap x_scale y_scale samples = -> sequence (map xBar -> [ (t*x_scale, (fromInt c)*y_scale) -> | (t,ss) <- samples, (n,c) <- ss ]) >> -> return () - -> xBar :: (Float, Float) -> IO () -> xBar (x, y) = -> let {x' = round x; y' = round y} -> in xDrawLine x' screen_size x' (screen_size - y') - ->#include "common-bits" |