Reorganisation of the source tree

Most of the other users of the fptools build system have migrated to
Cabal, and with the move to darcs we can now flatten the source tree
without losing history, so here goes.

The main change is that the ghc/ subdir is gone, and most of what it
contained is now at the top level.  The build system now makes no
pretense at being multi-project, it is just the GHC build system.

No doubt this will break many things, and there will be a period of
instability while we fix the dependencies.  A straightforward build
should work, but I haven't yet fixed binary/source distributions.
Changes to the Building Guide will follow, too.

10 files changed, 1318 insertions, 0 deletions

diff --git a/utils/heap-view/Graph.lhs b/utils/heap-view/Graph.lhs
new file mode 100644
index 0000000000..b8e08dbb9b
--- /dev/null
+++ b/utils/heap-view/Graph.lhs
@@ -0,0 +1,165 @@
+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
new file mode 100644
index 0000000000..b6cf1f137c
--- /dev/null
+++ b/utils/heap-view/HaskXLib.c
@@ -0,0 +1,297 @@
+/*----------------------------------------------------------------------*
+ *  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
new file mode 100644
index 0000000000..a7b4cbb78e
--- /dev/null
+++ b/utils/heap-view/HpView.lhs
@@ -0,0 +1,296 @@
+> 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
new file mode 100644
index 0000000000..fa8044b8b4
--- /dev/null
+++ b/utils/heap-view/HpView2.lhs
@@ -0,0 +1,225 @@
+> 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
new file mode 100644
index 0000000000..966fcdcfc7
--- /dev/null
+++ b/utils/heap-view/MAIL
@@ -0,0 +1,67 @@
+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
new file mode 100644
index 0000000000..e8fa8faf08
--- /dev/null
+++ b/utils/heap-view/Makefile
@@ -0,0 +1,31 @@
+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
new file mode 100644
index 0000000000..1e35bc2e43
--- /dev/null
+++ b/utils/heap-view/Makefile.original
@@ -0,0 +1,48 @@
+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
new file mode 100644
index 0000000000..9d7652fdcc
--- /dev/null
+++ b/utils/heap-view/Parse.lhs
@@ -0,0 +1,92 @@
+> 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
new file mode 100644
index 0000000000..db9503abc4
--- /dev/null
+++ b/utils/heap-view/README
@@ -0,0 +1,62 @@
+@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
new file mode 100644
index 0000000000..f41223b7f4
--- /dev/null
+++ b/utils/heap-view/common-bits
@@ -0,0 +1,35 @@
+ -----------------------------------------------------------------------------
+
+ 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 ()