> module Main where
> import PreludeGlaST
> import LibSystem

> import Parse

Program to do continuous heap profile.

Bad News: 

    The ghc runtime system writes its heap profile information to a
    named file (<progname>.hp).  The program merrily reads its input
    from a named file but has no way of synchronising with the program
    generating the file.

Good News 0:

    You can save the heap profile to a file:

	    <progname> <parameters> +RTS -h -i0.1 -RTS

    and then run:

	    hpView2 <progname>.hp Main:<functionname>

    This is very like using hp2ps but much more exciting because you
    never know what's going to happen next :-)


Good News 1:

    The prophet Stallman has blessed us with the shell command @mkfifo@
    (is there a standard Unix version?) which creates a named pipe.  If we
    instead run:

	    mkfifo <progname>.hp
	    hpView2 <progname>.hp Main:<functionname> &
	    <progname> <parameters> +RTS -h -i0.1 -RTS
	    rm <progname>.hp

    Good Things happen.

    NB If you don't delete the pipe, Bad Things happen: the program
    writes profiling info to the pipe until the pipe fills up then it
    blocks...


Right, on with the program:

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

In HpView.lhs, I had a fancy parser to handle all this - but it was
immensely inefficient.  We can produce something a lot more efficient
and robust very easily by noting that the only lines we care about
have precisely two entries on them.

> type Line = String
> type Word = String
> type Sample = (Float, [(String, Int)])

> parseProfile :: [[Word]] -> [Sample]
> parseProfile [] = []
> parseProfile ([keyword, time]:lines) | keyword == "BEGIN_SAMPLE" =
>	let (sample,rest) = parseSample lines
>	in
>	(read time, sample) : parseProfile rest
> parseProfile (_:xs) = parseProfile xs

> parseSample :: [[Word]] -> ([(String,Int)],[[Word]])
> parseSample ([word, count]:lines) =
>	if word == "END_SAMPLE" 
>	then ([], lines)
>	else let (samples, rest) = parseSample lines
>	     in ( (word, read count):samples,  rest )
> parseSample duff_lines = ([],duff_lines)

> screen_size = 200

> main :: IO ()
> main =
>	getArgs					>>= \ r ->
>	case r of 
>	  [filename, ident] -> 
>		xInitialise [] screen_size screen_size	>>
>		readFile filename			>>= \ hp ->
>		let samples = parseProfile (map words (lines hp))
>		    totals = [ sum [ s | (_,s) <- ss ] | (t,ss) <- samples ]
>
>		    ts = map scale totals
>		    is = map scale (slice samples ident)
>  		in
>		graphloop2 (is, []) (ts, [])
>	  _ -> error "usage: hpView2 file identifier\n"

For the example I'm running this on, the following scale does nicely.

> scale :: Int -> Float
> scale n = (fromInt n) / 10000.0

Slice drawing stuff... shows profile for each identifier (Ignores time
info in this version...)

> slice :: [Sample] -> String -> [Int]
> slice samples ident =
>	[ 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

Number of samples to display on screen

> n :: Int
> n = 40

Graph-drawing loop.  Get's the data for the particular identifier and
the total usage, scales to get total to fit screen and draws them.

> graphloop2 :: ([Float], [Float]) -> ([Float], [Float]) -> IO ()
> graphloop2 (i:is,is') (t:ts, ts') =
>	let is'' = take n (i:is')
>	    ts'' = take n (t:ts')
>
>	    -- scaling information:
>	    m = maximum ts''
>	    y_scale = (floor m) + 1
>	    y_scale' = fromInt y_scale
>	in
>	xCls						>>
> 	drawScales y_scale				>>
>	draw x_coords [ x / y_scale' | x <- is'' ]	>>
>	draw x_coords [ x / y_scale' | x <- ts'' ]	>>
>	xHandleEvent					>>
>	graphloop2 (is,is'') (ts, ts'')
> graphloop2 _ _ =
>	return ()

> x_coords :: [Float]
> x_coords = [ 0.0, 1 / (fromInt n) .. ]

Note: unpleasant as it is, the code cannot be simplified to something
like the following (which has scope for changing draw to take a list
of pairs).  The problem is that the graph won't start to be drawn
until the first @n@ values are available. (Is there also a danger of
clearing the screen while waiting for the next input value?)  A
possible alternative solution is to keep count of how many values have
actually been received.

< graphloop2 :: [Float] -> [Float] -> IO ()
< graphloop2 [] =
<	return ()
< graphloop2 ys =
<	let ys' = take n ys
<	    m = maximum ys'
<	    y_scale = (floor m) + 1
<	    y_scale' = fromInt y_scale
<	in
<	xCls						>>
< 	drawScales y_scale				>>
<	draw x_coords [ x / y_scale' | x <- ys' ]	>>
<	xHandleEvent					>>
<	graphloop2 (tail ys)

Draw lines specified by coordinates in range (0.0 .. 1.0) onto screen.

> draw :: [Float] -> [Float] -> IO ()
> draw xs ys = drawPoly (zip xs' (reverse ys'))
>  where
>   xs' = [ floor (x * sz) | x <- xs ]
>   ys' = [ floor ((1.0 - y) * sz) | y <- ys ]
>   sz = fromInt screen_size

> drawPoly :: [(Int, Int)] -> IO ()
> drawPoly ((x1,y1):(x2,y2):poly) =
>	xDrawLine x1 y1 x2 y2		>>
>	drawPoly ((x2,y2):poly)
> drawPoly _ = return ()

Draw horizontal line at major points on y-axis.

> drawScales :: Int -> IO ()
> drawScales y_scale =
>	sequence (map drawScale ys)	>>
>	return ()
>  where
>   ys = [ (fromInt i) / (fromInt y_scale) | i <- [1 .. y_scale - 1] ]

> drawScale :: Float -> IO ()
> drawScale y =
>	let y' = floor ((1.0 - y) * (fromInt screen_size))
>	in
>	xDrawLine 0 y' screen_size y'

>#include "common-bits"