7 Program to interpret a heap profile.
9 Started 28/11/93: parsing of profile
10 Tweaked 28/11/93: parsing fiddled till it worked and graphical backend added
14 0) think about where I want to go with this
15 1) further processing... sorting, filtering, ...
16 2) get dynamic display
19 Here's an example heap profile
22 DATE "Fri Apr 17 11:43:45 1992"
51 By inspection, the format seems to be:
53 profile :== header { sample }
54 header :== job date { unit }
57 unit :== "SAMPLE_UNIT" string | "VALUE_UNIT" string
59 sample :== samp | mark
60 samp :== "BEGIN_SAMPLE" time {pairs} "END_SAMPLE" time
61 pairs :== identifer count
69 But, this doesn't indicate the line structure. The simplest way to do
70 this is to treat each line as a single token --- for which the
71 following parser is useful:
73 Special purpose parser that recognises a string if it matches a given
74 prefix and returns the remainder.
76 > prefixP :: String -> P String String
78 > itemP `thenP` \ a ->
79 > let (p',a') = splitAt (length p) a
85 To begin with I want to parse a profile into a list of readings for
86 each identifier at each time.
88 > type Sample = (Float, [(String, Int)])
93 > profile :: P Line [Sample]
102 > zeroOrMoreP unit `thenP_`
105 > job :: P Line String
106 > job = prefixP "JOB "
108 > date :: P Line String
109 > date = prefixP "DATE "
111 > unit :: P Line String
113 > ( prefixP "SAMPLE_UNIT " )
115 > ( prefixP "VALUE_UNIT " )
117 > sample :: P Line Sample
121 > mark :: P Line Sample
123 > prefixP "MARK " `thenP` \ time ->
124 > unitP (read time, [])
126 ToDo: check that @time1 == time2@
128 > samp :: P Line Sample
130 > prefixP "BEGIN_SAMPLE " `thenP` \ time1 ->
131 > zeroOrMoreP pair `thenP` \ pairs ->
132 > prefixP "END_SAMPLE " `thenP` \ time2 ->
133 > unitP (read time1, pairs)
135 > pair :: P Line (String, Int)
137 > prefixP " " `thenP` \ sample_line ->
138 > let [identifier,count] = words sample_line
139 > in unitP (identifier, read count)
144 > test :: String -> String
145 > test str = ppSamples (theP profile (lines str))
147 > test1 = test example
149 > test2 :: String -> Dialogue
152 > (\ hp -> appendChan stdout (test hp) exit
156 Inefficient pretty-printer (uses ++ excessively)
158 > ppSamples :: [ Sample ] -> String
159 > ppSamples = unlines . map ppSample
161 > ppSample :: Sample -> String
162 > ppSample (time, samps) =
163 > (show time) ++ unwords (map ppSamp samps)
165 > ppSamp :: (String, Int) -> String
166 > ppSamp (identifier, count) = identifier ++ ":" ++ show count
168 To get the test1 to work in gofer, you need to fiddle with the input
169 a bit to get over Gofer's lack of string-parsing code.
172 > "JOB \"a.out -p\"\n" ++
173 > "DATE \"Fri Apr 17 11:43:45 1992\"\n" ++
174 > "SAMPLE_UNIT \"seconds\"\n" ++
175 > "VALUE_UNIT \"bytes\"\n" ++
176 > "BEGIN_SAMPLE 0.00\n" ++
178 > "END_SAMPLE 0.00\n" ++
179 > "BEGIN_SAMPLE 1.00\n" ++
182 > " intersect 12\n" ++
187 > "END_SAMPLE 1.00\n" ++
191 > "BEGIN_SAMPLE 2.00\n" ++
194 > " intersect 12\n" ++
198 > "END_SAMPLE 2.00\n" ++
199 > "BEGIN_SAMPLE 2.82\n" ++
205 Hack to let me test this code... Gofer doesn't have integer parsing built in.
208 > read :: String -> Int
216 1) the efficiency of finding slices can probably be dramatically
217 improved... if it matters.
219 2) the scaling should probably depend on the slices used
221 3) labelling graphs, colour, ...
223 4) responding to resize events
230 > readFile filename >>= \ hp ->
231 > let samples = theP profile (lines hp)
233 > times = [ t | (t,ss) <- samples ]
234 > names = [ n | (t,ss) <- samples, (n,c) <- ss ]
235 > counts = [ c | (t,ss) <- samples, (n,c) <- ss ]
237 > time = maximum times
238 > x_scale = (fromInt screen_size) / time
240 > max_count = maximum counts
241 > y_scale = (fromInt screen_size) / (fromInt max_count)
243 > slices = map (slice samples) idents
245 > xInitialise [] screen_size screen_size >>
246 > -- drawHeap x_scale y_scale samples >>
247 > sequence (map (drawSlice x_scale y_scale) slices) >>
249 > _ -> error "usage: hpView filename identifiers\n"
258 Slice drawing stuff... shows profile for each identifier
260 > slice :: [Sample] -> String -> [(Float,Int)]
261 > slice samples ident =
262 > [ (t,c) | (t,ss) <- samples, c <- [lookupPairs ss ident 0] ]
264 > lookupPairs :: Eq a => [(a, b)] -> a -> b -> b
265 > lookupPairs ((a', b') : hs) a b =
266 > if a == a' then b' else lookupPairs hs a b
267 > lookupPairs [] a b = b
269 > drawSlice :: Float -> Float -> [(Float,Int)] -> IO ()
270 > drawSlice x_scale y_scale slc =
272 > [ (round (x*x_scale), screen_size - (round ((fromInt y)*y_scale))) | (x,y) <- slc ]
274 > drawPoly :: [(Int, Int)] -> IO ()
275 > drawPoly ((x1,y1):(x2,y2):poly) =
276 > xDrawLine x1 y1 x2 y2 >>
277 > drawPoly ((x2,y2):poly)
278 > drawPoly _ = return ()
281 Very simple heap profiler... doesn't do a proper job at all. Good for
284 > drawHeap :: Float -> Float -> [Sample] -> IO ()
285 > drawHeap x_scale y_scale samples =
287 > [ (t*x_scale, (fromInt c)*y_scale)
288 > | (t,ss) <- samples, (n,c) <- ss ]) >>
291 > xBar :: (Float, Float) -> IO ()
293 > let {x' = round x; y' = round y}
294 > in xDrawLine x' screen_size x' (screen_size - y')
296 >#include "common-bits"