utils: delete obsolete heap-view program

Signed-off-by: Austin Seipp <austin@well-typed.com>

10 files changed, 0 insertions, 1318 deletions

diff --git a/utils/heap-view/Graph.lhs b/utils/heap-view/Graph.lhs
deleted file mode 100644
index b8e08dbb9b..0000000000
--- a/utils/heap-view/Graph.lhs
+++ /dev/null
@@ -1,165 +0,0 @@
-Started 29/11/93: 
-
-> module Main where
-> import PreludeGlaST
-> import LibSystem
-
-Program to draw a graph of last @n@ pieces of data from standard input
-continuously.
-
-> n :: Int
-> n = 40
-
-> max_sample :: Int
-> max_sample = 100
-
-> screen_size :: Int
-> screen_size = 200
-
-Version of grapher that can handle the output of ghc's @+RTS -Sstderr@
-option.  
-
-Nice variant would be to take a list of numbers from the commandline
-and display several graphs at once.
-
-> main :: IO ()
-> main =
->	getArgs				>>= \ r ->
->	case r of 
->	  [select] -> 
->		let selection = read select
->		in
->		xInitialise [] screen_size screen_size	>>
-> 		hGetContents stdin			>>= \ input ->
->  		graphloop2 (parseGCData selection input) [] 
->	  _ -> 
->		error "usage: graph <number in range 0..17>\n"
-
-The format of glhc18's stderr stuff is:
-
--- start of example (view in 120 column window)
-graph +RTS -Sstderr -H500 
-
-Collector: APPEL  HeapSize: 500 (bytes)
-
-  Alloc  Collect   Live   Resid   GC    GC     TOT     TOT  Page Flts   No of Roots  Caf  Mut-  Old  Collec  Resid
-  bytes   bytes    bytes   ency  user  elap    user    elap   GC  MUT  Astk Bstk Reg  No  able  Gen   tion   %heap
-     248     248      60  24.2%  0.00  0.04    0.05    0.23    1    1     1    0   0   1     0    0   Minor
--- end of example
-     0       1      2       3      4    5      6       7       8    9    10   11  12  13    14   15      16     17
-
-That is: 6 header lines followed by 17-18 columns of integers,
-percentages, floats and text.
-
-The scaling in the following is largely based on guesses about likely
-values - needs tuned.  
-
-@gcParsers@ is a list of functions which parse the corresponding
-column and attempts to scale the numbers into the range $0.0 .. 1.0$.
-(But may return a number avove $1.0$ which graphing part will scale to
-fit screen...)
-
-(Obvious optimisation - replace by list of scaling information!)
-
-(Obvious improvement - return (x,y) pair based on elapsed (or user) time.)
-
-> gcParsers :: [ String -> Float ]
-> gcParsers = [ heap, heap, heap, percent, time, time, time, time, flts, flts, stk, stk, reg, caf, caf, heap, text, percent ]
->  where
->   heap = scale 100000.0 . fromInt . check 0 . readDec
->   stk  = scale  25000.0 . fromInt . check 0 . readDec
->   int  = scale   1000.0 . fromInt . check 0 . readDec
->   reg = scale   10.0 . fromInt . check 0 . readDec
->   caf = scale  100.0 . fromInt . check 0 . readDec
->   flts = scale  100.0 . fromInt . check 0 . readDec
->   percent = scale 100.0 . check 0.0 . readFloat
->   time   = scale  20.0 . check 0.0 . readFloat
->   text s = 0.0
-
-> check :: a -> [(a,String)] -> a
-> check error_value parses = 
->	case parses of
->	  [] 		-> error_value
->	  ((a,s):_) 	-> a
-
-> scale :: Float -> Float -> Float
-> scale max n = n / max
-
-> parseGCData :: Int -> String -> [Float]
-> parseGCData column input = 
->	map ((gcParsers !! column) . (!! column) . words) (drop 6 (lines input))
-
-Hmmm, how to add logarithmic scaling neatly?  Do I still need to?
-
-Note: unpleasant as it is, the code cannot be simplified to something
-like the following.  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)
-
-
-> graphloop2 :: [Float] -> [Float] -> IO ()
-> graphloop2 (y:ys) xs =
->	let xs' = take n (y:xs)
->	    m = maximum xs'
->	    y_scale = (floor m) + 1
->	    y_scale' = fromInt y_scale
->	in
->	xCls						>>
-> 	drawScales y_scale				>>
->	draw x_coords [ x / y_scale' | x <- xs' ]	>>
->	xHandleEvent					>>
->	graphloop2 ys xs'
-> graphloop2 [] xs =
->	return ()
-
-> x_coords :: [Float]
-> x_coords = [ 0.0, 1 / (fromInt n) .. ]
-
-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"
diff --git a/utils/heap-view/HaskXLib.c b/utils/heap-view/HaskXLib.c
deleted file mode 100644
index b6cf1f137c..0000000000
--- a/utils/heap-view/HaskXLib.c
+++ /dev/null
@@ -1,297 +0,0 @@
-/*----------------------------------------------------------------------*
- *  X from Haskell (PicoX)
- *
- * (c) 1993 Andy Gill
- *
- *----------------------------------------------------------------------*/
-
-#include <X11/Xlib.h>
-#include <X11/Xutil.h>
-#include <X11/Xatom.h>
-#include <stdio.h>
-#include <strings.h>
-
-/*----------------------------------------------------------------------*/
-
-/* First the X Globals */
-
-Display *MyDisplay;
-int	 MyScreen;
-Window   MyWindow;
-XEvent   MyWinEvent;
-GC       DrawGC;
-GC       UnDrawGC;
-
-/* and the Haskell globals */
-
-typedef struct {
-  int HaskButtons[5];
-  int HaskPointerX,HaskPointerY;
-  int PointMoved;
-} HaskGlobType;
-
-HaskGlobType HaskGlob;
-
-/*----------------------------------------------------------------------*/
-
-/*
- * Now the access functions into the haskell globals
- */
-
-int haskGetButtons(int n)
-{
-  return(HaskGlob.HaskButtons[n]);
-}
-
-int haskGetPointerX(void)
-{
-  return(HaskGlob.HaskPointerX);
-}
-
-int haskGetPointerY(void)
-{
-  return(HaskGlob.HaskPointerY);
-}
-
-/*----------------------------------------------------------------------*/
-
-/*
- *The (rather messy) initiualisation
- */
-
-haskXBegin(int x,int y,int sty)
-{
- /*
-  *  later include these via interface hacks
-  */
-
- /* (int argc, char **argv) */
-  int argc = 0;
-  char **argv = 0;
-
-  XSizeHints XHints;
-  int MyWinFG, MyWinBG,tmp;
- 
-  if ((MyDisplay = XOpenDisplay("")) == NULL) {
-      fprintf(stderr, "Cannot connect to X server '%s'\n", XDisplayName(""));
-      exit(1);
-  }
-
-  MyScreen = DefaultScreen(MyDisplay);
-
-  MyWinBG = WhitePixel(MyDisplay, MyScreen);
-  MyWinFG = BlackPixel(MyDisplay, MyScreen);
- 
-  XHints.x      = x;
-  XHints.y      = y;
-  XHints.width  = x;
-  XHints.height = y;
-  XHints.flags  = PPosition | PSize;
- 
-  MyWindow =
-      XCreateSimpleWindow(
-			  MyDisplay,
-			  DefaultRootWindow(MyDisplay),
-			  x,y, x, y,
-			  5,
-			  MyWinFG,
-			  MyWinBG
-			  );
- 
-  XSetStandardProperties(
-			 MyDisplay,
-			 MyWindow,
-			 "XLib for Glasgow Haskell",
-			 "XLib for Glasgow Haskell",
-			 None,
-			 argv,
-			 argc,
-			 &XHints
-			 );
- 
-  /* Create drawing and erasing GC */
- 
-  DrawGC = XCreateGC(MyDisplay,MyWindow,0, 0);
-  XSetBackground(MyDisplay,DrawGC,MyWinBG);
-  XSetForeground(MyDisplay,DrawGC,MyWinFG);
-
-  UnDrawGC = XCreateGC(MyDisplay,MyWindow,0, 0);
-  XSetBackground(MyDisplay,UnDrawGC,MyWinFG);
-  XSetForeground(MyDisplay,UnDrawGC,MyWinBG);
-
-  XSetGraphicsExposures(MyDisplay,DrawGC,False);
-  XSetGraphicsExposures(MyDisplay,UnDrawGC,False);
-  XMapRaised(MyDisplay,MyWindow);
- 
-  /* the user should be able to choose which are tested for
-   */
-
-  XSelectInput(
-	       MyDisplay,
-	       MyWindow,
-	           ButtonPressMask | ButtonReleaseMask | PointerMotionMask 
-	       );
-
-  /*  later have more drawing styles
-   */
-
-  switch (sty)
-    {
-    case 0:   
-      /* Andy, this used to be GXor not much use for Undrawing so I
-         changed it. (Not much use for colour either - see next
-         comment */
-      XSetFunction(MyDisplay,DrawGC,GXcopy);
-      XSetFunction(MyDisplay,UnDrawGC,GXcopy);
-      break;
-    case 1:   
-      /* Andy, this can have totally bogus results on a colour screen */
-      XSetFunction(MyDisplay,DrawGC,GXxor);
-      XSetFunction(MyDisplay,UnDrawGC,GXxor);
-      break;
-    default:
-      /* Andy, is this really a good error message? */
-      printf(stderr,"Wrong Argument to XSet function\n");
-    }
- /*
-  *  reset the (Haskell) globals
-  */
-
- for(tmp=0;tmp<5;tmp++)
-   {
-     HaskGlob.HaskButtons[tmp] = 0;
-   }
-  HaskGlob.HaskPointerX = 0;
-  HaskGlob.HaskPointerY = 0;
-  HaskGlob.PointMoved = 0;
-
-  XFlush(MyDisplay);
-
-} 
-
-/*----------------------------------------------------------------------*/
-
-/* Boring X ``Do Something'' functions
- */
-
-haskXClose(void)
-{
-  XFreeGC( MyDisplay, DrawGC);
-  XFreeGC( MyDisplay, UnDrawGC);
-  XDestroyWindow( MyDisplay, MyWindow);
-  XCloseDisplay( MyDisplay);
-  return(0);
-}
-
-haskXDraw(x,y,x1,y1)
-int x,y,x1,y1;
-{
-  XDrawLine(MyDisplay,
-	    MyWindow,
-	    DrawGC,
-	    x,y,x1,y1);
-  return(0);
-}
-
-
-haskXPlot(c,x,y)
-int c;
-int x,y;
-{
-  XDrawPoint(MyDisplay,
-	    MyWindow,
-	    (c?DrawGC:UnDrawGC), 
-	    x,y);
-  return(0);
-}
-
-haskXFill(c,x,y,w,h)
-int c;
-int x, y;
-int w, h;
-{
-  XFillRectangle(MyDisplay,
-	    MyWindow,
-	    (c?DrawGC:UnDrawGC),
-	    x, y, w, h);
-  return(0);
-}
-
-/*----------------------------------------------------------------------*/
- 
- /* This has to be called every time round the loop,
-  * it flushed the buffer and handles input from the user
-  */
-
-haskHandleEvent()
-{
-  XFlush( MyDisplay);
-  while (XEventsQueued( MyDisplay, QueuedAfterReading) != 0) {
-    XNextEvent( MyDisplay, &MyWinEvent);
-    switch (MyWinEvent.type) {
-    case ButtonPress:
-      switch (MyWinEvent.xbutton.button) 
-	{
-	case Button1: HaskGlob.HaskButtons[0] = 1; break;
-	case Button2: HaskGlob.HaskButtons[1] = 1; break;
-	case Button3: HaskGlob.HaskButtons[2] = 1; break;
-	case Button4: HaskGlob.HaskButtons[3] = 1; break;
-	case Button5: HaskGlob.HaskButtons[4] = 1; break;
-	}
-      break;
-    case ButtonRelease:
-      switch (MyWinEvent.xbutton.button) 
-	{
-	case Button1: HaskGlob.HaskButtons[0] = 0; break;
-	case Button2: HaskGlob.HaskButtons[1] = 0; break;
-	case Button3: HaskGlob.HaskButtons[2] = 0; break;
-	case Button4: HaskGlob.HaskButtons[3] = 0; break;
-	case Button5: HaskGlob.HaskButtons[4] = 0; break;
-	}
-      break;
-    case MotionNotify: 
-        HaskGlob.HaskPointerX = MyWinEvent.xmotion.x;
-        HaskGlob.HaskPointerY = MyWinEvent.xmotion.y;
-        HaskGlob.PointMoved = 1;
-      break;
-    default:
-    printf("UNKNOWN INTERUPT ???? (%d) \n",MyWinEvent.type); 
-      break;
-    } /*switch*/
-  } /*if*/
-  return(0);
-} 
-
-
-/*----------------------------------------------------------------------*/
-
- /* A function to clear the screen 
-  */
-
-haskXCls(void)
-{
-  XClearWindow(MyDisplay,MyWindow);
-}
-
-/*----------------------------------------------------------------------*/
-
- /* A function to write a string
-  */
-
-haskXDrawString(int x,int y,char *str)
-{
-  return(0);
-/*  printf("GOT HERE %s %d %d",str,x,y); 
-  XDrawString(MyDisplay,MyWindow,DrawGC,x,y,str,strlen(str));
-*/
-}
-
-/*----------------------------------------------------------------------*/
-
-extern int prog_argc;
-extern char **prog_argv;
-
-haskArgs()
-{
-  return(prog_argc > 1 ? atoi(prog_argv[1]) : 0);
-}
diff --git a/utils/heap-view/HpView.lhs b/utils/heap-view/HpView.lhs
deleted file mode 100644
index a7b4cbb78e..0000000000
--- a/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"
diff --git a/utils/heap-view/HpView2.lhs b/utils/heap-view/HpView2.lhs
deleted file mode 100644
index fa8044b8b4..0000000000
--- a/utils/heap-view/HpView2.lhs
+++ /dev/null
@@ -1,225 +0,0 @@
-> 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"
diff --git a/utils/heap-view/MAIL b/utils/heap-view/MAIL
deleted file mode 100644
index 966fcdcfc7..0000000000
--- a/utils/heap-view/MAIL
+++ /dev/null
@@ -1,67 +0,0 @@
-To: partain@dcs.gla.ac.uk
-cc: areid@dcs.gla.ac.uk, andy@dcs.gla.ac.uk
-Subject: Heap profiling programs
-Date: Thu, 09 Dec 93 17:33:09 +0000
-From: Alastair Reid <areid@dcs.gla.ac.uk>
-
-
-I've hacked up a couple of programs which it might be worth putting in
-the next ghc distribution.  They are:
-
-graph:	
-
-  Draws a continuous graph of any one column of the statistics
-  produced using the "+RTS -Sstderr" option.
-
-  I'm not convinced this is astonishingly useful since I'm yet to
-  learn anything useful from (manually) examining these statistics.
-  (Although I do vaguely remember asking Patrick if the heap profiler
-  could do stack profiles too.)
-
-  A typical usage is:
-
-    slife 2 Unis/gardenofeden +RTS -Sstderr -H1M -RTS |& graph 2
-
-  which draws a graph of the third column (ie column 2!) of the
-  stats.
-
-  (btw is there a neater way of connecting stderr to graph's stdin?)
-
-hpView2:	
-
-  Draws a continuous graph of the statistics reported by the "+RTS -h"
-  option.
-
-  Since I understand what the figures mean, this seems to be the more
-  useful program.
-
-  A typical usage is:
-
-    mkfifo slife.hp
-    hpView2 slife.hp Main:mkQuad &
-    slife 2 Unis/gardenofeden +RTS -h -i0.1 -RTS 
-    rm slife.hp
-
-  which draws a graph of the total heap usage and the usage for Main:mkQuad.
-
-
-Minor problems:
-
-The code is a gross hack... but it works.  (Maybe distribute in rot13
-format so that you don't get accidentally get exposed to obscene code
-:-))
-
-The code uses a variant of Andy's picoXlibrary (which he was talking
-about releasing but maybe isn't ready to do yet.)
-
-Also, there are lots of obvious extensions etc which could be made but
-haven't yet...  (The major one is being able to set the initial
-scale-factor for displaying the graphs or being able to graph several
-stats at once without having to tee.)
-
-
-Hope you find them interesting.
-
-Alastair
-
-ps Code is in ~areid/hask/Life and should be readable/executable.
diff --git a/utils/heap-view/Makefile b/utils/heap-view/Makefile
deleted file mode 100644
index e8fa8faf08..0000000000
--- a/utils/heap-view/Makefile
+++ /dev/null
@@ -1,31 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-PROGRAMS = graph hpView hpView2
-
-SRC_HC_OPTS += -hi-diffs -fglasgow-exts -fhaskell-1.3 -O -L/usr/X11/lib -cpp
-SRC_CC_OPTS += -ansi -I/usr/X11/include
-# ToDo: use AC_PATH_X in configure to get lib/include dirs for X.
-
-OBJS_graph   = Graph.o           HaskXLib.o
-OBJS_hpView  = HpView.o  Parse.o HaskXLib.o
-OBJS_hpView2 = HpView2.o Parse.o HaskXLib.o
-
-all :: $(PROGRAMS)
-
-graph : $(OBJS_graph)
-	$(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $(OBJS_graph) -lX11
-
-hpView : $(OBJS_hpView)
-	$(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $(OBJS_hpView) -lX11
-
-hpView2 : $(OBJS_hpView2)
-	$(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $(OBJS_hpView2) -lX11
-
-HaskXLib.o : HaskXLib.c
-	$(CC) -c $(CC_OPTS) HaskXLib.c
-
-INSTALL_PROGS += $(PROGRAMS)
-CLEAN_FILES   += $(PROGRAMS)
-
-include $(TOP)/mk/target.mk
diff --git a/utils/heap-view/Makefile.original b/utils/heap-view/Makefile.original
deleted file mode 100644
index 1e35bc2e43..0000000000
--- a/utils/heap-view/Makefile.original
+++ /dev/null
@@ -1,48 +0,0 @@
-CC=gcc
-GLHC18 = glhc18
-GLHC19 = /users/fp/partain/bin/sun4/glhc
-HC= ghc -hi-diffs -fglasgow-exts -fhaskell-1.3
-HC_FLAGS = -O -prof -auto-all
-#HC_FLAGS = -O
-LIBS=-lX11
-FILES2 = Life2.o HaskXLib.o
-FILESS = LifeWithStability.o HaskXLib.o
-FILES = Life.o HaskXLib.o
-
-all : hpView hpView2
-
-# ADR's heap profile viewer
-hpView:	HpView.o Parse.o HaskXLib.o
-	$(HC) -o hpView $(HC_FLAGS) HpView.o Parse.o HaskXLib.o $(LIBS) -L/usr/X11/lib
-clean::
-	rm -f hpView
-
-# ADR's continuous heap profile viewer (handles output of -p)
-hpView2:	HpView2.o Parse.o HaskXLib.o
-	$(HC) -o hpView2 $(HC_FLAGS) HpView2.o Parse.o HaskXLib.o $(LIBS) -L/usr/X11/lib
-clean::
-	rm -f hpView2
-
-
-# ADR's continuous graph program (handles output of -Sstderr)
-graph:	Graph.o HaskXLib.o
-	$(HC) -o graph $(HC_FLAGS) Graph.o HaskXLib.o $(LIBS) -L/usr/X11/lib
-clean::
-	rm -f graph
-
-# ADR's continuous graph program (part of heap profile viewer) that
-# crashes the compiler
-bugGraph:	bugGraph.o HaskXLib.o
-	$(HC) -o bugGraph $(HC_FLAGS) bugGraph.o HaskXLib.o $(LIBS) -L/usr/X11/lib
-clean::
-	rm -f bugGraph
-
-%.o:%.c
-	$(CC) -c -ansi -traditional -g -I/usr/X11/include/ $< $(INC)
-
-%.o:%.lhs
-	$(HC) $(HC_FLAGS) -c $< $(INC)
-	
-clean::
-	rm -f core *.o *% #* 
-	rm -f *.hc
diff --git a/utils/heap-view/Parse.lhs b/utils/heap-view/Parse.lhs
deleted file mode 100644
index 9d7652fdcc..0000000000
--- a/utils/heap-view/Parse.lhs
+++ /dev/null
@@ -1,92 +0,0 @@
-> module Parse where
-
-The Parser monad in "Comprehending Monads"
-
-> infixr 9 `thenP`
-> infixr 9 `thenP_`
-> infixr 9 `plusP`
-
-> type P t a = [t] -> [(a,[t])]
-
-> unitP :: a -> P t a
-> unitP a = \i -> [(a,i)]
-
-> thenP :: P t a -> (a -> P t b) -> P t b
-> m `thenP` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k a i1]
-
-> thenP_ :: P t a -> P t b -> P t b
-> m `thenP_` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k i1]
-
-zeroP is the parser that always fails to parse its input
-
-> zeroP :: P t a
-> zeroP = \i -> []
-
-plusP combines two parsers in parallel
-(called "alt" in "Comprehending Monads")
-
-> plusP :: P t a -> P t a -> P t a
-> a1 `plusP` a2 = \i -> (a1 i) ++ (a2 i)
-
-itemP is the parser that parses a single token
-(called "next" in "Comprehending Monads")
-
-> itemP :: P t t
-> itemP = \i -> [(head i, tail i) | not (null i)]
-
-force successful parse
-
-> cutP :: P t a -> P t a
-> cutP p = \u -> let l = p u in if null l then [] else [head l]
-
-find all complete parses of a given string
-
-> useP :: P t a -> [t] -> [a]
-> useP m =  \x -> [ a | (a,[]) <- m x ]
-
-find first complete parse
-
-> theP :: P t a -> [t] -> a
-> theP m = head . (useP m)
-
-
-Some standard parser definitions
-
-mapP applies f to all current parse trees
-
-> mapP :: (a -> b) -> P t a -> P t b
-> f `mapP` m =  m `thenP` (\a -> unitP (f a))
-
-filter is the parser that parses a single token if it satisfies a
-predicate and fails otherwise.
-
-> filterP :: (a -> Bool) -> P t a -> P t a
-> p `filterP` m = m `thenP` (\a -> (if p a then unitP a else zeroP))
-
-lit recognises literals
-
-> litP :: Eq t => t -> P t ()
-> litP t = ((==t) `filterP` itemP) `thenP` (\c -> unitP () )
-
-> showP :: (Text a) => P t a -> [t] -> String
-> showP m xs = show (theP m xs)
-
-
-Simon Peyton Jones adds some useful operations:
-
-> zeroOrMoreP :: P t a -> P t [a]
-> zeroOrMoreP p = oneOrMoreP p `plusP` unitP []
-
-> oneOrMoreP :: P t a -> P t [a]
-> oneOrMoreP p = seq p
->  where seq p = p		`thenP` (\a ->
->		(seq p		`thenP` (\as -> unitP (a:as)))
->		`plusP`
->		unitP [a] )
-
-> oneOrMoreWithSepP :: P t a -> P t b -> P t [a]
-> oneOrMoreWithSepP p1 p2 = seq1 p1 p2
->   where seq1 p1 p2 =	p1 `thenP` (\a -> seq2 p1 p2 a `plusP`  unitP [a])
->         seq2 p1 p2 a =	p2		`thenP` (\_ ->
->				seq1 p1 p2	`thenP` (\as -> unitP (a:as) ))
-
diff --git a/utils/heap-view/README b/utils/heap-view/README
deleted file mode 100644
index db9503abc4..0000000000
--- a/utils/heap-view/README
+++ /dev/null
@@ -1,62 +0,0 @@
-@HpView.lhs@ is a very primitive heap profile viewer written in
-Haskell.  It feeds off the same files as hp2ps.  It needs a lot of
-tidying up and would be far more useful as a continuous display.
-(It's in this directory `cos there happens to be a heap profile here
-and I couldn't be bothered setting up a new directory, Makefile, etc.)
-
-@Graph.lhs@ is a continuous heap viewer that "parses" the output of
-the +RTS -Sstderr option.  Typical usage:
-
-   slife 1 r4 +RTS -Sstderr |& graph 2
-
-(You might also try 
-
-   cat data | graph 2
-
- to see it in action on some sample data.
-)
-
-Things to watch:
-
-  1) Scaling varies from column to column - consult the source.
-
-  2) The horizontal scale is not time - it is garbage collections.
-
-  3) The graph is of the (n+1)st column of the -Sstderr output. 
-
-     The data is not always incredibly useful: For example, when using
-     the (default) Appel 2-space garbage collector, the 3rd column
-     displays the amount of "live" data in the minor space.  A program
-     with a constant data usage will appear to have a sawtooth usage
-     as minor data gradually transfers to the major space and then,
-     suddenly, all gets transferred back at major collections.
-     Decreasing heap size decreases the size of the minor collections
-     and increases major collections exaggerating the sawtooth.
-
-  4) The program is not as robust as it might be.
-
-
-@HpView2.lhs@ is the result of a casual coupling of @Graph.lhs@ and
-@HpView.lhs@ which draws continuous graphs of the heap consisting of:
-total usage and usage by one particular cost centre.  For example:
-
-    mkfifo slife.hp
-    hpView2 slife.hp Main:mkQuad &
-    slife 2 Unis/gardenofeden +RTS -h -i0.1 -RTS 
-    rm slife.hp
-
-draws a graph of total usage and usage by the function @mkQuad@.  
-
-(You might also try 
-
-	hpView2 slife.old-hp Main:mkQuad
-
- to see it in action on some older data)
-
-The business with named pipes (mkfifo) is a little unfortunate - it
-would be nicer if the Haskell runtime system could output to stderr
-(say) which I could pipe into hpView which could just graph it's stdin
-(like graph does).  It's probably worth wrapping the whole thing up in
-a little shell-script.
-
-
diff --git a/utils/heap-view/common-bits b/utils/heap-view/common-bits
deleted file mode 100644
index f41223b7f4..0000000000
--- a/utils/heap-view/common-bits
+++ /dev/null
@@ -1,35 +0,0 @@
- -----------------------------------------------------------------------------
-
- xInitialise :: [String] -> Int -> Int -> IO ()
- xInitialise str x y = 
-	 _ccall_ haskXBegin x y (0::Int)	`seqPrimIO`
-	 return ()
-
- xHandleEvent :: IO ()
- xHandleEvent = 
-	 _ccall_ haskHandleEvent		`thenPrimIO` \ n ->
-	 case (n::Int) of
-		 0 -> return ()
-		 _ -> error "Unknown Message back from Handle Event"
-
- xClose :: IO ()
- xClose =
-	  _ccall_ haskXClose		`seqPrimIO`
-	  return ()
-
- xCls :: IO ()
- xCls = 
-	 _ccall_ haskXCls		`seqPrimIO`
-	 return ()
-
- xDrawLine :: Int -> Int -> Int -> Int -> IO ()
- xDrawLine x1 y1 x2 y2 =
-	 _ccall_ haskXDraw x1 y1 x2 y2	`seqPrimIO`
-	 return ()
-
- ----------------------------------------------------------------
-
- usleep :: Int -> IO ()
- usleep t =
-	 _ccall_ usleep t		`seqPrimIO`
-	 return ()