--- /dev/null
+> 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"
projects / ghc-hetmet.git / blobdiff